Pack.hs

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

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

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

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

lPackValueRaw
  :: forall a.
     (NicePackedValue a)
  => a -> ByteString
lPackValueRaw =
  packValue' . toVal \\ nicePackedValueEvi @a

lUnpackValueRaw
  :: forall a.
     (NiceUnpackedValue a)
  => ByteString -> Either UnpackError a
lUnpackValueRaw =
  fmap fromVal . unpackValue' \\ niceUnpackedValueEvi @a

lPackValue
  :: forall a.
     (NicePackedValue a)
  => a -> Packed a
lPackValue =
  Packed . lPackValueRaw

lUnpackValue
  :: forall a.
     (NiceUnpackedValue a)
  => Packed a -> Either UnpackError a
lUnpackValue =
  lUnpackValueRaw . unPacked

lEncodeValue
  :: forall a. (NiceUntypedValue a)
  => a -> ByteString
lEncodeValue = toBinary' . toVal \\ niceUntypedValueEvi @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 = addScriptExprPrefix . blake2b . lPackValueRaw

-- | Similar to 'valueToScriptExpr', but for values encoded as 'Expression's.
-- This is only used in tests.
expressionToScriptExpr :: Expression -> ByteString
expressionToScriptExpr = addScriptExprPrefix . blake2b . mappend packValuePrefix . encodeExpression'

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