Unpack.hs

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

{- | Module, carrying logic of @UNPACK@ instruction.

This is nearly symmetric to adjacent Pack.hs module.

When implementing this the following sources were used:

* https://pastebin.com/8gfXaRvp

* https://gitlab.com/tezos/tezos/-/blob/767de2b6665ec2cc21e41e6348f8a0b369d26450/src/proto_alpha/lib_protocol/script_ir_translator.ml#L2501

* https://github.com/tezbridge/tezbridge-crypto/blob/f7d93d8d04201557972e839967758cff5bbe5345/PsddFKi3/codec.js#L513

-}
module Michelson.Interpret.Unpack
  ( UnpackError (..)
  , unpackInstr'
  , unpackUValue'
  , unpackValue'
  ) where

import Prelude hiding (EQ, Ordering(..), get)

import qualified Data.ByteString as BS
import Data.Constraint (Dict(..))
import Fmt (pretty)

import Michelson.Typed (UnpackedValScope)
import qualified Michelson.Typed as T
import Michelson.Untyped
import qualified Michelson.Untyped as U
import Morley.Micheline.Binary (eitherDecodeExpression)
import Morley.Micheline.Class (FromExpression(..))
import Util.Binary

{- Implementation notes:

* We need to know which exact type we unpack to.
For instance, serialized signatures are indistinguishable from
plain serialized bytes, so if we want to return "Value" (typed or untyped),
we need to know currently expected type. The reference implementation does
the same.

* It occurred to be easier to decode to typed values and untyped instructions.
When decoding lambda, we type check given instruction, and when decoding
@PUSH@ call we untype decoded value.
One may say that this gives unreasonable performance overhead, but with the
current definition of "Value" types (typed and untyped) we cannot avoid it
anyway, because when deserializing bytearray-like data (keys, signatures, ...),
we have to convert raw bytes to human-readable 'Text' and later parse them
to bytes back at type check stage.
We console ourselves that lambdas are rarely packed.

-}

-- | Deserialize bytes into the given value.
-- Suitable for @UNPACK@ operation only.
unpackValue'
  :: forall t. (UnpackedValScope t)
  => ByteString -> Either UnpackError (T.Value t)
unpackValue' = unpackImpl @(T.Value t)
  where
    _reallyNeedThisConstraint = Dict @(UnpackedValScope t)

-- | Deserialize an instruction into the given value.
unpackInstr' :: ByteString -> Either UnpackError [ExpandedOp]
unpackInstr' = unpackImpl @([ExpandedOp])

-- | Deserialize bytes into 'Untyped.Value'.
unpackUValue' :: ByteString -> Either UnpackError U.Value
unpackUValue' = unpackImpl @U.Value

unpackImpl :: forall t. (FromExpression t)
           => ByteString
           -> Either UnpackError t
unpackImpl bs = do
  (tag, bs') <- maybeToRight (UnpackError "Empty bytes") (BS.uncons bs)
  when (tag /= 0x05) . Left . UnpackError $
    "Unexpected tag: '" <> (show tag) <> "'. '0x05' tag expected."
  expr <- eitherDecodeExpression bs'
  either (Left . UnpackError . pretty) Right $ fromExpression @t expr