-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

-- | Packing utilities.
module Lorentz.Pack
  ( lPackValue
  , lUnpackValue
  , lEncodeValue
  , valueToScriptExpr
  , expressionToScriptExpr
  ) where

import qualified Data.ByteString as BS
import Data.Constraint ((\\))

import Lorentz.Constraints
import Michelson.Interpret.Pack
import Michelson.Interpret.Unpack
import Michelson.Typed
import Morley.Micheline (Expression, encodeExpression)
import Tezos.Crypto (blake2b)

lPackValue
  :: forall a.
     (NicePackedValue a)
  => a -> ByteString
lPackValue :: a -> ByteString
lPackValue =
  Value (ToT a) -> ByteString
forall (t :: T). PackedValScope t => Value t -> ByteString
packValue' (Value (ToT a) -> ByteString)
-> (a -> Value (ToT a)) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value (ToT a)
forall a. IsoValue a => a -> Value (ToT a)
toVal ((SingI (ToT a), HasNoOp (ToT a), HasNoBigMap (ToT a)) =>
 a -> ByteString)
-> ((KnownValue a,
     (SingI (ToT a), FailOnOperationFound (ContainsOp (ToT a)),
      FailOnBigMapFound (ContainsBigMap (ToT a))))
    :- (SingI (ToT a), HasNoOp (ToT a), HasNoBigMap (ToT a)))
-> a
-> ByteString
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ (KnownValue a,
 (SingI (ToT a), FailOnOperationFound (ContainsOp (ToT a)),
  FailOnBigMapFound (ContainsBigMap (ToT a))))
:- (SingI (ToT a), HasNoOp (ToT a), HasNoBigMap (ToT a))
forall a. NicePackedValue a :- PackedValScope (ToT a)
nicePackedValueEvi @a

lUnpackValue
  :: forall a.
     (NiceUnpackedValue a)
  => ByteString -> Either UnpackError a
lUnpackValue :: ByteString -> Either UnpackError a
lUnpackValue =
  (Value (ToT a) -> a)
-> Either UnpackError (Value (ToT a)) -> Either UnpackError a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value (ToT a) -> a
forall a. IsoValue a => Value (ToT a) -> a
fromVal (Either UnpackError (Value (ToT a)) -> Either UnpackError a)
-> (ByteString -> Either UnpackError (Value (ToT a)))
-> ByteString
-> Either UnpackError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnpackError (Value (ToT a))
forall (t :: T).
UnpackedValScope t =>
ByteString -> Either UnpackError (Value t)
unpackValue' ((PackedValScope (ToT a), ConstantScope (ToT a)) =>
 ByteString -> Either UnpackError a)
-> ((KnownValue a,
     ((SingI (ToT a), FailOnOperationFound (ContainsOp (ToT a)),
       FailOnBigMapFound (ContainsBigMap (ToT a))),
      (SingI (ToT a), FailOnOperationFound (ContainsOp (ToT a)),
       FailOnBigMapFound (ContainsBigMap (ToT a)),
       FailOnContractFound (ContainsContract (ToT a)))))
    :- (PackedValScope (ToT a), ConstantScope (ToT a)))
-> ByteString
-> Either UnpackError a
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ (KnownValue a,
 ((SingI (ToT a), FailOnOperationFound (ContainsOp (ToT a)),
   FailOnBigMapFound (ContainsBigMap (ToT a))),
  (SingI (ToT a), FailOnOperationFound (ContainsOp (ToT a)),
   FailOnBigMapFound (ContainsBigMap (ToT a)),
   FailOnContractFound (ContainsContract (ToT a)))))
:- (PackedValScope (ToT a), ConstantScope (ToT a))
forall a. NiceUnpackedValue a :- UnpackedValScope (ToT a)
niceUnpackedValueEvi @a

lEncodeValue
  :: forall a. (NicePrintedValue a)
  => a -> ByteString
lEncodeValue :: a -> ByteString
lEncodeValue = Value (ToT a) -> ByteString
forall (t :: T). (SingI t, HasNoOp t) => Value t -> ByteString
encodeValue' (Value (ToT a) -> ByteString)
-> (a -> Value (ToT a)) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value (ToT a)
forall a. IsoValue a => a -> Value (ToT a)
toVal ((SingI (ToT a), HasNoOp (ToT a)) => a -> ByteString)
-> ((KnownValue a,
     (SingI (ToT a), FailOnOperationFound (ContainsOp (ToT a))))
    :- (SingI (ToT a), HasNoOp (ToT a)))
-> a
-> ByteString
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ (KnownValue a,
 (SingI (ToT a), FailOnOperationFound (ContainsOp (ToT a))))
:- (SingI (ToT a), HasNoOp (ToT a))
forall a. NicePrintedValue a :- PrintedValScope (ToT a)
nicePrintedValueEvi @a

-- | This function transforms Lorentz values into @script_expr@.
--
-- @script_expr@ is used in RPC as an argument in entrypoint
-- designed for getting value by key from the big_map in Babylon.
-- In order to convert value to the @script_expr@ we have to pack it,
-- take blake2b hash and add specific @expr@ prefix. Take a look at
-- <https://gitlab.com/tezos/tezos/blob/6e25ae8eb385d9975a30388c7a7aa2a9a65bf184/src/proto_005_PsBabyM1/lib_protocol/script_expr_hash.ml>
-- and <https://gitlab.com/tezos/tezos/blob/6e25ae8eb385d9975a30388c7a7aa2a9a65bf184/src/proto_005_PsBabyM1/lib_protocol/contract_services.ml#L136>
-- for more information.
valueToScriptExpr
  :: forall t. (NicePackedValue t)
  => t -> ByteString
valueToScriptExpr :: t -> ByteString
valueToScriptExpr = ByteString -> ByteString
addScriptExprPrefix (ByteString -> ByteString) -> (t -> ByteString) -> t -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
blake2b (ByteString -> ByteString) -> (t -> ByteString) -> t -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> ByteString
forall a. NicePackedValue a => a -> ByteString
lPackValue

-- | Similar to 'valueToScriptExpr', but for values encoded as 'Expression's.
-- This is only used in tests.
expressionToScriptExpr :: Expression -> ByteString
expressionToScriptExpr :: Expression -> ByteString
expressionToScriptExpr = ByteString -> ByteString
addScriptExprPrefix (ByteString -> ByteString)
-> (Expression -> ByteString) -> Expression -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
blake2b (ByteString -> ByteString)
-> (Expression -> ByteString) -> Expression -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
mappend ByteString
forall s. IsString s => s
packValuePrefix (ByteString -> ByteString)
-> (Expression -> ByteString) -> Expression -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expression -> ByteString
encodeExpression

addScriptExprPrefix :: ByteString -> ByteString
addScriptExprPrefix :: ByteString -> ByteString
addScriptExprPrefix = ([Word8] -> ByteString
BS.pack [0x0D, 0x2C, 0x40, 0x1B] ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>)