module Michelson.Interpret.Unpack
( UnpackError (..)
, unpackValue
, unpackValue'
) where
import Prelude hiding (EQ, Ordering(..), get)
import Control.Monad.Except (throwError)
import Data.Binary (Get)
import qualified Data.Binary.Get as Get
import qualified Data.Bits as Bits
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import Data.Constraint (Dict(..))
import Data.Default (def)
import qualified Data.Kind as Kind
import qualified Data.List as List
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Singletons (SingI(..))
import Data.Typeable ((:~:)(..))
import Fmt (Buildable, build, fmt, hexF, pretty, (+|), (+||), (|+), (||+))
import Text.Hex (encodeHex)
import Michelson.Text
import Michelson.TypeCheck
(HST(..), SomeHST(..), SomeInstr(..), SomeInstrOut(..), TCError(..), TypeCheckEnv(..))
import Michelson.TypeCheck.Helpers (ensureDistinctAsc, eqHST1)
import Michelson.TypeCheck.Instr (typeCheckList)
import Michelson.Typed (RemFail(..), Sing(..), starNotes)
import qualified Michelson.Typed as T
import Michelson.Typed.EntryPoints
import Michelson.Typed.Scope
(BigMapPresence(..), ContractPresence(..), OpPresence(..), UnpackedValScope, bigMapAbsense,
checkBigMapPresence, checkContractTypePresence, checkOpPresence, contractTypeAbsense, opAbsense)
import Michelson.Untyped
import Tezos.Address (Address(..), ContractHash(..), parseAddress)
import Tezos.Core
import Tezos.Crypto
(KeyHash(..), KeyHashTag(..), PublicKey(..), keyHashLengthBytes, mkSignature, parseKeyHash,
parsePublicKey, parseSignature, signatureLengthBytes)
import qualified Tezos.Crypto.Ed25519 as Ed25519
import qualified Tezos.Crypto.P256 as P256
import qualified Tezos.Crypto.Secp256k1 as Secp256k1
newtype UnpackError = UnpackError { unUnpackError :: Text }
deriving (Show, Eq)
instance Buildable UnpackError where
build (UnpackError msg) = build msg
instance Exception UnpackError where
displayException = pretty
(?) :: Get a -> String -> Get a
(?) = flip Get.label
infix 0 ?
getByteStringCopy :: Int -> Get ByteString
getByteStringCopy = fmap BS.copy . Get.getByteString
expectTag :: String -> Word8 -> Get ()
expectTag desc t =
Get.label desc $ do
t' <- Get.getWord8
unless (t == t') $
fail . fmt $ "Unexpected tag value (expected 0x" +| hexF t |+
", but got 0x" +| hexF t' |+ ")"
unknownTag :: String -> Word8 -> Get a
unknownTag desc tag =
fail . fmt $ "Unknown " <> build desc <> " tag: 0x" <> hexF tag
expectDescTag :: HasCallStack => String -> Word16 -> Get ()
expectDescTag desc argsNum =
Get.label desc $ do
tag <- Get.getWord8
unless (tag == expected) $
fail . fmt $ "Unexpected preliminary tag: 0x" <> hexF tag
where
expected = case argsNum of
0 -> 0x03
1 -> 0x05
2 -> 0x07
3 -> 0x08
_ -> error "Bad arguments num"
ensureEnd :: Get ()
ensureEnd =
unlessM Get.isEmpty $ do
remainder <- Get.getRemainingLazyByteString
fail $ "Expected end of entry, unconsumed bytes \
\(" +| length remainder |+ "): "
+|| encodeHex (LBS.toStrict remainder) ||+ ""
manyForced :: Get a -> Get [a]
manyForced decode = do
emp <- Get.isEmpty
if emp
then return []
else (:) <$> decode <*> manyForced decode
data TaggedDecoder a where
TaggedDecoder :: Buildable err =>
{ tdTag :: !Word8
, tdLength :: !Int
, tdConstructor :: !(ByteString -> Either err a)
} -> TaggedDecoder a
decodeWithTag :: String -> [TaggedDecoder a] -> Int -> Get a
decodeWithTag what decoders len =
decodeWithTagSimple what . map (\td -> (tdTag td, tdToGet td)) $ decoders
where
tdToGet :: TaggedDecoder a -> Get a
tdToGet TaggedDecoder {..}
| tdLength + 1 /= len =
fail $ "Wrong length of " +| what |+ ": " +| len |+ ""
| otherwise = do
bs <- getByteStringCopy tdLength
case tdConstructor bs of
Left err -> fail $ "Wrong " +| what |+ ": " +| err |+ ""
Right res -> pure res
decodeWithTagSimple :: String -> [(Word8, Get a)] -> Get a
decodeWithTagSimple what decoders = Get.label what $ do
tag <- Get.label (what <> " tag") Get.getWord8
case List.find ((tag ==) . fst) decoders of
Nothing -> unknownTag what tag
Just (_, decoder) -> decoder
unpackValue
:: (UnpackedValScope t)
=> LByteString -> Either UnpackError (T.Value t)
unpackValue bs =
case Get.runGetOrFail unpackDecoder bs of
Left (_remainder, _offset, err) -> Left . UnpackError $ toText err
Right (_remainder, _offset, res) -> Right res
unpackValue'
:: (UnpackedValScope t)
=> ByteString -> Either UnpackError (T.Value t)
unpackValue' = unpackValue . LBS.fromStrict
unpackDecoder
:: (UnpackedValScope t)
=> Get (T.Value t)
unpackDecoder =
expectTag "Packed data start" 0x05 *> decodeValue <* ensureEnd
decodeValue
:: forall t.
(HasCallStack, UnpackedValScope t)
=> Get (T.Value t)
decodeValue = Get.label "Value" $
case sing @t of
STc _ ->
T.VC <$> decodeCValue
STKey -> T.VKey <$> asum
[ decodeAsBytes $ decodeWithTag "key"
[ TaggedDecoder 0x00 Ed25519.publicKeyLengthBytes
(fmap PublicKeyEd25519 . Ed25519.mkPublicKey)
, TaggedDecoder 0x01 Secp256k1.publicKeyLengthBytes
(fmap PublicKeySecp256k1 . Secp256k1.mkPublicKey)
, TaggedDecoder 0x02 P256.publicKeyLengthBytes
(fmap PublicKeyP256 . P256.mkPublicKey)
]
, decodeAsString parsePublicKey
]
STUnit -> do
expectDescTag "Unit" 0
expectTag "Unit" 0x0B
return T.VUnit
STSignature -> T.VSignature <$> asum
[ decodeAsBytes $ \_len -> do
bs <- getByteStringCopy signatureLengthBytes
case mkSignature bs of
Nothing -> error "mkSignature failed"
Just s -> pure s
, decodeAsString parseSignature
]
STChainId -> asum
[ decodeAsBytes $ \_len -> do
bs <- getByteStringCopy chainIdLength
case mkChainId bs of
Nothing -> fail $ "Wrong chain id format"
Just s -> pure (T.VChainId s)
, T.VChainId <$> decodeAsString parseChainId
]
STOption _ -> do
Get.getByteString 2 >>= \case
"\x03\x06" -> pure (T.VOption Nothing)
"\x05\x09" -> T.VOption . Just <$> decodeValue
other -> fail $ "Unknown option tag: " <> show other
STList _ -> do
decodeAsList $ T.VList <$> manyForced decodeValue
STSet _ -> do
decodeAsList $ do
vals <- manyForced decodeCValue
either (fail . toString) pure $
T.VSet . Set.fromDistinctAscList <$> ensureDistinctAsc id vals
STPair lt _ ->
case (checkOpPresence lt, checkBigMapPresence lt, checkContractTypePresence lt) of
(OpAbsent, BigMapAbsent, ContractAbsent) -> do
expectDescTag "Pair" 2
expectTag "Pair" 0x07
T.VPair ... (,) <$> decodeValue <*> decodeValue
STOr lt _ ->
case (checkOpPresence lt, checkBigMapPresence lt, checkContractTypePresence lt) of
(OpAbsent, BigMapAbsent, ContractAbsent) -> do
expectDescTag "Or" 1
Get.getWord8 >>= \case
0x05 -> T.VOr . Left <$> decodeValue
0x08 -> T.VOr . Right <$> decodeValue
other -> unknownTag "or constructor" other
STLambda _ _ -> do
uinstr <- decodeOps
T.VLam <$> decodeTypeCheckLam uinstr
STMap _ _ -> do
T.VMap <$> decodeMap
decodeCValue :: forall ct. SingI ct => Get (T.CValue ct)
decodeCValue = case sing @ct of
SCInt -> do
expectTag "Int" 0x00
T.CvInt <$> decodeInt
SCNat -> do
expectTag "Nat" 0x00
T.CvNat <$> decodeInt
SCString -> do
expectTag "String" 0x01
T.CvString <$> decodeString
SCBytes -> do
expectTag "Bytes" 0x0a
T.CvBytes <$> decodeBytes
SCMutez -> do
expectTag "Mutez" 0x00
mmutez <- mkMutez <$> decodeInt
maybe (fail "Negative mutez") (pure . T.CvMutez) mmutez
SCBool -> do
expectDescTag "Bool" 0
Get.getWord8 >>= \case
0x0A -> pure (T.CvBool True)
0x03 -> pure (T.CvBool False)
other -> unknownTag "bool" other
SCKeyHash -> T.CvKeyHash <$> asum
[ decodeAsBytes $ decodeWithTag "key_hash" keyHashDecoders
, decodeAsString parseKeyHash
]
SCTimestamp -> do
expectTag "Timestamp" 0x00
T.CvTimestamp . timestampFromSeconds <$> decodeInt
SCAddress ->
T.CvAddress <$> decodeEpAddress
keyHashDecoders :: [TaggedDecoder KeyHash]
keyHashDecoders =
[ TaggedDecoder @Void 0x00 keyHashLengthBytes (pure . KeyHash KeyHashEd25519)
, TaggedDecoder @Void 0x01 keyHashLengthBytes (pure . KeyHash KeyHashSecp256k1)
, TaggedDecoder @Void 0x02 keyHashLengthBytes (pure . KeyHash KeyHashP256)
]
decodeLength :: Get Int
decodeLength = Get.label "Length" $ do
len <- Get.getWord32be
let len' = fromIntegral @_ @Int len
unless (fromIntegral len' == len && len' >= 0) $
fail "Length overflow"
return len'
decodeAsListRaw :: Get a -> Get a
decodeAsListRaw getElems = do
l <- decodeLength ? "List length"
Get.isolate l (getElems ? "List content")
decodeAsList :: Get a -> Get a
decodeAsList getElems = do
expectTag "List" 0x02
decodeAsListRaw getElems
decodeString :: Get MText
decodeString = do
l <- decodeLength ? "String length"
ss <- replicateM l Get.getWord8 ? "String content"
ss' <- decodeUtf8' (BS.pack ss)
& either (fail . show) pure
? "String UTF-8 decoding"
mkMText ss'
& either (fail . show) pure
? "Michelson string validity analysis"
decodeAsString :: Buildable e => (Text -> Either e a) -> Get a
decodeAsString parser = do
expectTag "String" 0x01
str <- decodeString
either (fail . pretty) pure $ parser $ unMText str
decodeAsBytesRaw :: (Int -> Get a) -> Get a
decodeAsBytesRaw decode = do
l <- decodeLength ? "Byte array length"
decode l ? "Byte array content"
decodeAsBytes :: (Int -> Get a) -> Get a
decodeAsBytes decode = do
expectTag "Bytes" 0x0A
decodeAsBytesRaw decode
decodeBytes :: Get ByteString
decodeBytes = decodeAsBytesRaw getByteStringCopy
decodeMap
:: (SingI k, UnpackedValScope v)
=> Get $ Map (T.CValue k) (T.Value v)
decodeMap = Get.label "Map" $
decodeAsList $ do
es <- manyForced $ do
expectDescTag "Elt" 2
expectTag "Elt" 0x04
(,) <$> decodeCValue <*> decodeValue
either (fail . toString) pure $
Map.fromDistinctAscList <$> ensureDistinctAsc fst es
decodeAddress :: Get Address
decodeAddress = Get.label "Address" $ asum
[ decodeAsBytes $ \(pred -> lenNoTag) -> decodeWithTagSimple "address"
[ (0x00, KeyAddress <$>
decodeWithTag "key_hash inside address" keyHashDecoders lenNoTag)
, (0x01, Get.label "Contract addres" $ do
addr <- getByteStringCopy 20
expectTag "Contract address suffix" 0x00
return $ ContractAddress (ContractHash addr)
)
]
, decodeAsString parseAddress
]
decodeEpAddress :: Get EpAddress
decodeEpAddress = do
eaAddress <- decodeAddress
refAnn <- decodeAnn
eaEntryPoint <- epNameFromRefAnn refAnn
& either (fail . pretty) pure
return EpAddress{..}
decodeInt :: Num i => Get i
decodeInt = fromIntegral @Integer <$> loop 0 0 ? "Number"
where
loop !offset !acc = do
byte <- Get.getWord8
let hasCont = Bits.testBit byte 7
let doCont shft = if hasCont then loop (shft + offset) else pure
let addAndCont shft bytePayload =
doCont shft $ acc + Bits.shiftL (fromIntegral bytePayload) offset
let payload = Bits.clearBit byte 7
if offset > 0
then addAndCont 7 payload
else do
let sign = if Bits.testBit byte 6 then -1 else 1
let upayload = Bits.clearBit payload 6
(sign *) <$> addAndCont 6 upayload
decodeAnn :: forall (t :: Kind.Type). Get (Annotation t)
decodeAnn = pure noAnn
decodeTypeCheckLam
:: forall inp out m.
(Typeable inp, SingI inp, SingI out, Typeable out, MonadFail m)
=> [ExpandedOp]
-> m (RemFail T.Instr '[inp] '[out])
decodeTypeCheckLam uinstr =
either tcErrToFail pure . evaluatingState tcInitEnv . runExceptT $ do
let inp = (sing @inp, starNotes, noAnn) ::& SNil
_ :/ instr' <- typeCheckList uinstr inp
case instr' of
instr ::: out' ->
case eqHST1 @out out' of
Right Refl ->
pure $ RfNormal instr
Left err ->
let tinp = Type TUnit noAnn
tout = Type TUnit noAnn
in throwError $
TCFailedOnInstr (LAMBDA noAnn tinp tout uinstr) (SomeHST inp)
"Unexpected lambda output type" def (Just err)
AnyOutInstr instr ->
return $ RfAlwaysFails instr
where
tcErrToFail err = fail $ "Type check failed: " +| err |+ ""
tcInitEnv =
TypeCheckEnv
{ tcExtFrames = error "runInstrImpl(UNPACK): tcExtFrames touched"
, tcContractParam = error "runInstrImpl(UNPACK): tcContractParam touched"
, tcContracts = error "runInstrImpl(UNPACK): tcContracts touched"
}
decodeInstr :: Get ExpandedInstr
decodeInstr = Get.label "Instruction" $ do
pretag <- Get.getWord8 ? "Pre instr tag"
tag <- Get.getWord8 ? "Instr tag"
case (pretag, tag) of
(0x03, 0x20) -> pure $ DROP
(0x05, 0x20) -> DROPN <$> (expectTag "'DROP n' parameter" 0x00 *> decodeInt)
(0x03, 0x21) -> pure $ DUP noAnn
(0x03, 0x4C) -> pure $ SWAP
(0x05, 0x70) -> DIG <$> (expectTag "'DIG n' parameter" 0x00 *> decodeInt)
(0x05, 0x71) -> DUG <$> (expectTag "'DUG n' parameter" 0x00 *> decodeInt)
(0x07, 0x43) -> do
an :: VarAnn <- decodeAnn
typ <- decodeType
T.withSomeSingT (T.fromUType typ) $ \(st :: Sing t) ->
case (opAbsense st, bigMapAbsense st, contractTypeAbsense st) of
(Nothing, _, _) -> fail "Operation type cannot appear in PUSH"
(_, Nothing, _) -> fail "BigMap type cannot appear in PUSH"
(_, _, Nothing) -> fail "'contract' type cannot appear in PUSH"
(Just Dict, Just Dict, Just Dict) -> do
tval <- decodeValue @t
return $ PUSH an typ (T.untypeValue tval)
(0x03, 0x46) -> SOME <$> decodeAnn <*> decodeAnn
(0x05, 0x3E) -> NONE <$> decodeAnn <*> decodeAnn <*> decodeType
(0x03, 0x4F) -> UNIT <$> decodeAnn <*> decodeAnn
(0x07, 0x2F) -> IF_NONE <$> decodeOps <*> decodeOps
(0x03, 0x42) -> PAIR <$> decodeAnn <*> decodeAnn <*> decodeAnn <*> decodeAnn
(0x03, 0x16) -> CAR <$> decodeAnn <*> decodeAnn
(0x03, 0x17) -> CDR <$> decodeAnn <*> decodeAnn
(0x05, 0x33) -> LEFT <$> decodeAnn <*> decodeAnn <*> decodeAnn <*> decodeAnn
<*> decodeType
(0x05, 0x44) -> RIGHT <$> decodeAnn <*> decodeAnn <*> decodeAnn <*> decodeAnn
<*> decodeType
(0x07, 0x2E) -> IF_LEFT <$> decodeOps <*> decodeOps
(0x05, 0x3D) -> NIL <$> decodeAnn <*> decodeAnn <*> decodeType
(0x03, 0x1B) -> CONS <$> decodeAnn
(0x07, 0x2D) -> IF_CONS <$> decodeOps <*> decodeOps
(0x03, 0x45) -> SIZE <$> decodeAnn
(0x05, 0x24) -> EMPTY_SET <$> decodeAnn <*> decodeAnn <*> decodeComparable
(0x07, 0x23) -> EMPTY_MAP <$> decodeAnn <*> decodeAnn <*> decodeComparable
<*> decodeType
(0x07, 0x72) -> EMPTY_BIG_MAP <$> decodeAnn <*> decodeAnn <*> decodeComparable
<*> decodeType
(0x05, 0x38) -> MAP <$> decodeAnn <*> decodeOps
(0x05, 0x52) -> ITER <$> decodeOps
(0x03, 0x39) -> MEM <$> decodeAnn
(0x03, 0x29) -> GET <$> decodeAnn
(0x03, 0x50) -> UPDATE <$> decodeAnn
(0x07, 0x2C) -> IF <$> decodeOps <*> decodeOps
(0x05, 0x34) -> LOOP <$> decodeOps
(0x05, 0x53) -> LOOP_LEFT <$> decodeOps
(0x09, 0x31) -> do
res <- decodeAsListRaw $
LAMBDA <$> decodeAnn <*> decodeType <*> decodeType <*> decodeOps
void decodeLength
return res
(0x03, 0x26) -> EXEC <$> decodeAnn
(0x03, 0x73) -> APPLY <$> decodeAnn
(0x05, 0x1F) -> DIP <$> decodeOps
(0x07, 0x1F) ->
DIPN <$> (expectTag "'DIP n' parameter" 0x00 *> decodeInt) <*> decodeOps
(0x03, 0x27) -> pure FAILWITH
(0x05, 0x57) -> CAST <$> decodeAnn <*> decodeType
(0x03, 0x58) -> RENAME <$> decodeAnn
(0x03, 0x0C) -> PACK <$> decodeAnn
(0x05, 0x0D) -> UNPACK <$> decodeAnn <*> decodeType
(0x03, 0x1A) -> CONCAT <$> decodeAnn
(0x03, 0x6F) -> SLICE <$> decodeAnn
(0x03, 0x56) -> ISNAT <$> decodeAnn
(0x03, 0x12) -> ADD <$> decodeAnn
(0x03, 0x4B) -> SUB <$> decodeAnn
(0x03, 0x3A) -> MUL <$> decodeAnn
(0x03, 0x22) -> EDIV <$> decodeAnn
(0x03, 0x11) -> ABS <$> decodeAnn
(0x03, 0x3B) -> NEG <$> decodeAnn
(0x03, 0x35) -> LSL <$> decodeAnn
(0x03, 0x36) -> LSR <$> decodeAnn
(0x03, 0x41) -> OR <$> decodeAnn
(0x03, 0x14) -> AND <$> decodeAnn
(0x03, 0x51) -> XOR <$> decodeAnn
(0x03, 0x3F) -> NOT <$> decodeAnn
(0x03, 0x19) -> COMPARE <$> decodeAnn
(0x03, 0x25) -> EQ <$> decodeAnn
(0x03, 0x3C) -> NEQ <$> decodeAnn
(0x03, 0x37) -> LT <$> decodeAnn
(0x03, 0x2A) -> GT <$> decodeAnn
(0x03, 0x32) -> LE <$> decodeAnn
(0x03, 0x28) -> GE <$> decodeAnn
(0x03, 0x30) -> INT <$> decodeAnn
(0x05, 0x55) -> CONTRACT <$> decodeAnn <*> decodeAnn <*> decodeType
(0x03, 0x4D) -> TRANSFER_TOKENS <$> decodeAnn
(0x03, 0x4E) -> SET_DELEGATE <$> decodeAnn
(0x05, 0x1D) ->
decodeAsList $ do
an1 <- decodeAnn
an2 <- decodeAnn
expectTag "Pre contract parameter" 0x05
expectTag "Contract parameter" 0x00
p <- decodeType
expectTag "Pre contract storage" 0x05
expectTag "Contract storage" 0x01
s <- decodeType
expectTag "Pre contract code" 0x05
expectTag "Contract code" 0x02
c <- decodeOps
return $ CREATE_CONTRACT an1 an2 (Contract p s c)
(0x03, 0x1E) -> IMPLICIT_ACCOUNT <$> decodeAnn
(0x03, 0x40) -> NOW <$> decodeAnn
(0x03, 0x13) -> AMOUNT <$> decodeAnn
(0x03, 0x15) -> BALANCE <$> decodeAnn
(0x03, 0x18) -> CHECK_SIGNATURE <$> decodeAnn
(0x03, 0x0F) -> SHA256 <$> decodeAnn
(0x03, 0x10) -> SHA512 <$> decodeAnn
(0x03, 0x0E) -> BLAKE2B <$> decodeAnn
(0x03, 0x2B) -> HASH_KEY <$> decodeAnn
(0x03, 0x4A) -> STEPS_TO_QUOTA <$> decodeAnn
(0x03, 0x47) -> SOURCE <$> decodeAnn
(0x03, 0x48) -> SENDER <$> decodeAnn
(0x03, 0x54) -> ADDRESS <$> decodeAnn
(0x03, 0x75) -> CHAIN_ID <$> decodeAnn
(other1, other2) -> fail $ "Unknown instruction tag: 0x" +|
hexF other1 |+ hexF other2 |+ ""
decodeOp :: Get ExpandedOp
decodeOp = Get.label "Op" $ do
tag <- Get.lookAhead Get.getWord8
if tag == 0x02
then SeqEx <$> decodeOps ? "Ops seq"
else PrimEx <$> decodeInstr ? "One op"
decodeOps :: Get [ExpandedOp]
decodeOps = decodeAsList $ manyForced decodeOp
decodeComparable :: Get Comparable
decodeComparable = Get.label "Comparable primitive type" $
Comparable <$> decodeCT <*> decodeAnn
decodeCT :: Get CT
decodeCT = Get.label "CT" $ do
pretag <- Get.getWord8 ? "Pre simple comparable type tag"
tag <- Get.getWord8 ? "Simple comparable type tag"
case (pretag, tag) of
(0x03, 0x5B) -> pure CInt
(0x03, 0x62) -> pure CNat
(0x03, 0x68) -> pure CString
(0x03, 0x69) -> pure CBytes
(0x03, 0x6A) -> pure CMutez
(0x03, 0x59) -> pure CBool
(0x03, 0x5D) -> pure CKeyHash
(0x03, 0x6B) -> pure CTimestamp
(0x03, 0x6E) -> pure CAddress
(other1, other2) -> fail $ "Unknown primitive tag: 0x" +|
hexF other1 |+ hexF other2 |+ ""
decodeT :: Get T
decodeT = Get.label "T" $
doDecode <|> (Tc <$> decodeCT)
where
doDecode = do
pretag <- Get.getWord8 ? "Pre complex type tag"
tag <- Get.getWord8 ? "Complex type tag"
case (pretag, tag) of
(0x03, 0x5C) -> pure TKey
(0x03, 0x6C) -> pure TUnit
(0x03, 0x67) -> pure TSignature
(0x03, 0x74) -> pure TChainId
(0x05, 0x63) -> TOption <$> decodeType
(0x05, 0x5F) -> TList <$> decodeType
(0x05, 0x66) -> TSet <$> decodeComparable
(0x03, 0x6D) -> pure TOperation
(0x05, 0x5A) -> TContract <$> decodeType
(0x07, 0x65) -> TPair <$> decodeAnn <*> decodeAnn <*> decodeType <*> decodeType
(0x07, 0x64) -> TOr <$> decodeAnn <*> decodeAnn <*> decodeType <*> decodeType
(0x07, 0x5E) -> TLambda <$> decodeType <*> decodeType
(0x07, 0x60) -> TMap <$> decodeComparable <*> decodeType
(0x07, 0x61) -> TBigMap <$> decodeComparable <*> decodeType
(other1, other2) -> fail $ "Unknown primitive tag: 0x" +|
hexF other1 |+ hexF other2 |+ ""
decodeType :: Get Type
decodeType = Type <$> decodeT <*> decodeAnn ? "Type"