-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

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

import Data.ByteString qualified 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 :: forall a. NicePackedValue a => a -> ByteString
lPackValueRaw =
  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 (PackedValScope (ToT a) => a -> ByteString)
-> (NicePackedValue a :- PackedValScope (ToT a)) -> a -> ByteString
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ forall a. NicePackedValue a :- PackedValScope (ToT a)
nicePackedValueEvi @a

lUnpackValueRaw
  :: forall a.
     (NiceUnpackedValue a)
  => ByteString -> Either UnpackError a
lUnpackValueRaw :: forall a. NiceUnpackedValue a => ByteString -> Either UnpackError a
lUnpackValueRaw =
  (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' (UnpackedValScope (ToT a) => ByteString -> Either UnpackError a)
-> (NiceUnpackedValue a :- UnpackedValScope (ToT a))
-> ByteString
-> Either UnpackError a
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ forall a. NiceUnpackedValue a :- UnpackedValScope (ToT a)
niceUnpackedValueEvi @a

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

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

lEncodeValue
  :: forall a. (NiceUntypedValue a)
  => a -> ByteString
lEncodeValue :: forall a. NiceUntypedValue a => a -> ByteString
lEncodeValue = Value (ToT a) -> ByteString
forall a. ToExpression a => a -> ByteString
toBinary' (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)
-> (NiceUntypedValue a :- (SingI (ToT a), HasNoOp (ToT a)))
-> a
-> ByteString
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ forall a. NiceUntypedValue a :- UntypedValScope (ToT a)
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 :: forall a. NicePackedValue a => a -> 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
lPackValueRaw

-- | 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 [Word8
0x0D, Word8
0x2C, Word8
0x40, Word8
0x1B] ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>)