-- SPDX-FileCopyrightText: 2021 Oxhead Alpha -- SPDX-License-Identifier: LicenseRef-MIT-OA {-# LANGUAGE OverloadedLists #-} module Test.Serialization.Untyped.Michelson ( spec_Serialization ) where import Prelude hiding (Ordering(..)) import Data.Aeson qualified as J import Data.Aeson.QQ (aesonQQ) import Fmt (pretty) import Test.Hspec (Spec, describe, it, shouldSatisfy) import Test.Hspec.Expectations (expectationFailure) import Morley.Micheline (Expression, fromExpression, toExpression) import Morley.Michelson.Interpret (runUnpack) import Morley.Michelson.Interpret.Pack (packValue', packValuePrefix, toBinary') import Morley.Michelson.Interpret.Unpack (unpackUValue', unpackValue') import Morley.Michelson.Macro (expandList) import Morley.Michelson.Parser qualified as Parser import Morley.Michelson.Typed import Morley.Michelson.Untyped qualified as U import Morley.Tezos.Core (ChainId(..)) import Test.Cleveland.Instances (HasInstrCallStack(..)) import Test.Cleveland.Util import Test.Serialization.Util import Test.Util.Parser spec_Serialization :: Spec spec_Serialization = do describe "serialization tests for comparable values (CValue)" $ do unitTest intTest stringTest bytesTest boolTest optionTest orTest describe "serialization tests for non-comparable values" $ do seqTest mapTest describe "serialization tests for instructions" $ do instrTest typesTest deserializeNegTest readableDeserializeTest lengthsAreNotIgnoredTest deserializeIntAsNatTest deserializeComparablePairTest deserializeComparableOrTest deserializeComparableOptionTest deserializeComparablesTest deserializeSeqOfEmptySeqsTest -- | Test method that checks that the conversion result is equal -- to the result of 'tezos-client convert data ... from michelson to binary' toBinaryTestMethod :: HasCallStack => [TestMethod U.Value] toBinaryTestMethod = toBinaryTestMethodImpl (\v -> packValuePrefix <> toBinary' v) -- | Test method that checks that the conversion result is equal -- to the result of 'tezos-client convert data ... from binary to michelson' fromBinaryTestMethod :: HasCallStack => [TestMethod U.Value] fromBinaryTestMethod = fromBinaryTestMethodImpl unpackUValue' -- | Test method that checks that the conversion result is equal -- to the result of 'tezos-client convert data ... from michelson to json' toJsonTestMethod :: HasCallStack => [TestMethod U.Value] toJsonTestMethod = toJsonTestMethodImpl -- | Test method that checks that the conversion result is equal -- to the result of 'tezos-client convert data ... from json to michelson' fromJsonTestMethod :: HasCallStack => [TestMethod U.Value] fromJsonTestMethod = fromJsonTestMethodImpl @U.Value allTestMethods :: HasCallStack => [TestMethod U.Value] allTestMethods = mconcat [ toBinaryTestMethod , fromBinaryTestMethod , toJsonTestMethod , fromJsonTestMethod ] serializeSpecManual :: HasCallStack => String -> [TestMethod U.Value] -> [Example (U.Value, (Text, J.Value))] -> Spec serializeSpecManual = serializeSpecManualImpl id serializeSpec :: HasCallStack => String -> [Example (U.Value, (Text, J.Value))] -> Spec serializeSpec name = serializeSpecManual name allTestMethods parseSerializeSpec :: HasCallStack => String -> [(Text, (Text, J.Value))] -> Spec parseSerializeSpec name suites = parseLambdaSpec name allTestMethods suites parseDeserializeOnlySpec :: String -> [(Text, (Text, J.Value))] -> Spec parseDeserializeOnlySpec name suites = parseLambdaSpec name (fromBinaryTestMethod <> fromJsonTestMethod) suites parseLambdaSpec :: String -> [TestMethod U.Value] -> [(Text, (Text, J.Value))] -> Spec parseLambdaSpec name testMethods suites = forM_ @[_] testMethods $ \(TestMethod mname method) -> describe mname $ describe name $ forM_ suites $ \(codeText, (packed, json)) -> it (truncateName $ toString codeText) $ do parsed <- Parser.codeEntry `shouldParse` ("{" <> codeText <> "}") let code = expandList parsed let lambda = withoutIcs . U.ValueLambda <$> (nonEmpty code) ?: U.ValueNil method lambda packed json where truncateName s | length s < 60 = s | otherwise = take 60 s <> " ..." unpackNegSpec :: String -> Text -> Spec unpackNegSpec name encodedHex = it name $ let encoded = unsafe . fromHex $ stripOptional0x encodedHex in unpackUValue' encoded `shouldSatisfy` isLeft deserializeNegSpec :: String -> Text -> J.Value -> Spec deserializeNegSpec = deserializeNegSpecImpl @U.Value unpackUValue' intTest :: Spec intTest = serializeSpec "ValueInt" [ Example "-64" $ U.ValueInt -64 ~: "0500c001" ~: [aesonQQ| { "int": "-64" } |] , Example "-63" $ U.ValueInt -63 ~: "05007f" ~: [aesonQQ| { "int": "-63"} |] , Example "-2" $ U.ValueInt -2 ~: "050042" ~: [aesonQQ| { "int": "-2"} |] , Example "-1" $ U.ValueInt -1 ~: "050041" ~: [aesonQQ| { "int": "-1"} |] , Example "0" $ U.ValueInt 0 ~: "050000" ~: [aesonQQ| { "int": "0"} |] , Example "1" $ U.ValueInt 1 ~: "050001" ~: [aesonQQ| { "int": "1"} |] , Example "2" $ U.ValueInt 2 ~: "050002" ~: [aesonQQ| { "int": "2"} |] , Example "63" $ U.ValueInt 63 ~: "05003f" ~: [aesonQQ| { "int": "63"} |] , Example "64" $ U.ValueInt 64 ~: "05008001" ~: [aesonQQ| { "int": "64"} |] , Example "65" $ U.ValueInt 65 ~: "05008101" ~: [aesonQQ| { "int": "65"} |] , Example "-65" $ U.ValueInt -65 ~: "0500c101" ~: [aesonQQ| { "int": "-65"} |] , Example "127" $ U.ValueInt 127 ~: "0500bf01" ~: [aesonQQ| { "int": "127"} |] , Example "128" $ U.ValueInt 128 ~: "05008002" ~: [aesonQQ| { "int": "128"} |] , Example "129" $ U.ValueInt 129 ~: "05008102" ~: [aesonQQ| { "int": "129"} |] , Example "-127" $ U.ValueInt -127 ~: "0500ff01" ~: [aesonQQ| { "int": "-127"} |] , Example "191" $ U.ValueInt 191 ~: "0500bf02" ~: [aesonQQ| { "int": "191"} |] , Example "192" $ U.ValueInt 192 ~: "05008003" ~: [aesonQQ| { "int": "192"} |] , Example "193" $ U.ValueInt 193 ~: "05008103" ~: [aesonQQ| { "int": "193"} |] , Example "2028" $ U.ValueInt 2028 ~: "0500ac1f" ~: [aesonQQ| { "int": "2028"} |] , Example "5000" $ U.ValueInt 5000 ~: "0500884e" ~: [aesonQQ| { "int": "5000"} |] , Example "10000" $ U.ValueInt 10000 ~: "0500909c01" ~: [aesonQQ| { "int": "10000"} |] , Example "20000" $ U.ValueInt 20000 ~: "0500a0b802" ~: [aesonQQ| { "int": "20000"} |] , Example "-5000" $ U.ValueInt -5000 ~: "0500c84e" ~: [aesonQQ| { "int": "-5000"} |] , Example "-10000" $ U.ValueInt -10000 ~: "0500d09c01" ~: [aesonQQ| { "int": "-10000"} |] , Example "-20000" $ U.ValueInt-20000 ~: "0500e0b802" ~: [aesonQQ| { "int": "-20000"} |] ] stringTest :: Spec stringTest = serializeSpec "ValueString" [ Example "Hello World!" $ (U.ValueString "Hello World!") ~: "05010000000c48656c6c6f20576f726c6421" ~: [aesonQQ| { "string": "Hello World!" } |] , Example "HODL: Hold On for Dear Life" $ (U.ValueString "HODL: Hold On for Dear Life") ~: "05010000001b484f444c3a20486f6c64204f6e20666f722044656172204c696665" ~: [aesonQQ| { "string": "HODL: Hold On for Dear Life" } |] , Example "Newline" $ (U.ValueString "\n") ~: "0501000000010a" ~: [aesonQQ| { "string": "\n" } |] ] bytesTest :: Spec bytesTest = serializeSpec "ValueBytes" [ Example "Numerical" $ (U.ValueBytes $ U.InternalByteString "000123") ~: "050a00000006303030313233" -- > Text.Hex.encodeHex "000123" ~: [aesonQQ| { "bytes": "303030313233"} |] , Example "Alphabetical" $ (U.ValueBytes $ U.InternalByteString "A rose by any other name would smell as sweet") ~: "050a0000002d4120726f736520627920616e79206f74686572206e616\ \d6520776f756c6420736d656c6c206173207377656574" -- > Text.Hex.encodeHex "A rose by any other name would smell as sweet" ~: [aesonQQ| { "bytes": "4120726f736520627920616e79206f74686572206e616d6520776f756c6420736d656c6c206173207377656574" } |] ] boolTest :: Spec boolTest = serializeSpec "ValueTrue, ValueFalse" [ Example "True" $ U.ValueTrue ~: "05030a" ~: [aesonQQ| { "prim": "True"} |] , Example "False" $ U.ValueFalse ~: "050303" ~: [aesonQQ| { "prim": "False"} |] ] unitTest :: Spec unitTest = serializeSpec "ValueUnit" [ Example "Unit" $ U.ValueUnit ~: "05030b" ~: [aesonQQ|{ "prim": "Unit" }|] ] optionTest :: Spec optionTest = do serializeSpec "ValueSome" [ Example "Just" $ (U.ValueSome $ U.ValueInt 123) ~: "05050900bb01" ~: [aesonQQ| { "prim": "Some", "args": [ { "int": "123" } ] } |] , Example "Nothing" $ U.ValueNone ~: "050306" ~: [aesonQQ| { "prim": "None" } |] ] serializeSpec "ValueSome" [ Example "Just" $ (U.ValueSome $ U.ValueString "Goodnight World!") ~: "0505090100000010476f6f646e6967687420576f726c6421" ~: [aesonQQ| { "prim": "Some", "args": [ { "string": "Goodnight World!" } ] } |] ] seqTest :: Spec seqTest = serializeSpec "ValueSeq" [ Example "Empty seq" $ U.ValueNil ~: "050200000000" ~: [aesonQQ| [] |] , Example "Singleton seq" $ (U.ValueSeq $ U.ValueInt 1 :| []) ~: "0502000000020001" ~: [aesonQQ| [ { "int": "1" } ] |] , Example "Seq with many elements" $ (U.ValueSeq $ U.ValueInt 1 :| [U.ValueInt 2, U.ValueInt 3]) ~: "050200000006000100020003" ~: [aesonQQ| [ { "int": "1" }, { "int": "2" }, { "int": "3" } ] |] ] orTest :: Spec orTest = serializeSpec "ValueLeft, ValueRight" [ Example "Left" $ (U.ValueLeft $ U.ValueString "Error") ~: "05050501000000054572726f72" ~: [aesonQQ| { "prim": "Left", "args": [ { "string": "Error" } ] } |] , Example "Right" $ U.ValueRight U.ValueTrue ~: "050508030a" ~: [aesonQQ| { "prim": "Right", "args": [ { "prim": "True" } ] } |] ] mapTest :: Spec mapTest = do serializeSpec "ValueMap" [ Example "Empty map" $ U.ValueNil ~: "050200000000" ~: [aesonQQ| [] |] , Example "Non-empty map" $ (U.ValueMap $ (U.Elt (U.ValueInt 0) (U.ValueString "Hello")) :| [ U.Elt (U.ValueInt 1) (U.ValueString "Goodbye") , U.Elt (U.ValueInt 2) (U.ValueString "Goodnight") ]) ~: "05020000003007040000010000000548656c6c6f07040001010000000\ \7476f6f64627965070400020100000009476f6f646e69676874" ~: [aesonQQ| [ { "prim": "Elt", "args": [ { "int": "0" }, { "string": "Hello" } ] }, { "prim": "Elt", "args": [ { "int": "1" }, { "string": "Goodbye" } ] }, { "prim": "Elt", "args": [ { "int": "2" }, { "string": "Goodnight" } ] } ] |] ] serializeSpec "ValueMap" $ examples [ (U.ValueMap $ (U.Elt (U.ValueString "Lancaster") (U.ValueSeq $ (U.ValueInt 22323) :| [U.ValueFalse])) :| [ U.Elt (U.ValueString "Stuart") (U.ValueSeq $ (U.ValueInt -832988) :| [U.ValueTrue]) , U.Elt (U.ValueString "Tudor") (U.ValueSeq $ (U.ValueInt 123) :| [U.ValueTrue]) ]) ~: "050200000049070401000000094c616e636173746572020000000600b3\ \dc02030307040100000006537475617274020000000600dcd765030a07\ \0401000000055475646f72020000000500bb01030a" ~: [aesonQQ| [ { "prim": "Elt", "args": [ { "string": "Lancaster" }, [ { "int": "22323" }, { "prim": "False" } ] ] }, { "prim": "Elt", "args": [ { "string": "Stuart" }, [ { "int": "-832988" }, { "prim": "True" } ] ] }, { "prim": "Elt", "args": [ { "string": "Tudor" }, [ { "int": "123" }, { "prim": "True" } ] ] } ] |] ] instrTest :: Spec instrTest = do -- The binary values we compare against are produced with command -- > tezos-client convert data "{ $instrs }" from michelson to binary -- -- The json values are produced with: -- > tezos-client convert data '{ $instrs }' from michelson to json parseSerializeSpec "instr" [ "" ~: "0x050200000000" ~: [aesonQQ| [] |] , "PUSH int 1; DROP" ~: "0x0502000000080743035b00010320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "DROP" } ] |] , "DUP; SWAP; DROP" ~: "0x0502000000060321034c0320" ~: [aesonQQ| [ { "prim": "DUP" }, { "prim": "SWAP" }, { "prim": "DROP" } ] |] , "DUP 1; SWAP; DROP" ~: "0x05020000000805210001034c0320" ~: [aesonQQ| [ { "prim": "DUP", "args": [ { "int": "1" } ] }, { "prim": "SWAP" }, { "prim": "DROP" } ] |] , "PUSH nat 1; PUSH nat 1; DUP 2; DROP; DROP; DROP" ~: "0x05020000001607430362000107430362000105210002032003200320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "nat" }, { "int": "1" } ] }, { "prim": "PUSH", "args": [ { "prim": "nat" }, { "int": "1" } ] }, { "prim": "DUP", "args": [ { "int": "2" } ] }, { "prim": "DROP" }, { "prim": "DROP" }, { "prim": "DROP" } ] |] , "UNIT; DUUP; DROP 2" ~: "0x05020000000a034f0521000205200002" ~: [aesonQQ| [ { "prim": "UNIT" }, { "prim": "DUP", "args": [ { "int": "2" } ] }, { "prim": "DROP", "args": [ { "int": "2" } ] } ] |] , "UNIT; UNIT; DUUUP; DROP 3" ~: "0x05020000000c034f034f0521000305200003" ~: [aesonQQ| [ { "prim": "UNIT" }, { "prim": "UNIT" }, { "prim": "DUP", "args": [ { "int": "3" } ] }, { "prim": "DROP", "args": [ { "int": "3" } ] } ] |] , "DIG 0" ~: "0x05020000000405700000" ~: [aesonQQ| [ { "prim": "DIG", "args": [ { "int": "0" } ] } ] |] , "UNIT; DIG 1; DIP { DROP }" ~: "0x05020000000f034f05700001051f02000000020320" ~: [aesonQQ| [ { "prim": "UNIT" }, { "prim": "DIG", "args": [ { "int": "1" } ] }, { "prim": "DIP", "args": [ [ { "prim": "DROP" } ] ] } ] |] , "DUG 0" ~: "0x05020000000405710000" ~: [aesonQQ| [ { "prim": "DUG", "args": [ { "int": "0" } ] } ] |] , "UNIT; DUG 1; DIP { DROP }" ~: "0x05020000000f034f05710001051f02000000020320" ~: [aesonQQ| [ { "prim": "UNIT" }, { "prim": "DUG", "args": [ { "int": "1" } ] }, { "prim": "DIP", "args": [ [ { "prim": "DROP" } ] ] } ] |] , "UNIT; DROP" ~: "0x050200000004034f0320" ~: [aesonQQ| [ { "prim": "UNIT" }, { "prim": "DROP" } ] |] , "UNIT :u; DROP" ~: "0x05020000000a044f000000023a750320" ~: [aesonQQ| [ { "prim": "UNIT", "annots": [ ":u" ] }, { "prim": "DROP" } ] |] , "UNIT; DROP 1" ~: "0x050200000006034f05200001" ~: [aesonQQ| [ { "prim": "UNIT" }, { "prim": "DROP", "args": [ { "int": "1" } ] } ] |] , "DROP 0" ~: "0x05020000000405200000" ~: [aesonQQ| [ { "prim": "DROP", "args": [ { "int": "0" } ] } ] |] , "UNIT; UNIT; UNIT; DROP 3" ~: "0x05020000000a034f034f034f05200003" ~: [aesonQQ| [ { "prim": "UNIT" }, { "prim": "UNIT" }, { "prim": "UNIT" }, { "prim": "DROP", "args": [ { "int": "3" } ] } ] |] , "PUSH int 1; SOME; IF_NONE {} {DROP}" ~: "0x0502000000160743035b00010346072f020000000002000000020320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "SOME" }, { "prim": "IF_NONE", "args": [ [], [ { "prim": "DROP" } ] ] } ] |] , "PUSH int 1; SOME; IF_SOME {DROP} {}" ~: "0x05020000001b0743035b00010346020000000e072f020000000002000000020320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "SOME" }, [ { "prim": "IF_NONE", "args": [ [], [ { "prim": "DROP" } ] ] } ] ] |] , "PUSH int 1; SOME :s; IF_SOME {DROP} {}" ~: "0x0502000000210743035b00010446000000023a73020000000e072f020000000\ \002000000020320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "SOME", "annots": [ ":s" ] }, [ { "prim": "IF_NONE", "args": [ [], [ { "prim": "DROP" } ] ] } ] ] |] , "NONE int; DROP" ~: "0x050200000006053e035b0320" ~: [aesonQQ| [ { "prim": "NONE", "args": [ { "prim": "int" } ] }, { "prim": "DROP" } ] |] , "NONE :n int; DROP" ~: "0x05020000000c063e035b000000023a6e0320" ~: [aesonQQ| [ { "prim": "NONE", "args": [ { "prim": "int" } ], "annots": [ ":n" ] }, { "prim": "DROP" } ] |] , "PUSH int 1; PAIR; CAR" ~: "0x05020000000a0743035b000103420316" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "PAIR" }, { "prim": "CAR" } ] |] , "PUSH int 1; PAIR %a %b; CAR @%" ~: "0x0502000000190743035b000104420000000525612025620416000000024025" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "PAIR", "annots": [ "%a", "%b" ] }, { "prim": "CAR", "annots": [ "@%" ] } ] |] , "PUSH int 1; PAIR %a %b; CAR @%%" ~: "0x05020000001a0743035b00010442000000052561202562041600000003402525" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "PAIR", "annots": [ "%a", "%b" ] }, { "prim": "CAR", "annots": [ "@%%" ] } ] |] , "PUSH int 1; PAIR :p; CAR" ~: "0x0502000000100743035b00010442000000023a700316" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "PAIR", "annots": [ ":p" ] }, { "prim": "CAR" } ] |] , "PUSH int 1; PAIR % %o; CAR" ~: "0x0502000000120743035b00010442000000042520256f0316" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "PAIR", "annots": [ "%", "%o" ] }, { "prim": "CAR" } ] |] , "PUSH int 1; PAIR %o %; CAR" ~: "0x0502000000100743035b0001044200000002256f0316" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "PAIR", "annots": [ "%o" ] }, { "prim": "CAR" } ] |] , "PUSH int 1; PAIR %o; CAR" ~: "0x0502000000100743035b0001044200000002256f0316" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "PAIR", "annots": [ "%o" ] }, { "prim": "CAR" } ] |] , "PUSH int 1; PAIR :p %l %r; CAR" ~: "0x0502000000160743035b00010442000000083a7020256c2025720316" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "PAIR", "annots": [ ":p", "%l", "%r" ] }, { "prim": "CAR" } ] |] , "PUSH int 1; PAIR %l %r; CAR %l" ~: "0x0502000000190743035b0001044200000005256c202572041600000002256c" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "PAIR", "annots": [ "%l", "%r" ] }, { "prim": "CAR", "annots": [ "%l" ] } ] |] , "PUSH int 1; PAIR %l %r; CDR %r" ~: "0x0502000000190743035b0001044200000005256c2025720417000000022572" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "PAIR", "annots": [ "%l", "%r" ] }, { "prim": "CDR", "annots": [ "%r" ] } ] |] , "PUSH int 1; PAIR %l %r; CDR @%" ~: "0x0502000000190743035b0001044200000005256c2025720417000000024025" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "PAIR", "annots": [ "%l", "%r" ] }, { "prim": "CDR", "annots": [ "@%" ] } ] |] , "PUSH int 1; PAIR %l %r; CDR @%%" ~: "0x05020000001a0743035b0001044200000005256c202572041700000003402525" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "PAIR", "annots": [ "%l", "%r" ] }, { "prim": "CDR", "annots": [ "@%%" ] } ] |] , "PUSH int 1; PAIR % %@; CAR" ~: "0x0502000000120743035b0001044200000004252025400316" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "PAIR", "annots": [ "%", "%@" ] }, { "prim": "CAR" } ] |] , "PUSH int 1; PAIR :p % %@ @p; CAR" ~: "0x0502000000180743035b000104420000000a3a7020252025402040700316" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "PAIR", "annots": [ ":p", "%", "%@", "@p" ] }, { "prim": "CAR" } ] |] , "PUSH int 1; PAIR 2; CAR" ~: "0x05020000000c0743035b0001054200020316" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "PAIR", "args": [ { "int": "2" } ] }, { "prim": "CAR" } ] |] , "PUSH nat 1; PUSH bool True; PUSH int 1; PAIR 4; CAR" ~: "0x05020000001807430362000107430359030a0743035b0001054200040316" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "nat" }, { "int": "1" } ] }, { "prim": "PUSH", "args": [ { "prim": "bool" }, { "prim": "True" } ] }, { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "PAIR", "args": [ { "int": "4" } ] }, { "prim": "CAR" } ] |] , "DUP; DUP; DUP; PAIR 4; UNPAIR 3; DIP { DROP 2 }" ~: "0x05020000001903210321032105420004057a0003051f020000000405200002" ~: [aesonQQ| [ { "prim": "DUP" }, { "prim": "DUP" }, { "prim": "DUP" }, { "prim": "PAIR", "args": [ { "int": "4" } ] }, { "prim": "UNPAIR", "args": [ { "int": "3" } ] }, { "prim": "DIP", "args": [ [ { "prim": "DROP", "args": [ { "int": "2" } ] } ] ] } ] |] , "DUP; PAIR; UNPAIR %a %b @c @d; DROP;" ~: "0x05020000001703210342047a0000000b25612025622040632040640320" ~: [aesonQQ| [ { "prim": "DUP" }, { "prim": "PAIR" }, { "prim": "UNPAIR", "annots": [ "%a", "%b", "@c", "@d" ] }, { "prim": "DROP" } ] |] , "DUP; PAIR; UNPAIR @% @%%; DROP;" ~: "0x05020000001203210342047a000000064025204025250320" ~: [aesonQQ| [ { "prim": "DUP" }, { "prim": "PAIR" }, { "prim": "UNPAIR", "annots": [ "@%", "@%%" ] }, { "prim": "DROP" } ] |] , "LEFT unit; IF_LEFT {} { DROP; PUSH int 1 }" ~: "0x0502000000180533036c072e0200000000020000000803200743035b0001" ~: [aesonQQ| [ { "prim": "LEFT", "args": [ { "prim": "unit" } ] }, { "prim": "IF_LEFT", "args": [ [], [ { "prim": "DROP" }, { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] } ] ] } ] |] , "LEFT :lu %l %r unit; IF_LEFT {} { DROP; PUSH int 1 }" ~: "0x0502000000250633036c000000093a6c7520256c202572072e0200000000020\ \000000803200743035b0001" ~: [aesonQQ| [ { "prim": "LEFT", "args": [ { "prim": "unit" } ], "annots": [ ":lu", "%l", "%r" ] }, { "prim": "IF_LEFT", "args": [ [], [ { "prim": "DROP" }, { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] } ] ] } ] |] , "RIGHT unit; IF_RIGHT {} { DROP; PUSH int 1 }" ~: "0x05020000001d0544036c0200000014072e020000000803200743035b00010200000000" ~: [aesonQQ| [ { "prim": "RIGHT", "args": [ { "prim": "unit" } ] }, [ { "prim": "IF_LEFT", "args": [ [ { "prim": "DROP" }, { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] } ], [] ] } ] ] |] , "LEFT :lu %l unit; IF_LEFT {} { DROP; PUSH int 1 }" ~: "0x0502000000220633036c000000063a6c7520256c072e0200000000020000000\ \803200743035b0001" ~: [aesonQQ| [ { "prim": "LEFT", "args": [ { "prim": "unit" } ], "annots": [ ":lu", "%l" ] }, { "prim": "IF_LEFT", "args": [ [], [ { "prim": "DROP" }, { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] } ] ] } ] |] , "RIGHT :lu %l unit; IF_RIGHT {} { DROP; PUSH int 1 }" ~: "0x0502000000270644036c000000063a6c7520256c0200000014072e020000000\ \803200743035b00010200000000" ~: [aesonQQ| [ { "prim": "RIGHT", "args": [ { "prim": "unit" } ], "annots": [ ":lu", "%l" ] }, [ { "prim": "IF_LEFT", "args": [ [ { "prim": "DROP" }, { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] } ], [] ] } ] ] |] , "LEFT :lu %@ %r unit; IF_LEFT {} { DROP; PUSH int 1 }" ~: "0x0502000000250633036c000000093a6c75202540202572072e0200000000020\ \000000803200743035b0001" ~: [aesonQQ| [ { "prim": "LEFT", "args": [ { "prim": "unit" } ], "annots": [ ":lu", "%@", "%r" ] }, { "prim": "IF_LEFT", "args": [ [], [ { "prim": "DROP" }, { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] } ] ] } ] |] , "LEFT :lu %@ %r @vl unit; IF_LEFT {} { DROP; PUSH int 1 }" ~: "0x0502000000290633036c0000000d3a6c752025402025722040766c072e020\ \0000000020000000803200743035b0001" ~: [aesonQQ| [ { "prim": "LEFT", "args": [ { "prim": "unit" } ], "annots": [ ":lu", "%@", "%r", "@vl" ] }, { "prim": "IF_LEFT", "args": [ [], [ { "prim": "DROP" }, { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] } ] ] } ] |] , "RIGHT :ru % %@ unit; IF_RIGHT {} { DROP; PUSH int 1 }" ~: "0x0502000000290644036c000000083a727520252025400200000014072e020\ \000000803200743035b00010200000000" ~: [aesonQQ| [ { "prim": "RIGHT", "args": [ { "prim": "unit" } ], "annots": [ ":ru", "%", "%@" ] }, [ { "prim": "IF_LEFT", "args": [ [ { "prim": "DROP" }, { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] } ], [] ] } ] ] |] , "RIGHT :ru % %@ @vr unit; IF_RIGHT {} { DROP; PUSH int 1 }" ~: "0x05020000002d0644036c0000000c3a72752025202540204076720200000014072e020\ \000000803200743035b00010200000000" ~: [aesonQQ| [ { "prim": "RIGHT", "args": [ { "prim": "unit" } ], "annots": [ ":ru", "%", "%@", "@vr" ] }, [ { "prim": "IF_LEFT", "args": [ [ { "prim": "DROP" }, { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] } ], [] ] } ] ] |] , "DUP; NIL int; SWAP; CONS; SIZE; DROP" ~: "0x05020000000e0321053d035b034c031b03450320" ~: [aesonQQ| [ { "prim": "DUP" }, { "prim": "NIL", "args": [ { "prim": "int" } ] }, { "prim": "SWAP" }, { "prim": "CONS" }, { "prim": "SIZE" }, { "prim": "DROP" } ] |] , "NIL int; IF_CONS { DROP; DROP } {}" ~: "0x050200000014053d035b072d0200000004032003200200000000" ~: [aesonQQ| [ { "prim": "NIL", "args": [ { "prim": "int" } ] }, { "prim": "IF_CONS", "args": [ [ { "prim": "DROP" }, { "prim": "DROP" } ], [] ] } ] |] , "NIL :ni int; IF_CONS { DROP; DROP } {}" ~: "0x05020000001b063d035b000000033a6e69072d0200000004032003200200000000" ~: [aesonQQ| [ { "prim": "NIL", "args": [ { "prim": "int" } ], "annots": [ ":ni" ] }, { "prim": "IF_CONS", "args": [ [ { "prim": "DROP" }, { "prim": "DROP" } ], [] ] } ] |] , "EMPTY_SET int; ITER { DROP }" ~: "0x05020000000d0524035b055202000000020320" ~: [aesonQQ| [ { "prim": "EMPTY_SET", "args": [ { "prim": "int" } ] }, { "prim": "ITER", "args": [ [ { "prim": "DROP" } ] ] } ] |] , "EMPTY_SET :si int; ITER { DROP }" ~: "0x0502000000140624035b000000033a7369055202000000020320" ~: [aesonQQ| [ { "prim": "EMPTY_SET", "args": [ { "prim": "int" } ], "annots": [ ":si" ] }, { "prim": "ITER", "args": [ [ { "prim": "DROP" } ] ] } ] |] , "EMPTY_MAP int unit; MAP {}; DROP" ~: "0x05020000000f0723035b036c053802000000000320" ~: [aesonQQ| [ { "prim": "EMPTY_MAP", "args": [ { "prim": "int" }, { "prim": "unit" } ] }, { "prim": "MAP", "args": [ [] ] }, { "prim": "DROP" } ] |] , "EMPTY_MAP :miu int unit; MAP {}; DROP" ~: "0x0502000000170823035b036c000000043a6d6975053802000000000320" ~: [aesonQQ| [ { "prim": "EMPTY_MAP", "args": [ { "prim": "int" }, { "prim": "unit" } ], "annots": [ ":miu" ] }, { "prim": "MAP", "args": [ [] ] }, { "prim": "DROP" } ] |] , "EMPTY_MAP int unit; PUSH int 1; MEM; DROP" ~: "0x0502000000100723035b036c0743035b000103390320" ~: [aesonQQ| [ { "prim": "EMPTY_MAP", "args": [ { "prim": "int" }, { "prim": "unit" } ] }, { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "MEM" }, { "prim": "DROP" } ] |] , "EMPTY_MAP int unit; PUSH int 1; GET; DROP" ~: "0x0502000000100723035b036c0743035b000103290320" ~: [aesonQQ| [ { "prim": "EMPTY_MAP", "args": [ { "prim": "int" }, { "prim": "unit" } ] }, { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "GET" }, { "prim": "DROP" } ] |] , "EMPTY_MAP int unit; NONE unit; PUSH int 1; UPDATE; DROP" ~: "0x0502000000140723035b036c053e036c0743035b000103500320" ~: [aesonQQ| [ { "prim": "EMPTY_MAP", "args": [ { "prim": "int" }, { "prim": "unit" } ] }, { "prim": "NONE", "args": [ { "prim": "unit" } ] }, { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "UPDATE" }, { "prim": "DROP" } ] |] , "EMPTY_MAP int unit; NONE unit; PUSH int 1; GET_AND_UPDATE; DROP 2" ~: "0x0502000000160723035b036c053e036c0743035b0001038c05200002" ~: [aesonQQ| [ { "prim": "EMPTY_MAP", "args": [ { "prim": "int" }, { "prim": "unit" } ] }, { "prim": "NONE", "args": [ { "prim": "unit" } ] }, { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "GET_AND_UPDATE" }, { "prim": "DROP", "args": [ { "int": "2" } ] } ] |] , "EMPTY_BIG_MAP int unit; PUSH int 1; GET; DROP" ~: "0x0502000000100772035b036c0743035b000103290320" ~: [aesonQQ| [ { "prim": "EMPTY_BIG_MAP", "args": [ { "prim": "int" }, { "prim": "unit" } ] }, { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "GET" }, { "prim": "DROP" } ] |] , "EMPTY_BIG_MAP :bmiu int unit; PUSH int 1; GET; DROP" ~: "0x0502000000190872035b036c000000053a626d69750743035b000103290320" ~: [aesonQQ| [ { "prim": "EMPTY_BIG_MAP", "args": [ { "prim": "int" }, { "prim": "unit" } ], "annots": [ ":bmiu" ] }, { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "GET" }, { "prim": "DROP" } ] |] , "PUSH int 1; PAIR; GET 1;" ~: "0x05020000000c0743035b0001034205290001" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "PAIR" }, { "prim": "GET", "args": [ { "int": "1" } ] } ] |] , "DUP; UPDATE 0;" ~: "0x050200000006032105500000" ~: [aesonQQ| [ { "prim": "DUP" }, { "prim": "UPDATE", "args": [ { "int": "0" } ] } ] |] , "PUSH bool True; IF {} {}" ~: "0x05020000001207430359030a072c02000000000200000000" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "bool" }, { "prim": "True" } ] }, { "prim": "IF", "args": [ [], [] ] } ] |] , "PUSH bool True; LOOP { PUSH bool False }" ~: "0x05020000001307430359030a05340200000006074303590303" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "bool" }, { "prim": "True" } ] }, { "prim": "LOOP", "args": [ [ { "prim": "PUSH", "args": [ { "prim": "bool" }, { "prim": "False" } ] } ] ] } ] |] , "PUSH (or int int) (Left 1); LOOP_LEFT { RIGHT int }; DROP" ~: "0x05020000001907430764035b035b05050001055302000000040544035b0320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "or", "args": [ { "prim": "int" }, { "prim": "int" } ] }, { "prim": "Left", "args": [ { "int": "1" } ] } ] }, { "prim": "LOOP_LEFT", "args": [ [ { "prim": "RIGHT", "args": [ { "prim": "int" } ] } ] ] }, { "prim": "DROP" } ] |] , "LAMBDA int int { PUSH int 1; DROP }; SWAP; EXEC" ~: "0x05020000001f093100000011035b035b02000000080743035b0001032000000000034c0326" ~: [aesonQQ| [ { "prim": "LAMBDA", "args": [ { "prim": "int" }, { "prim": "int" }, [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "DROP" } ] ] }, { "prim": "SWAP" }, { "prim": "EXEC" } ] |] , "DUP; LAMBDA (pair int int) int { CAR }; SWAP; APPLY; SWAP; EXEC" ~: "0x050200000023032109310000000f0765035b035b035b0200000002031600000000034c0373\ \034c0326" ~: [aesonQQ| [ { "prim": "DUP" }, { "prim": "LAMBDA", "args": [ { "prim": "pair", "args": [ { "prim": "int" }, { "prim": "int" } ] }, { "prim": "int" }, [ { "prim": "CAR" } ] ] }, { "prim": "SWAP" }, { "prim": "APPLY" }, { "prim": "SWAP" }, { "prim": "EXEC" } ] |] , "DIP {}" ~: "0x050200000007051f0200000000" ~: [aesonQQ| [ { "prim": "DIP", "args": [ [] ] } ] |] , "DIP 1 {}" ~: "0x050200000009071f00010200000000" ~: [aesonQQ| [ { "prim": "DIP", "args": [ { "int": "1" }, [] ] } ] |] , "DIP 0 {}" ~: "0x050200000009071f00000200000000" ~: [aesonQQ| [ { "prim": "DIP", "args": [ { "int": "0" }, [] ] } ] |] , "UNIT; UNIT; DIP 3 { UNIT; DROP }; DROP; DROP" ~: "0x050200000015034f034f071f00030200000004034f032003200320" ~: [aesonQQ| [ { "prim": "UNIT" }, { "prim": "UNIT" }, { "prim": "DIP", "args": [ { "int": "3" }, [ { "prim": "UNIT" }, { "prim": "DROP" } ] ] }, { "prim": "DROP" }, { "prim": "DROP" } ] |] , "UNIT; UNIT; DIIIP { UNIT; DROP }; DROP; DROP" ~: "0x050200000015034f034f071f00030200000004034f032003200320" ~: [aesonQQ| [ { "prim": "UNIT" }, { "prim": "UNIT" }, { "prim": "DIP", "args": [ { "int": "3" }, [ { "prim": "UNIT" }, { "prim": "DROP" } ] ] }, { "prim": "DROP" }, { "prim": "DROP" } ] |] , "FAILWITH" ~: "0x0502000000020327" ~: [aesonQQ| [ { "prim": "FAILWITH" } ] |] , "CAST int" ~: "0x0502000000040557035b" ~: [aesonQQ| [ { "prim": "CAST", "args": [ { "prim": "int" } ] } ] |] , "RENAME" ~: "0x0502000000020358" ~: [aesonQQ| [ { "prim": "RENAME" } ] |] , "DUP; PACK; UNPACK unit; DROP" ~: "0x05020000000a0321030c050d036c0320" ~: [aesonQQ| [ { "prim": "DUP" }, { "prim": "PACK" }, { "prim": "UNPACK", "args": [ { "prim": "unit" } ] }, { "prim": "DROP" } ] |] , "DUP; PACK; UNPACK :uu unit; DROP" ~: "0x0502000000110321030c060d036c000000033a75750320" ~: [aesonQQ| [ { "prim": "DUP" }, { "prim": "PACK" }, { "prim": "UNPACK", "args": [ { "prim": "unit" } ], "annots": [ ":uu" ] }, { "prim": "DROP" } ] |] , "PUSH string \"\"; DUP; CONCAT; DROP" ~: "0x05020000000f0743036801000000000321031a0320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "string" }, { "string": "" } ] }, { "prim": "DUP" }, { "prim": "CONCAT" }, { "prim": "DROP" } ] |] , "NIL string; CONCAT; DROP" ~: "0x050200000008053d0368031a0320" ~: [aesonQQ| [ { "prim": "NIL", "args": [ { "prim": "string" } ] }, { "prim": "CONCAT" }, { "prim": "DROP" } ] |] , "PUSH string \"\"; PUSH nat 1; PUSH nat 2; SLICE; DROP" ~: "0x050200000019074303680100000000074303620001074303620002036f0320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "string" }, { "string": "" } ] }, { "prim": "PUSH", "args": [ { "prim": "nat" }, { "int": "1" } ] }, { "prim": "PUSH", "args": [ { "prim": "nat" }, { "int": "2" } ] }, { "prim": "SLICE" }, { "prim": "DROP" } ] |] , "PUSH int 1; ISNAT; DROP" ~: "0x05020000000a0743035b000103560320" -- Arithmetic instructions are below ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "ISNAT" }, { "prim": "DROP" } ] |] , "PUSH nat 1; INT; DROP" ~: "0x05020000000a07430362000103300320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "nat" }, { "int": "1" } ] }, { "prim": "INT" }, { "prim": "DROP" } ] |] , "VIEW \"myview\" nat" ~: "0x05020000000f079001000000066d79766965770362" ~: [aesonQQ| [ { "prim": "VIEW", "args": [ { "string": "myview" }, { "prim": "nat" } ] } ] |] -- SELF cannot appear in lambda -- CONTRACT - IMPLICIT_ACCOUNT go below , "NOW; DROP" ~: "0x05020000000403400320" ~: [aesonQQ| [ { "prim": "NOW" }, { "prim": "DROP" } ] |] , "AMOUNT; DROP" ~: "0x05020000000403130320" ~: [aesonQQ| [ { "prim": "AMOUNT" }, { "prim": "DROP" } ] |] , "BALANCE; DROP" ~: "0x05020000000403150320" ~: [aesonQQ| [ { "prim": "BALANCE" }, { "prim": "DROP" } ] |] -- VOTING_POWER goes below , "TOTAL_VOTING_POWER; DROP" ~: "0x050200000004037c0320" ~: [aesonQQ| [ { "prim": "TOTAL_VOTING_POWER" }, { "prim": "DROP" } ] |] -- CHECK_SIGNATURE goes below , "PUSH bytes 0x; SHA256; DROP" ~: "0x05020000000d074303690a00000000030f0320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "bytes" }, { "bytes": "" } ] }, { "prim": "SHA256" }, { "prim": "DROP" } ] |] , "PUSH bytes 0x; SHA512; DROP" ~: "0x05020000000d074303690a0000000003100320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "bytes" }, { "bytes": "" } ] }, { "prim": "SHA512" }, { "prim": "DROP" } ] |] , "PUSH bytes 0x; BLAKE2B; DROP" ~: "0x05020000000d074303690a00000000030e0320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "bytes" }, { "bytes": "" } ] }, { "prim": "BLAKE2B" }, { "prim": "DROP" } ] |] , "PUSH bytes 0x; SHA3; DROP" ~: "0x05020000000d074303690a00000000037e0320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "bytes" }, { "bytes": "" } ] }, { "prim": "SHA3" }, { "prim": "DROP" } ] |] , "PUSH bytes 0x; KECCAK; DROP" ~: "0x05020000000d074303690a00000000037d0320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "bytes" }, { "bytes": "" } ] }, { "prim": "KECCAK" }, { "prim": "DROP" } ] |] , "PUSH (list (pair bls12_381_g1 bls12_381_g2)) {}; PAIRING_CHECK; DROP" ~: "0x0502000000130743055f0765038003810200000000037f0320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "list", "args": [ { "prim": "pair", "args": [ { "prim": "bls12_381_g1" }, { "prim": "bls12_381_g2" } ] } ] }, [] ] }, { "prim": "PAIRING_CHECK" }, { "prim": "DROP" } ] |] -- HASH_KEY goes below , "SOURCE; DROP" ~: "0x05020000000403470320" ~: [aesonQQ| [ { "prim": "SOURCE" }, { "prim": "DROP" } ] |] , "SENDER; DROP" ~: "0x05020000000403480320" ~: [aesonQQ| [ { "prim": "SENDER" }, { "prim": "DROP" } ] |] -- ADDRESS goes below , "CHAIN_ID; DROP" ~: "0x05020000000403750320" ~: [aesonQQ| [ { "prim": "CHAIN_ID" }, { "prim": "DROP" } ] |] , "LEVEL; DROP" ~: "0x05020000000403760320" ~: [aesonQQ| [ { "prim": "LEVEL" }, { "prim": "DROP" } ] |] , "SELF_ADDRESS; DROP" ~: "0x05020000000403770320" ~: [aesonQQ| [ { "prim": "SELF_ADDRESS" }, { "prim": "DROP" } ] |] , "PUSH nat 5; PUSH nat 5; TICKET; DROP" ~: "0x05020000001007430362000507430362000503880320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "nat" }, { "int": "5" } ] }, { "prim": "PUSH", "args": [ { "prim": "nat" }, { "int": "5" } ] }, { "prim": "TICKET" }, { "prim": "DROP" } ] |] -- other ticket-related instructions go below -- DUP macro , "PUSH nat 1; PUSH nat 1; DUUP; DROP; DROP; DROP" ~: "0x05020000001607430362000107430362000105210002032003200320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "nat" }, { "int": "1" } ] }, { "prim": "PUSH", "args": [ { "prim": "nat" }, { "int": "1" } ] }, { "prim": "DUP", "args": [ { "int": "2" } ] }, { "prim": "DROP" }, { "prim": "DROP" }, { "prim": "DROP" } ] |] -- CAR k and CDR k macros , "PUSH string \"owo\"; PUSH int 2; PAIR 3; CAR 0" ~: "0x05020000001f0743036801000000036f776f0743035b000205420003020000000405290001" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "string" }, { "string": "owo" } ] }, { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "2" } ] }, { "prim": "PAIR", "args": [ { "int": "3" } ] }, [ { "prim": "GET", "args": [ { "int": "1" } ] } ] ] |] , "PUSH string \"owo\"; PUSH nat 2; PAIR 3; CDR 0; CDR 2" ~: "0x0502000000280743036801000000036f776f07430362000205420003020000000405290000020000000405290004" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "string" }, { "string": "owo" } ] }, { "prim": "PUSH", "args": [ { "prim": "nat" }, { "int": "2" } ] }, { "prim": "PAIR", "args": [ { "int": "3" } ] }, [ { "prim": "GET", "args": [ { "int": "0" } ] } ], [ { "prim": "GET", "args": [ { "int": "4" } ] } ] ] |] , "DUP @dp; SWAP; DROP" ~: "0x05020000000d042100000003406470034c0320" ~: [aesonQQ| [ { "prim": "DUP", "annots": [ "@dp" ] }, { "prim": "SWAP" }, { "prim": "DROP" } ] |] , "DUP @y 1; SWAP; DROP" ~: "0x05020000000e06210001000000024079034c0320" ~: [aesonQQ| [ { "prim": "DUP", "args": [ { "int": "1" } ], "annots": [ "@y" ] }, { "prim": "SWAP" }, { "prim": "DROP" } ] |] , "UNIT @un; DROP" ~: "0x05020000000b044f0000000340756e0320" ~: [aesonQQ| [ { "prim": "UNIT", "annots": [ "@un" ] }, { "prim": "DROP" } ] |] , "NONE @nn int; DROP" ~: "0x05020000000d063e035b00000003406e6e0320" ~: [aesonQQ| [ { "prim": "NONE", "args": [ { "prim": "int" } ], "annots": [ "@nn" ] }, { "prim": "DROP" } ] |] , "PUSH @vn int 1; PAIR @vpn; CAR @vn" ~: "0x0502000000200843035b00010000000340766e0442000000044076706e0416\ \0000000340766e" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ], "annots": [ "@vn" ] }, { "prim": "PAIR", "annots": [ "@vpn" ] }, { "prim": "CAR", "annots": [ "@vn" ] } ] |] , "PUSH int 1; PAIR @ 2; CAR" ~: "0x05020000000c0743035b0001054200020316" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "PAIR", "args": [ { "int": "2" } ] }, { "prim": "CAR" } ] |] , "PUSH int 1; PAIR @x 2; CAR" ~: "0x0502000000120743035b0001064200020000000240780316" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "PAIR", "args": [ { "int": "2" } ], "annots": [ "@x" ] }, { "prim": "CAR" } ] |] , "PUSH @a int 1; PAIR @x 2; CAR" ~: "0x0502000000180843035b0001000000024061064200020000000240780316" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ], "annots": [ "@a" ] }, { "prim": "PAIR", "args": [ { "int": "2" } ], "annots": [ "@x" ] }, { "prim": "CAR" } ] |] , "PUSH nat 1; PUSH bool True; PUSH int 1; PAIR @x 4; CAR" ~: "0x05020000001e07430362000107430359030a0743035b0001064200040000000240780316" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "nat" }, { "int": "1" } ] }, { "prim": "PUSH", "args": [ { "prim": "bool" }, { "prim": "True" } ] }, { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "PAIR", "args": [ { "int": "4" } ], "annots": [ "@x" ] }, { "prim": "CAR" } ] |] , "PUSH @a nat 1; PUSH @b bool True; PUSH @c int 1; PAIR @x 4; CAR" ~: "0x05020000003008430362000100000002406108430359030a0000000240620843035b0001000000024063064200040000000240780316" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "nat" }, { "int": "1" } ], "annots": [ "@a" ] }, { "prim": "PUSH", "args": [ { "prim": "bool" }, { "prim": "True" } ], "annots": [ "@b" ] }, { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ], "annots": [ "@c" ] }, { "prim": "PAIR", "args": [ { "int": "4" } ], "annots": [ "@x" ] }, { "prim": "CAR" } ] |] , "PUSH int 1; PAIR; CDR @dr" ~: "0x0502000000110743035b00010342041700000003406472" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "PAIR" }, { "prim": "CDR", "annots": [ "@dr" ] } ] |] , "LEFT @ll unit; IF_LEFT {} { DROP; PUSH int 1 }" ~: "0x05020000001f0633036c00000003406c6c072e020000000002000000080320\ \0743035b0001" ~: [aesonQQ| [ { "prim": "LEFT", "args": [ { "prim": "unit" } ], "annots": [ "@ll" ] }, { "prim": "IF_LEFT", "args": [ [], [ { "prim": "DROP" }, { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] } ] ] } ] |] , "RIGHT @rl unit; IF_RIGHT {} { DROP; PUSH int 1 }" ~: "0x0502000000240644036c0000000340726c0200000014072e02000000080320\ \0743035b00010200000000" ~: [aesonQQ| [ { "prim": "RIGHT", "args": [ { "prim": "unit" } ], "annots": [ "@rl" ] }, [ { "prim": "IF_LEFT", "args": [ [ { "prim": "DROP" }, { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] } ], [] ] } ] ] |] , "DUP; NIL @al int; SWAP; CONS @dl; SIZE @sl; DROP" ~: "0x0502000000230321063d035b0000000340616c034c041b0000000340646c04\ \450000000340736c0320" ~: [aesonQQ| [ { "prim": "DUP" }, { "prim": "NIL", "args": [ { "prim": "int" } ], "annots": [ "@al" ] }, { "prim": "SWAP" }, { "prim": "CONS", "annots": [ "@dl" ] }, { "prim": "SIZE", "annots": [ "@sl" ] }, { "prim": "DROP" } ] |] , "EMPTY_MAP @sm int unit; PUSH int 1; MEM @mmm; DROP" ~: "0x05020000001f0823035b036c0000000340736d0743035b0001043900000004406d6d6d0320" ~: [aesonQQ| [ { "prim": "EMPTY_MAP", "args": [ { "prim": "int" }, { "prim": "unit" } ], "annots": [ "@sm" ] }, { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "MEM", "annots": [ "@mmm" ] }, { "prim": "DROP" } ] |] , "EMPTY_MAP int unit; NONE unit; PUSH int 1; UPDATE @ups; DROP" ~: "0x05020000001c0723035b036c053e036c0743035b0001045000000004407570730320" ~: [aesonQQ| [ { "prim": "EMPTY_MAP", "args": [ { "prim": "int" }, { "prim": "unit" } ] }, { "prim": "NONE", "args": [ { "prim": "unit" } ] }, { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "UPDATE", "annots": [ "@ups" ] }, { "prim": "DROP" } ] |] , "EMPTY_MAP int unit; NONE unit; PUSH int 1; GET_AND_UPDATE @ups; DROP 2" ~: "0x05020000001e0723035b036c053e036c0743035b0001048c000000044075707305200002" ~: [aesonQQ| [ { "prim": "EMPTY_MAP", "args": [ { "prim": "int" }, { "prim": "unit" } ] }, { "prim": "NONE", "args": [ { "prim": "unit" } ] }, { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "GET_AND_UPDATE", "annots": [ "@ups" ] }, { "prim": "DROP", "args": [ { "int": "2" } ] } ] |] , "EMPTY_BIG_MAP int unit; PUSH int 1; GET @gg; DROP" ~: "0x0502000000170772035b036c0743035b00010429000000034067670320" ~: [aesonQQ| [ { "prim": "EMPTY_BIG_MAP", "args": [ { "prim": "int" }, { "prim": "unit" } ] }, { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "GET", "annots": [ "@gg" ] }, { "prim": "DROP" } ] |] , "PUSH int 1; PAIR; GET @gg 1;" ~: "0x0502000000130743035b000103420629000100000003406767" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "PAIR" }, { "prim": "GET", "args": [ { "int": "1" } ], "annots": [ "@gg" ] } ] |] , "DUP; UPDATE @gg 0;" ~: "0x05020000000d03210650000000000003406767" ~: [aesonQQ| [ { "prim": "DUP" }, { "prim": "UPDATE", "args": [ { "int": "0" } ], "annots": [ "@gg" ] } ] |] , "PUSH string \"\"; DUP; CONCAT @c; DROP" ~: "0x0502000000150743036801000000000321041a0000000240630320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "string" }, { "string": "" } ] }, { "prim": "DUP" }, { "prim": "CONCAT", "annots": [ "@c" ] }, { "prim": "DROP" } ] |] , "PUSH int 1; PUSH int 2; ADD @a; DROP" ~: "0x0502000000160743035b00010743035b000204120000000240610320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "2" } ] }, { "prim": "ADD", "annots": [ "@a" ] }, { "prim": "DROP" } ] |] , "PUSH int 1; PUSH int 2; SUB @s; DROP" ~: "0x0502000000160743035b00010743035b0002044b0000000240730320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "2" } ] }, { "prim": "SUB", "annots": [ "@s" ] }, { "prim": "DROP" } ] |] , "PUSH mutez 1; PUSH mutez 2; SUB_MUTEZ @sm; DROP" ~: "0x0502000000170743036a00010743036a000204930000000340736d0320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "mutez" }, { "int": "1" } ] }, { "prim": "PUSH", "args": [ { "prim": "mutez" }, { "int": "2" } ] }, { "prim": "SUB_MUTEZ", "annots": [ "@sm" ] }, { "prim": "DROP" } ] |] , "PUSH int 1; PUSH int 2; MUL @m; DROP" ~: "0x0502000000160743035b00010743035b0002043a00000002406d0320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "2" } ] }, { "prim": "MUL", "annots": [ "@m" ] }, { "prim": "DROP" } ] |] , "PUSH int 1; PUSH int 2; EDIV @edv; DROP" ~: "0x0502000000180743035b00010743035b0002042200000004406564760320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "2" } ] }, { "prim": "EDIV", "annots": [ "@edv" ] }, { "prim": "DROP" } ] |] , "PUSH int 1; ABS @a; DROP" ~: "0x0502000000100743035b000104110000000240610320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "ABS", "annots": [ "@a" ] }, { "prim": "DROP" } ] |] , "PUSH int 1; NEG @n; DROP" ~: "0x0502000000100743035b0001043b00000002406e0320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "NEG", "annots": [ "@n" ] }, { "prim": "DROP" } ] |] , "PUSH nat 1; PUSH nat 2; LSL @ll; DROP" ~: "0x050200000017074303620001074303620002043500000003406c6c0320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "nat" }, { "int": "1" } ] }, { "prim": "PUSH", "args": [ { "prim": "nat" }, { "int": "2" } ] }, { "prim": "LSL", "annots": [ "@ll" ] }, { "prim": "DROP" } ] |] , "PUSH nat 1; PUSH nat 2; LSR @lr; DROP" ~: "0x050200000017074303620001074303620002043600000003406c720320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "nat" }, { "int": "1" } ] }, { "prim": "PUSH", "args": [ { "prim": "nat" }, { "int": "2" } ] }, { "prim": "LSR", "annots": [ "@lr" ] }, { "prim": "DROP" } ] |] , "PUSH nat 1; PUSH nat 2; OR @o; DROP" ~: "0x050200000016074303620001074303620002044100000002406f0320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "nat" }, { "int": "1" } ] }, { "prim": "PUSH", "args": [ { "prim": "nat" }, { "int": "2" } ] }, { "prim": "OR", "annots": [ "@o" ] }, { "prim": "DROP" } ] |] , "PUSH nat 1; PUSH nat 2; XOR @x; DROP" ~: "0x05020000001607430362000107430362000204510000000240780320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "nat" }, { "int": "1" } ] }, { "prim": "PUSH", "args": [ { "prim": "nat" }, { "int": "2" } ] }, { "prim": "XOR", "annots": [ "@x" ] }, { "prim": "DROP" } ] |] , "PUSH int 1; NOT @n; DROP" ~: "0x0502000000100743035b0001043f00000002406e0320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "NOT", "annots": [ "@n" ] }, { "prim": "DROP" } ] |] , "PUSH nat 1; PUSH nat 2; COMPARE @cp; DROP" ~: "0x0502000000170743036200010743036200020419000000034063700320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "nat" }, { "int": "1" } ] }, { "prim": "PUSH", "args": [ { "prim": "nat" }, { "int": "2" } ] }, { "prim": "COMPARE", "annots": [ "@cp" ] }, { "prim": "DROP" } ] |] , "PUSH int 1; EQ @e; DROP" ~: "0x0502000000100743035b000104250000000240650320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "EQ", "annots": [ "@e" ] }, { "prim": "DROP" } ] |] , "PUSH int 1; NEQ @ne; DROP" ~: "0x0502000000110743035b0001043c00000003406e650320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "NEQ", "annots": [ "@ne" ] }, { "prim": "DROP" } ] |] , "PUSH int 1; LT @l; DROP" ~: "0x0502000000100743035b0001043700000002406c0320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "LT", "annots": [ "@l" ] }, { "prim": "DROP" } ] |] , "PUSH int 1; GT @g; DROP" ~: "0x0502000000100743035b0001042a0000000240670320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "GT", "annots": [ "@g" ] }, { "prim": "DROP" } ] |] , "PUSH int 1; LE @e; DROP" ~: "0x0502000000100743035b000104320000000240650320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "LE", "annots": [ "@e" ] }, { "prim": "DROP" } ] |] , "PUSH int 1; GE @g; DROP" ~: "0x0502000000100743035b000104280000000240670320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "GE", "annots": [ "@g" ] }, { "prim": "DROP" } ] |] , "PUSH int 1; ISNAT @i; DROP" ~: "0x0502000000100743035b000104560000000240690320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "ISNAT", "annots": [ "@i" ] }, { "prim": "DROP" } ] |] , "PUSH nat 1; INT @i; DROP" ~: "0x05020000001007430362000104300000000240690320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "nat" }, { "int": "1" } ] }, { "prim": "INT", "annots": [ "@i" ] }, { "prim": "DROP" } ] |] , "NOW @n; DROP" ~: "0x05020000000a044000000002406e0320" ~: [aesonQQ| [ { "prim": "NOW", "annots": [ "@n" ] }, { "prim": "DROP" } ] |] , "LEVEL @n; DROP" ~: "0x05020000000a047600000002406e0320" ~: [aesonQQ| [ { "prim": "LEVEL", "annots": [ "@n" ] }, { "prim": "DROP" } ] |] , "SELF_ADDRESS @n; DROP" ~: "0x05020000000a047700000002406e0320" ~: [aesonQQ| [ { "prim": "SELF_ADDRESS", "annots": [ "@n" ] }, { "prim": "DROP" } ] |] , "AMOUNT @a; DROP" ~: "0x05020000000a04130000000240610320" ~: [aesonQQ| [ { "prim": "AMOUNT", "annots": [ "@a" ] }, { "prim": "DROP" } ] |] , "BALANCE @b; DROP" ~: "0x05020000000a04150000000240620320" ~: [aesonQQ| [ { "prim": "BALANCE", "annots": [ "@b" ] }, { "prim": "DROP" } ] |] , "TOTAL_VOTING_POWER @vp; DROP" ~: "0x05020000000b047c000000034076700320" ~: [aesonQQ| [ { "prim": "TOTAL_VOTING_POWER", "annots": [ "@vp" ] }, { "prim": "DROP" } ] |] , "PUSH key_hash 0x001e45d2f8e24d7c39b15daa2fb3b5fac470818eb6; VOTING_POWER @vp; DROP" ~: "0x0502000000290743035d0a00000015001e45d2f8e24d7c39b15daa2fb3b5fac470818eb6047b000000034076700320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "key_hash" }, { "bytes": "001e45d2f8e24d7c39b15daa2fb3b5fac470818eb6" } ] }, { "prim": "VOTING_POWER", "annots": [ "@vp" ] }, { "prim": "DROP" } ] |] , "PUSH bytes 0x; BLAKE2B @b2b; DROP" ~: "0x050200000015074303690a00000000040e00000004406232620320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "bytes" }, { "bytes": "" } ] }, { "prim": "BLAKE2B", "annots": [ "@b2b" ] }, { "prim": "DROP" } ] |] , "SOURCE @src; DROP" ~: "0x05020000000c044700000004407372630320" ~: [aesonQQ| [ { "prim": "SOURCE", "annots": [ "@src" ] }, { "prim": "DROP" } ] |] , "SENDER @s; DROP" ~: "0x05020000000a04480000000240730320" ~: [aesonQQ| [ { "prim": "SENDER", "annots": [ "@s" ] }, { "prim": "DROP" } ] |] , "CHAIN_ID @cid; DROP" ~: "0x05020000000c047500000004406369640320" ~: [aesonQQ| [ { "prim": "CHAIN_ID", "annots": [ "@cid" ] }, { "prim": "DROP" } ] |] , "CAST @c int" ~: "0x05020000000a0657035b000000024063" ~: [aesonQQ| [ { "prim": "CAST", "args": [ { "prim": "int" } ], "annots": [ "@c" ] } ] |] , "CAST @c (int :i)" ~: "0x0502000000100657045b000000023a69000000024063" ~: [aesonQQ| [ { "prim": "CAST", "args": [ { "prim": "int", "annots": [ ":i" ] } ], "annots": [ "@c" ] } ] |] , "CAST (int :i)" ~: "0x05020000000a0557045b000000023a69" ~: [aesonQQ| [ { "prim": "CAST", "args": [ { "prim": "int", "annots": [ ":i" ] } ] } ] |] , "RENAME @r" ~: "0x0502000000080458000000024072" ~: [aesonQQ| [ { "prim": "RENAME", "annots": [ "@r" ] } ] |] , "PUSH string \"owo\"; PUSH int 2; PAIR 3; CAR @kek 0" ~: "0x0502000000270743036801000000036f776f0743035b000205420003020000000c0629000100000004406b656b" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "string" }, { "string": "owo" } ] }, { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "2" } ] }, { "prim": "PAIR", "args": [ { "int": "3" } ] }, [ { "prim": "GET", "args": [ { "int": "1" } ], "annots": [ "@kek" ] } ] ] |] , "PUSH string \"owo\"; PUSH nat 2; PAIR 3; CDR @foo 0; CDR @bar 2" ~: "0x0502000000380743036801000000036f776f07430362000205420003020000000c062900000000000440666f6f020000000c062900040000000440626172" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "string" }, { "string": "owo" } ] }, { "prim": "PUSH", "args": [ { "prim": "nat" }, { "int": "2" } ] }, { "prim": "PAIR", "args": [ { "int": "3" } ] }, [ { "prim": "GET", "args": [ { "int": "0" } ], "annots": [ "@foo" ] } ], [ { "prim": "GET", "args": [ { "int": "4" } ], "annots": [ "@bar" ] } ] ] |] , "EMPTY_SET :si @si int; ITER { DROP }" ~: "0x0502000000180624035b000000073a736920407369055202000000020320" ~: [aesonQQ| [ { "prim": "EMPTY_SET", "args": [ { "prim": "int" } ], "annots": [ ":si", "@si" ] }, { "prim": "ITER", "args": [ [ { "prim": "DROP" } ] ] } ] |] , "EMPTY_MAP :miu @em int unit; MAP @dm {}; DROP" ~: "0x0502000000220823035b036c000000083a6d69752040656d063802000000000000000340646d0320" ~: [aesonQQ| [ { "prim": "EMPTY_MAP", "args": [ { "prim": "int" }, { "prim": "unit" } ], "annots": [ ":miu", "@em" ] }, { "prim": "MAP", "args": [ [] ], "annots": [ "@dm" ] }, { "prim": "DROP" } ] |] , "DROP; PUSH @i (int :i) 42; DUP 1; SWAP; DROP" ~: "0x05020000001c03200843045b000000023a69002a00000002406905210001034c0320" ~: [aesonQQ| [ { "prim": "DROP" }, { "prim": "PUSH", "args": [ { "prim": "int", "annots": [ ":i" ] }, { "int": "42" } ], "annots": [ "@i" ] }, { "prim": "DUP", "args": [ { "int": "1" } ] }, { "prim": "SWAP" }, { "prim": "DROP" } ] |] , "LAMBDA @lii int int { PUSH int 1; DROP }; SWAP; EXEC" ~: "0x050200000023093100000011035b035b02000000080743035b000103200000\ \0004406c6969034c0326" ~: [aesonQQ| [ { "prim": "LAMBDA", "args": [ { "prim": "int" }, { "prim": "int" }, [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "DROP" } ] ], "annots": [ "@lii" ] }, { "prim": "SWAP" }, { "prim": "EXEC" } ] |] ] parseSerializeSpec "arith instr" [ "PUSH int 1; PUSH int 2; ADD; DROP" ~: "0x0502000000100743035b00010743035b000203120320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "2" } ] }, { "prim": "ADD" }, { "prim": "DROP" } ] |] , "PUSH int 1; PUSH int 2; SUB; DROP" ~: "0x0502000000100743035b00010743035b0002034b0320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "2" } ] }, { "prim": "SUB" }, { "prim": "DROP" } ] |] , "PUSH mutez 1; PUSH mutez 2; SUB_MUTEZ; DROP" ~: "0x0502000000100743036a00010743036a000203930320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "mutez" }, { "int": "1" } ] }, { "prim": "PUSH", "args": [ { "prim": "mutez" }, { "int": "2" } ] }, { "prim": "SUB_MUTEZ" }, { "prim": "DROP" } ] |] , "PUSH int 1; PUSH int 2; MUL; DROP" ~: "0x0502000000100743035b00010743035b0002033a0320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "2" } ] }, { "prim": "MUL" }, { "prim": "DROP" } ] |] , "PUSH int 1; PUSH int 2; EDIV; DROP" ~: "0x0502000000100743035b00010743035b000203220320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "2" } ] }, { "prim": "EDIV" }, { "prim": "DROP" } ] |] , "PUSH int 1; ABS; DROP" ~: "0x05020000000a0743035b000103110320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "ABS" }, { "prim": "DROP" } ] |] , "PUSH int 1; NEG @kek; DROP" ~: "0x0502000000120743035b0001043b00000004406b656b0320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "NEG", "annots": [ "@kek" ] }, { "prim": "DROP" } ] |] , "PUSH nat 1; PUSH nat 2; LSL; DROP" ~: "0x05020000001007430362000107430362000203350320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "nat" }, { "int": "1" } ] }, { "prim": "PUSH", "args": [ { "prim": "nat" }, { "int": "2" } ] }, { "prim": "LSL" }, { "prim": "DROP" } ] |] , "PUSH nat 1; PUSH nat 2; LSR; DROP" ~: "0x05020000001007430362000107430362000203360320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "nat" }, { "int": "1" } ] }, { "prim": "PUSH", "args": [ { "prim": "nat" }, { "int": "2" } ] }, { "prim": "LSR" }, { "prim": "DROP" } ] |] , "PUSH nat 1; PUSH nat 2; OR; DROP" ~: "0x05020000001007430362000107430362000203410320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "nat" }, { "int": "1" } ] }, { "prim": "PUSH", "args": [ { "prim": "nat" }, { "int": "2" } ] }, { "prim": "OR" }, { "prim": "DROP" } ] |] , "PUSH nat 1; PUSH nat 2; XOR; DROP" ~: "0x05020000001007430362000107430362000203510320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "nat" }, { "int": "1" } ] }, { "prim": "PUSH", "args": [ { "prim": "nat" }, { "int": "2" } ] }, { "prim": "XOR" }, { "prim": "DROP" } ] |] , "PUSH int 1; NOT; DROP" ~: "0x05020000000a0743035b0001033f0320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "NOT" }, { "prim": "DROP" } ] |] , "PUSH nat 1; PUSH nat 2; COMPARE; DROP" ~: "0x05020000001007430362000107430362000203190320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "nat" }, { "int": "1" } ] }, { "prim": "PUSH", "args": [ { "prim": "nat" }, { "int": "2" } ] }, { "prim": "COMPARE" }, { "prim": "DROP" } ] |] , "PUSH int 1; EQ; DROP" ~: "0x05020000000a0743035b000103250320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "EQ" }, { "prim": "DROP" } ] |] , "PUSH int 1; NEQ; DROP" ~: "0x05020000000a0743035b0001033c0320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "NEQ" }, { "prim": "DROP" } ] |] , "PUSH int 1; LT; DROP" ~: "0x05020000000a0743035b000103370320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "LT" }, { "prim": "DROP" } ] |] , "PUSH int 1; GT; DROP" ~: "0x05020000000a0743035b0001032a0320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "GT" }, { "prim": "DROP" } ] |] , "PUSH int 1; LE; DROP" ~: "0x05020000000a0743035b000103320320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "LE" }, { "prim": "DROP" } ] |] , "PUSH int 1; GE; DROP" ~: "0x05020000000a0743035b000103280320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "GE" }, { "prim": "DROP" } ] |] ] parseSerializeSpec "instrs address-related" [ "CONTRACT unit; DROP; PUSH unit Unit" ~: "0x05020000000c0555036c03200743036c030b" ~: [aesonQQ| [ { "prim": "CONTRACT", "args": [ { "prim": "unit" } ] }, { "prim": "DROP" }, { "prim": "PUSH", "args": [ { "prim": "unit" }, { "prim": "Unit" } ] } ] |] , "CONTRACT %entrypnt unit; DROP; PUSH unit Unit" ~: "0x0502000000190655036c0000000925656e747279706e7403200743036c030b" ~: [aesonQQ| [ { "prim": "CONTRACT", "args": [ { "prim": "unit" } ], "annots": [ "%entrypnt" ] }, { "prim": "DROP" }, { "prim": "PUSH", "args": [ { "prim": "unit" }, { "prim": "Unit" } ] } ] |] , "CONTRACT @va %entrypnt unit; DROP; PUSH unit Unit" ~: "0x05020000001d0655036c0000000d25656e747279706e742040766103200743036c030b" ~: [aesonQQ| [ { "prim": "CONTRACT", "args": [ { "prim": "unit" } ], "annots": [ "%entrypnt", "@va" ] }, { "prim": "DROP" }, { "prim": "PUSH", "args": [ { "prim": "unit" }, { "prim": "Unit" } ] } ] |] , "CONTRACT @va unit; DROP; PUSH unit Unit" ~: "0x0502000000130655036c0000000340766103200743036c030b" ~: [aesonQQ| [ { "prim": "CONTRACT", "args": [ { "prim": "unit" } ], "annots": [ "@va" ] }, { "prim": "DROP" }, { "prim": "PUSH", "args": [ { "prim": "unit" }, { "prim": "Unit" } ] } ] |] ] parseSerializeSpec "instrs contract-related" [ "PUSH mutez 5; PUSH unit Unit; TRANSFER_TOKENS; DROP; PUSH unit Unit" ~: "0x0502000000160743036a00050743036c030b034d03200743036c030b" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "mutez" }, { "int": "5" } ] }, { "prim": "PUSH", "args": [ { "prim": "unit" }, { "prim": "Unit" } ] }, { "prim": "TRANSFER_TOKENS" }, { "prim": "DROP" }, { "prim": "PUSH", "args": [ { "prim": "unit" }, { "prim": "Unit" } ] } ] |] , "ADDRESS; DROP; PUSH unit Unit" ~: "0x05020000000a035403200743036c030b" ~: [aesonQQ| [ { "prim": "ADDRESS" }, { "prim": "DROP" }, { "prim": "PUSH", "args": [ { "prim": "unit" }, { "prim": "Unit" } ] } ] |] ] parseSerializeSpec "instrs key-hash-related" [ "SOME; SET_DELEGATE; DROP; PUSH unit Unit" ~: "0x05020000000c0346034e03200743036c030b" ~: [aesonQQ| [ { "prim": "SOME" }, { "prim": "SET_DELEGATE" }, { "prim": "DROP" }, { "prim": "PUSH", "args": [ { "prim": "unit" }, { "prim": "Unit" } ] } ] |] , "SOME; DIP{ PUSH unit Unit; PUSH mutez 5; }; \ \ CREATE_CONTRACT{ \ \ storage unit; \ \ parameter unit; \ \ code { DROP; UNIT; NIL operation; PAIR } \ \ }; \ \ DROP; DROP; PUSH unit Unit \ \" ~: "0x05020000003f0346051f020000000c0743036c030b0743036a0005051d020000\ \00190501036c0500036c0502020000000a0320034f053d036d0342032003200743\ \036c030b" ~: [aesonQQ| [ { "prim": "SOME" }, { "prim": "DIP", "args": [ [ { "prim": "PUSH", "args": [ { "prim": "unit" }, { "prim": "Unit" } ] }, { "prim": "PUSH", "args": [ { "prim": "mutez" }, { "int": "5" } ] } ] ] }, { "prim": "CREATE_CONTRACT", "args": [ [ { "prim": "storage", "args": [ { "prim": "unit" } ] }, { "prim": "parameter", "args": [ { "prim": "unit" } ] }, { "prim": "code", "args": [ [ { "prim": "DROP" }, { "prim": "UNIT" }, { "prim": "NIL", "args": [ { "prim": "operation" } ] }, { "prim": "PAIR" } ] ] } ] ] }, { "prim": "DROP" }, { "prim": "DROP" }, { "prim": "PUSH", "args": [ { "prim": "unit" }, { "prim": "Unit" } ] } ] |] , "SOME; DIP{ PUSH int 1; PUSH mutez 5 }; \ \ CREATE_CONTRACT{ \ \ parameter (int :p); \ \ storage (int :s); \ \ code { DROP; PUSH int 10; NIL operation; PAIR } \ \ }; \ \ DROP; DROP; PUSH unit Unit \ \" ~: "0x05020000004f0346051f020000000c0743035b00010743036a0005051d020000\ \00290500045b000000023a700501045b000000023a730502020000000e03200743\ \035b000a053d036d0342032003200743036c030b" ~: [aesonQQ| [ { "prim": "SOME" }, { "prim": "DIP", "args": [ [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "PUSH", "args": [ { "prim": "mutez" }, { "int": "5" } ] } ] ] }, { "prim": "CREATE_CONTRACT", "args": [ [ { "prim": "parameter", "args": [ { "prim": "int", "annots": [ ":p" ] } ] }, { "prim": "storage", "args": [ { "prim": "int", "annots": [ ":s" ] } ] }, { "prim": "code", "args": [ [ { "prim": "DROP" }, { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "10" } ] }, { "prim": "NIL", "args": [ { "prim": "operation" } ] }, { "prim": "PAIR" } ] ] } ] ] }, { "prim": "DROP" }, { "prim": "DROP" }, { "prim": "PUSH", "args": [ { "prim": "unit" }, { "prim": "Unit" } ] } ] |] , "SOME; DIP{ PUSH int 1; PUSH mutez 5 }; \ \ CREATE_CONTRACT{ \ \ parameter (int %root :p); \ \ storage (int :s); \ \ code { DROP; PUSH int 10; NIL operation; PAIR } \ \ }; \ \ DROP; DROP; PUSH unit Unit \ \" ~: "0502000000550346051f020000000c0743035b00010743036a0005051d020000002\ \f0500045b0000000825726f6f74203a700501045b000000023a730502020000000e\ \03200743035b000a053d036d0342032003200743036c030b" ~: [aesonQQ| [ { "prim": "SOME" }, { "prim": "DIP", "args": [ [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "PUSH", "args": [ { "prim": "mutez" }, { "int": "5" } ] } ] ] }, { "prim": "CREATE_CONTRACT", "args": [ [ { "prim": "parameter", "args": [ { "prim": "int", "annots": [ "%root", ":p" ] } ] }, { "prim": "storage", "args": [ { "prim": "int", "annots": [ ":s" ] } ] }, { "prim": "code", "args": [ [ { "prim": "DROP" }, { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "10" } ] }, { "prim": "NIL", "args": [ { "prim": "operation" } ] }, { "prim": "PAIR" } ] ] } ] ] }, { "prim": "DROP" }, { "prim": "DROP" }, { "prim": "PUSH", "args": [ { "prim": "unit" }, { "prim": "Unit" } ] } ] |] , "IMPLICIT_ACCOUNT; DROP; PUSH unit Unit" ~: "0x05020000000a031e03200743036c030b" ~: [aesonQQ| [ { "prim": "IMPLICIT_ACCOUNT" }, { "prim": "DROP" }, { "prim": "PUSH", "args": [ { "prim": "unit" }, { "prim": "Unit" } ] } ] |] , "VOTING_POWER; DROP; UNIT" ~: "0x050200000006037b0320034f" ~: [aesonQQ| [ { "prim": "VOTING_POWER" }, { "prim": "DROP" }, { "prim": "UNIT" } ] |] ] parseSerializeSpec "instrs public-key-related" [ "HASH_KEY" ~: "0x050200000002032b" ~: [aesonQQ| [ { "prim": "HASH_KEY" } ] |] ] parseSerializeSpec "instrs public-key-related" [ "DIP{ PUSH bytes 0x }; DUP; DIP {CAR}; CDR; CHECK_SIGNATURE" ~: "0x05020000001f051f0200000009074303690a000000000321051f020000\ \0002031603170318" ~: [aesonQQ| [ { "prim": "DIP", "args": [ [ { "prim": "PUSH", "args": [ { "prim": "bytes" }, { "bytes": "" } ] } ] ] }, { "prim": "DUP" }, { "prim": "DIP", "args": [ [ { "prim": "CAR" } ] ] }, { "prim": "CDR" }, { "prim": "CHECK_SIGNATURE" } ] |] ] parseSerializeSpec "instr" [ "NEVER" ~: "0x0502000000020379" ~: [aesonQQ| [ {"prim": "NEVER"} ] |] ] parseSerializeSpec "VarAnn instrs address-related" [ "CONTRACT @c unit; DROP; PUSH unit Unit" ~: "0x0502000000120655036c00000002406303200743036c030b" ~: [aesonQQ| [ { "prim": "CONTRACT", "args": [ { "prim": "unit" } ], "annots": [ "@c" ] }, { "prim": "DROP" }, { "prim": "PUSH", "args": [ { "prim": "unit" }, { "prim": "Unit" } ] } ] |] ] parseSerializeSpec "VarAnn instrs contract-related" [ "ADDRESS @a; DROP; PUSH unit Unit" ~: "0x050200000010045400000002406103200743036c030b" ~: [aesonQQ| [ { "prim": "ADDRESS", "annots": [ "@a" ] }, { "prim": "DROP" }, { "prim": "PUSH", "args": [ { "prim": "unit" }, { "prim": "Unit" } ] } ] |] ] parseSerializeSpec "VarAnn instrs key-hash-related" [ "SOME; SET_DELEGATE @d; DROP; PUSH unit Unit" ~: "0x0502000000120346044e00000002406403200743036c030b" ~: [aesonQQ| [ { "prim": "SOME" }, { "prim": "SET_DELEGATE", "annots": [ "@d" ] }, { "prim": "DROP" }, { "prim": "PUSH", "args": [ { "prim": "unit" }, { "prim": "Unit" } ] } ] |] , "SOME; DIP{ PUSH int 1; PUSH mutez 5 }; \ \ CREATE_CONTRACT @ez { \ \ storage (int :s); \ \ parameter (int :p); \ \ code { DROP; PUSH int 10; NIL operation; PAIR } \ \ }; \ \ DROP; DROP; PUSH unit Unit \ \" ~: "0x0502000000560346051f020000000c0743035b00010743036a0005061d02000\ \000290501045b000000023a730500045b000000023a700502020000000e032007\ \43035b000a053d036d03420000000340657a032003200743036c030b" ~: [aesonQQ| [ { "prim": "SOME" }, { "prim": "DIP", "args": [ [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "PUSH", "args": [ { "prim": "mutez" }, { "int": "5" } ] } ] ] }, { "prim": "CREATE_CONTRACT", "args": [ [ { "prim": "storage", "args": [ { "prim": "int", "annots": [ ":s" ] } ] }, { "prim": "parameter", "args": [ { "prim": "int", "annots": [ ":p" ] } ] }, { "prim": "code", "args": [ [ { "prim": "DROP" }, { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "10" } ] }, { "prim": "NIL", "args": [ { "prim": "operation" } ] }, { "prim": "PAIR" } ] ] } ] ], "annots": [ "@ez" ] }, { "prim": "DROP" }, { "prim": "DROP" }, { "prim": "PUSH", "args": [ { "prim": "unit" }, { "prim": "Unit" } ] } ] |] , "SOME; DIP{ PUSH int 1; PUSH mutez 5 }; \ \ CREATE_CONTRACT @ez @pz { \ \ parameter (int :p); \ \ storage (int :s); \ \ code { DROP; PUSH int 10; NIL operation; PAIR } \ \ }; \ \ DROP; DROP; PUSH unit Unit \ \" ~: "0x05020000005a0346051f020000000c0743035b00010743036a0005061d02000\ \000290500045b000000023a700501045b000000023a730502020000000e032007\ \43035b000a053d036d03420000000740657a2040707a032003200743036c030b" ~: [aesonQQ| [ { "prim": "SOME" }, { "prim": "DIP", "args": [ [ { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "1" } ] }, { "prim": "PUSH", "args": [ { "prim": "mutez" }, { "int": "5" } ] } ] ] }, { "prim": "CREATE_CONTRACT", "args": [ [ { "prim": "parameter", "args": [ { "prim": "int", "annots": [ ":p" ] } ] }, { "prim": "storage", "args": [ { "prim": "int", "annots": [ ":s" ] } ] }, { "prim": "code", "args": [ [ { "prim": "DROP" }, { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "10" } ] }, { "prim": "NIL", "args": [ { "prim": "operation" } ] }, { "prim": "PAIR" } ] ] } ] ], "annots": [ "@ez", "@pz" ] }, { "prim": "DROP" }, { "prim": "DROP" }, { "prim": "PUSH", "args": [ { "prim": "unit" }, { "prim": "Unit" } ] } ] |] , "IMPLICIT_ACCOUNT @i; DROP; PUSH unit Unit" ~: "0x050200000010041e00000002406903200743036c030b" ~: [aesonQQ| [ { "prim": "IMPLICIT_ACCOUNT", "annots": [ "@i" ] }, { "prim": "DROP" }, { "prim": "PUSH", "args": [ { "prim": "unit" }, { "prim": "Unit" } ] } ] |] ] parseSerializeSpec "VarAnn instrs public-key-related" [ "HASH_KEY @h" ~: "0x050200000008042b000000024068" ~: [aesonQQ| [ { "prim": "HASH_KEY", "annots": [ "@h" ] } ] |] ] parseSerializeSpec "VarAnn instrs public-key-related" [ "DIP{ PUSH bytes 0x }; DUP; DIP {CAR}; CDR; CHECK_SIGNATURE @c" ~: "0x050200000025051f0200000009074303690a000000000321051f0200000002\ \031603170418000000024063" ~: [aesonQQ| [ { "prim": "DIP", "args": [ [ { "prim": "PUSH", "args": [ { "prim": "bytes" }, { "bytes": "" } ] } ] ] }, { "prim": "DUP" }, { "prim": "DIP", "args": [ [ { "prim": "CAR" } ] ] }, { "prim": "CDR" }, { "prim": "CHECK_SIGNATURE", "annots": [ "@c" ] } ] |] ] parseSerializeSpec "instrs ticket-related 1" [ "READ_TICKET; DROP; DROP; UNIT" ~: "0x050200000008038903200320034f" ~: [aesonQQ| [ { "prim": "READ_TICKET" }, { "prim": "DROP" }, { "prim": "DROP" }, { "prim": "UNIT" } ] |] , "DIP{ PUSH nat 0; DUP; PAIR }; SPLIT_TICKET; DROP; UNIT" ~: "0x050200000017051f020000000a07430362000003210342038a0320034f" ~: [aesonQQ| [ { "prim": "DIP", "args": [ [ { "prim": "PUSH", "args": [ { "prim": "nat" }, { "int": "0" } ] }, { "prim": "DUP" }, { "prim": "PAIR" } ] ] }, { "prim": "SPLIT_TICKET" }, { "prim": "DROP" }, { "prim": "UNIT" } ] |] ] parseSerializeSpec "instrs ticket-related 2" [ "JOIN_TICKETS; DROP; UNIT" ~: "0x050200000006038b0320034f" ~: [aesonQQ| [ { "prim": "JOIN_TICKETS" }, { "prim": "DROP" }, { "prim": "UNIT" }] |] ] parseSerializeSpec "top-level view" [ "CREATE_CONTRACT \ \{ storage unit; \ \ parameter unit; \ \ code { FAILWITH }; \ \ view \"nyan\" int nat { CAR } \ \ }" ~: "0x050200000036051d020000002f0501036c0500036c05020200000002032709910\ \000001401000000046e79616e035b03620200000002031600000000" ~: [aesonQQ| [ { "prim": "CREATE_CONTRACT", "args": [ [ { "prim": "storage", "args": [ { "prim": "unit" } ] }, { "prim": "parameter", "args": [ { "prim": "unit" } ] }, { "prim": "code", "args": [ [ { "prim": "FAILWITH" } ] ] }, { "prim": "view", "args": [ { "string": "nyan" }, { "prim": "int" }, { "prim": "nat" }, [ { "prim": "CAR" } ] ] } ] ] } ] |] ] typesTest :: Spec typesTest = do -- Bytes we compare agains are produced with command -- tezos-client convert data '{ LAMBDA ($ty) ($ty) {}; DROP }' from michelson to binary / -- | tr -d '\n' | awk '{ print $45 }' | sed 's/Hash://' -- A right-combed pair can be deserialized from two notations (`pair a b c` or `pair a (pair b c)`), -- but we only serialize it as `pair a b c`. -- For this reason, this test only checks that `pair a (pair b c)` can be correctly deserialized. -- Further down, we have more tests that check serialization+deserialization -- for the `pair a b c` notation. parseDeserializeOnlySpec "deserialize right comb pair" [ lambdaWrap "pair int nat string" ~: "0x050200000031093100000025096500000006035b0362036800000000096500000006035b03620368000000000200000000000000000320" ~: [aesonQQ| [ { "prim": "LAMBDA", "args": [ { "prim": "pair", "args": [ { "prim": "int" }, { "prim": "nat" }, { "prim": "string" } ] }, { "prim": "pair", "args": [ { "prim": "int" }, { "prim": "nat" }, { "prim": "string" } ] }, [] ] }, { "prim": "DROP" } ] |] ] parseSerializeSpec "types" [ lambdaWrap "int" ~: "0x050200000015093100000009035b035b0200000000000000000320" ~: [aesonQQ| [ { "prim": "LAMBDA", "args": [ { "prim": "int" }, { "prim": "int" }, [] ] }, { "prim": "DROP" } ] |] , lambdaWrap "int :i" ~: "0x050200000021093100000015045b000000023a69045b000000023a690200000\ \000000000000320" ~: [aesonQQ| [ { "prim": "LAMBDA", "args": [ { "prim": "int", "annots": [ ":i" ] }, { "prim": "int", "annots": [ ":i" ] }, [] ] }, { "prim": "DROP" } ] |] , lambdaWrap "nat" ~: "0x050200000015093100000009036203620200000000000000000320" ~: [aesonQQ| [ { "prim": "LAMBDA", "args": [ { "prim": "nat" }, { "prim": "nat" }, [] ] }, { "prim": "DROP" } ] |] , lambdaWrap "string" ~: "0x050200000015093100000009036803680200000000000000000320" ~: [aesonQQ| [ { "prim": "LAMBDA", "args": [ { "prim": "string" }, { "prim": "string" }, [] ] }, { "prim": "DROP" } ] |] , lambdaWrap "bytes" ~: "0x050200000015093100000009036903690200000000000000000320" ~: [aesonQQ| [ { "prim": "LAMBDA", "args": [ { "prim": "bytes" }, { "prim": "bytes" }, [] ] }, { "prim": "DROP" } ] |] , lambdaWrap "mutez" ~: "0x050200000015093100000009036a036a0200000000000000000320" ~: [aesonQQ| [ { "prim": "LAMBDA", "args": [ { "prim": "mutez" }, { "prim": "mutez" }, [] ] }, { "prim": "DROP" } ] |] , lambdaWrap "bool" ~: "0x050200000015093100000009035903590200000000000000000320" ~: [aesonQQ| [ { "prim": "LAMBDA", "args": [ { "prim": "bool" }, { "prim": "bool" }, [] ] }, { "prim": "DROP" } ] |] , lambdaWrap "key_hash" ~: "0x050200000015093100000009035d035d0200000000000000000320" ~: [aesonQQ| [ { "prim": "LAMBDA", "args": [ { "prim": "key_hash" }, { "prim": "key_hash" }, [] ] }, { "prim": "DROP" } ] |] , lambdaWrap "bls12_381_fr" ~: "0x050200000015093100000009038203820200000000000000000320" ~: [aesonQQ| [ { "prim": "LAMBDA", "args": [ { "prim": "bls12_381_fr" }, { "prim": "bls12_381_fr" }, [] ] }, { "prim": "DROP" } ] |] , lambdaWrap "bls12_381_g1" ~: "0x050200000015093100000009038003800200000000000000000320" ~: [aesonQQ| [ { "prim": "LAMBDA", "args": [ { "prim": "bls12_381_g1" }, { "prim": "bls12_381_g1" }, [] ] }, { "prim": "DROP" } ] |] , lambdaWrap "bls12_381_g2" ~: "0x050200000015093100000009038103810200000000000000000320" ~: [aesonQQ| [ { "prim": "LAMBDA", "args": [ { "prim": "bls12_381_g2" }, { "prim": "bls12_381_g2" }, [] ] }, { "prim": "DROP" } ] |] , lambdaWrap "timestamp" ~: "0x050200000015093100000009036b036b0200000000000000000320" ~: [aesonQQ| [ { "prim": "LAMBDA", "args": [ { "prim": "timestamp" }, { "prim": "timestamp" }, [] ] }, { "prim": "DROP" } ] |] , lambdaWrap "address" ~: "0x050200000015093100000009036e036e0200000000000000000320" ~: [aesonQQ| [ { "prim": "LAMBDA", "args": [ { "prim": "address" }, { "prim": "address" }, [] ] }, { "prim": "DROP" } ] |] , lambdaWrap "key" ~: "0x050200000015093100000009035c035c0200000000000000000320" ~: [aesonQQ| [ { "prim": "LAMBDA", "args": [ { "prim": "key" }, { "prim": "key" }, [] ] }, { "prim": "DROP" } ] |] , lambdaWrap "unit" ~: "0x050200000015093100000009036c036c0200000000000000000320" ~: [aesonQQ| [ { "prim": "LAMBDA", "args": [ { "prim": "unit" }, { "prim": "unit" }, [] ] }, { "prim": "DROP" } ] |] , lambdaWrap "never" ~: "0x050200000015093100000009037803780200000000000000000320" ~: [aesonQQ| [ { "prim": "LAMBDA", "args": [ { "prim": "never" }, { "prim": "never" }, [] ] }, { "prim": "DROP" } ] |] , lambdaWrap "signature" ~: "0x050200000015093100000009036703670200000000000000000320" ~: [aesonQQ| [ { "prim": "LAMBDA", "args": [ { "prim": "signature" }, { "prim": "signature" }, [] ] }, { "prim": "DROP" } ] |] , lambdaWrap "chain_id" ~: "0x050200000015093100000009037403740200000000000000000320" ~: [aesonQQ| [ { "prim": "LAMBDA", "args": [ { "prim": "chain_id" }, { "prim": "chain_id" }, [] ] }, { "prim": "DROP" } ] |] , lambdaWrap "option unit" ~: "0x05020000001909310000000d0563036c0563036c0200000000000000000320" ~: [aesonQQ| [ { "prim": "LAMBDA", "args": [ { "prim": "option", "args": [ { "prim": "unit" } ] }, { "prim": "option", "args": [ { "prim": "unit" } ] }, [] ] }, { "prim": "DROP" } ] |] , lambdaWrap "set int" ~: "0x05020000001909310000000d0566035b0566035b0200000000000000000320" ~: [aesonQQ| [ { "prim": "LAMBDA", "args": [ { "prim": "set", "args": [ { "prim": "int" } ] }, { "prim": "set", "args": [ { "prim": "int" } ] }, [] ] }, { "prim": "DROP" } ] |] , lambdaWrap "set :s int" ~: "0x0502000000250931000000190666035b000000023a730666035b000000023a7\ \30200000000000000000320" ~: [aesonQQ| [ { "prim": "LAMBDA", "args": [ { "prim": "set", "args": [ { "prim": "int" } ], "annots": [ ":s" ] }, { "prim": "set", "args": [ { "prim": "int" } ], "annots": [ ":s" ] }, [] ] }, { "prim": "DROP" } ] |] , lambdaWrap "set :s (int :i)" ~: "0x0502000000310931000000250666045b000000023a69000000023a730666045\ \b000000023a69000000023a730200000000000000000320" ~: [aesonQQ| [ { "prim": "LAMBDA", "args": [ { "prim": "set", "args": [ { "prim": "int", "annots": [ ":i" ] } ], "annots": [ ":s" ] }, { "prim": "set", "args": [ { "prim": "int", "annots": [ ":i" ] } ], "annots": [ ":s" ] }, [] ] }, { "prim": "DROP" } ] |] , lambdaWrap "operation" ~: "0x050200000015093100000009036d036d0200000000000000000320" ~: [aesonQQ| [ { "prim": "LAMBDA", "args": [ { "prim": "operation" }, { "prim": "operation" }, [] ] }, { "prim": "DROP" } ] |] , lambdaWrap "contract unit" ~: "0x05020000001909310000000d055a036c055a036c0200000000000000000320" ~: [aesonQQ| [ { "prim": "LAMBDA", "args": [ { "prim": "contract", "args": [ { "prim": "unit" } ] }, { "prim": "contract", "args": [ { "prim": "unit" } ] }, [] ] }, { "prim": "DROP" } ] |] , lambdaWrap "ticket int" ~: "0x05020000001909310000000d0587035b0587035b0200000000000000000320" ~: [aesonQQ| [ { "prim": "LAMBDA", "args": [ { "prim": "ticket", "args": [ { "prim": "int" } ] }, { "prim": "ticket", "args": [ { "prim": "int" } ] }, [] ] }, { "prim": "DROP" } ] |] , lambdaWrap "pair unit int" ~: "0x05020000001d0931000000110765036c035b0765036c035b0200000000000000000320" ~: [aesonQQ| [ { "prim": "LAMBDA", "args": [ { "prim": "pair", "args": [ { "prim": "unit" }, { "prim": "int" } ] }, { "prim": "pair", "args": [ { "prim": "unit" }, { "prim": "int" } ] }, [] ] }, { "prim": "DROP" } ] |] , lambdaWrap "pair :point (int %x) (int %y)" ~: "0x05020000004909310000003d0865045b000000022578045b000000022579000\ \000063a706f696e740865045b000000022578045b000000022579000000063a70\ \6f696e740200000000000000000320" ~: [aesonQQ| [ { "prim": "LAMBDA", "args": [ { "prim": "pair", "args": [ { "prim": "int", "annots": [ "%x" ] }, { "prim": "int", "annots": [ "%y" ] } ], "annots": [ ":point" ] }, { "prim": "pair", "args": [ { "prim": "int", "annots": [ "%x" ] }, { "prim": "int", "annots": [ "%y" ] } ], "annots": [ ":point" ] }, [] ] }, { "prim": "DROP" } ] |] , lambdaWrap "pair :point3d (pair :point (int %x) (int %y)) (int %z)" ~: "0x05020000007509310000006908650865045b000000022578045b00000002257\ \9000000063a706f696e74045b00000002257a000000083a706f696e7433640865\ \0865045b000000022578045b000000022579000000063a706f696e74045b00000\ \002257a000000083a706f696e7433640200000000000000000320" ~: [aesonQQ| [ { "prim": "LAMBDA", "args": [ { "prim": "pair", "args": [ { "prim": "pair", "args": [ { "prim": "int", "annots": [ "%x" ] }, { "prim": "int", "annots": [ "%y" ] } ], "annots": [ ":point" ] }, { "prim": "int", "annots": [ "%z" ] } ], "annots": [ ":point3d" ] }, { "prim": "pair", "args": [ { "prim": "pair", "args": [ { "prim": "int", "annots": [ "%x" ] }, { "prim": "int", "annots": [ "%y" ] } ], "annots": [ ":point" ] }, { "prim": "int", "annots": [ "%z" ] } ], "annots": [ ":point3d" ] }, [] ] }, { "prim": "DROP" } ] |] , lambdaWrap "or unit int" ~: "0x05020000001d0931000000110764036c035b0764036c035b0200000000000000000320" ~: [aesonQQ| [ { "prim": "LAMBDA", "args": [ { "prim": "or", "args": [ { "prim": "unit" }, { "prim": "int" } ] }, { "prim": "or", "args": [ { "prim": "unit" }, { "prim": "int" } ] }, [] ] }, { "prim": "DROP" } ] |] , lambdaWrap "or (unit :u %l) (int :i %r)" ~: "0x0502000000410931000000350764046c000000053a7520256c045b000000053\ \a692025720764046c000000053a7520256c045b000000053a6920257202000000\ \00000000000320" ~: [aesonQQ| [ { "prim": "LAMBDA", "args": [ { "prim": "or", "args": [ { "prim": "unit", "annots": [ ":u", "%l" ] }, { "prim": "int", "annots": [ ":i", "%r" ] } ] }, { "prim": "or", "args": [ { "prim": "unit", "annots": [ ":u", "%l" ] }, { "prim": "int", "annots": [ ":i", "%r" ] } ] }, [] ] }, { "prim": "DROP" } ] |] , lambdaWrap "lambda unit int" ~: "0x05020000001d093100000011075e036c035b075e036c035b0200000000000000000320" ~: [aesonQQ| [ { "prim": "LAMBDA", "args": [ { "prim": "lambda", "args": [ { "prim": "unit" }, { "prim": "int" } ] }, { "prim": "lambda", "args": [ { "prim": "unit" }, { "prim": "int" } ] }, [] ] }, { "prim": "DROP" } ] |] , lambdaWrap "lambda :l (unit :n) (int :t)" ~: "0x050200000041093100000035085e046c000000023a6e045b000000023a74000\ \000023a6c085e046c000000023a6e045b000000023a74000000023a6c02000000\ \00000000000320" ~: [aesonQQ| [ { "prim": "LAMBDA", "args": [ { "prim": "lambda", "args": [ { "prim": "unit", "annots": [ ":n" ] }, { "prim": "int", "annots": [ ":t" ] } ], "annots": [ ":l" ] }, { "prim": "lambda", "args": [ { "prim": "unit", "annots": [ ":n" ] }, { "prim": "int", "annots": [ ":t" ] } ], "annots": [ ":l" ] }, [] ] }, { "prim": "DROP" } ] |] , lambdaWrap "map int unit" ~: "0x05020000001d0931000000110760035b036c0760035b036c0200000000000000000320" ~: [aesonQQ| [ { "prim": "LAMBDA", "args": [ { "prim": "map", "args": [ { "prim": "int" }, { "prim": "unit" } ] }, { "prim": "map", "args": [ { "prim": "int" }, { "prim": "unit" } ] }, [] ] }, { "prim": "DROP" } ] |] , lambdaWrap "big_map int unit" ~: "0x05020000001d0931000000110761035b036c0761035b036c0200000000000000000320" ~: [aesonQQ| [ { "prim": "LAMBDA", "args": [ { "prim": "big_map", "args": [ { "prim": "int" }, { "prim": "unit" } ] }, { "prim": "big_map", "args": [ { "prim": "int" }, { "prim": "unit" } ] }, [] ] }, { "prim": "DROP" } ] |] ] parseSerializeSpec "types" [ lambdaWrap "pair unit int string" ~: "0x050200000031093100000025096500000006036c035b03680000000009650000000\ \6036c035b0368000000000200000000000000000320" ~: [aesonQQ| [ { "prim": "LAMBDA", "args": [ { "prim": "pair", "args": [ { "prim": "unit" }, { "prim": "int" }, { "prim": "string" } ] }, { "prim": "pair", "args": [ { "prim": "unit" }, { "prim": "int" }, { "prim": "string" } ] }, [] ] }, { "prim": "DROP" } ] |] , lambdaWrap "pair (pair int nat string) (pair nat string int) string int nat" ~: "0x050200000071093100000065096500000026096500000006035b036203680000000\ \009650000000603620368035b000000000368035b0362000000000965000000260965\ \00000006035b036203680000000009650000000603620368035b000000000368035b0\ \362000000000200000000000000000320" ~: [aesonQQ| [ { "prim": "LAMBDA", "args": [ { "prim": "pair", "args": [ { "prim": "pair", "args": [ { "prim": "int" }, { "prim": "nat" }, { "prim": "string" } ] }, { "prim": "pair", "args": [ { "prim": "nat" }, { "prim": "string" }, { "prim": "int" } ] }, { "prim": "string" }, { "prim": "int" }, { "prim": "nat" } ] }, { "prim": "pair", "args": [ { "prim": "pair", "args": [ { "prim": "int" }, { "prim": "nat" }, { "prim": "string" } ] }, { "prim": "pair", "args": [ { "prim": "nat" }, { "prim": "string" }, { "prim": "int" } ] }, { "prim": "string" }, { "prim": "int" }, { "prim": "nat" } ] }, [] ] }, { "prim": "DROP" } ] |] , lambdaWrap "pair int (pair :t int int)" ~: "0x0502000000310931000000250765035b0865035b035b000000023a740765035b086503\ \5b035b000000023a740200000000000000000320" ~: [aesonQQ| [ { "prim": "LAMBDA", "args": [ { "prim": "pair", "args": [ { "prim": "int" }, { "prim": "pair", "args": [ { "prim": "int" }, { "prim": "int" } ], "annots": [ ":t" ] } ] }, { "prim": "pair", "args": [ { "prim": "int" }, { "prim": "pair", "args": [ { "prim": "int" }, { "prim": "int" } ], "annots": [ ":t" ] } ] }, [] ] }, { "prim": "DROP" } ] |] , lambdaWrap "pair int (string :t)" ~: "0x05020000002909310000001d0765035b0468000000023a740765035b0468000000023\ \a740200000000000000000320" ~: [aesonQQ| [ { "prim": "LAMBDA", "args": [ { "prim": "pair", "args": [ { "prim": "int" }, { "prim": "string", "annots": [ ":t" ] } ] }, { "prim": "pair", "args": [ { "prim": "int" }, { "prim": "string", "annots": [ ":t" ] } ] }, [] ] }, { "prim": "DROP" } ] |] , lambdaWrap "pair int string (pair :t int string)" ~: "0x050200000045093100000039096500000010035b03680865035b03680\ \00000023a7400000000096500000010035b03680865035b03680000000\ \23a74000000000200000000000000000320" ~: [aesonQQ| [ { "prim": "LAMBDA", "args": [ { "prim": "pair", "args": [ { "prim": "int" }, { "prim": "string" }, { "prim": "pair", "args": [ { "prim": "int" }, { "prim": "string" } ], "annots": [ ":t" ] } ] }, { "prim": "pair", "args": [ { "prim": "int" }, { "prim": "string" }, { "prim": "pair", "args": [ { "prim": "int" }, { "prim": "string" } ], "annots": [ ":t" ] } ] }, [] ] }, { "prim": "DROP" } ] |] , lambdaWrap "pair :point (pair int nat string) (pair nat string int) string int nat" ~: "0x05020000007d093100000071096500000026096500000006035b03620368000000000965\ \0000000603620368035b000000000368035b0362000000063a706f696e7409650000002609\ \6500000006035b036203680000000009650000000603620368035b000000000368035b0362\ \000000063a706f696e740200000000000000000320" ~: [aesonQQ| [ { "prim": "LAMBDA", "args": [ { "prim": "pair", "args": [ { "prim": "pair", "args": [ { "prim": "int" }, { "prim": "nat" }, { "prim": "string" } ] }, { "prim": "pair", "args": [ { "prim": "nat" }, { "prim": "string" }, { "prim": "int" } ] }, { "prim": "string" }, { "prim": "int" }, { "prim": "nat" } ], "annots": [ ":point" ] }, { "prim": "pair", "args": [ { "prim": "pair", "args": [ { "prim": "int" }, { "prim": "nat" }, { "prim": "string" } ] }, { "prim": "pair", "args": [ { "prim": "nat" }, { "prim": "string" }, { "prim": "int" } ] }, { "prim": "string" }, { "prim": "int" }, { "prim": "nat" } ], "annots": [ ":point" ] }, [] ] }, { "prim": "DROP" } ] |] , lambdaWrap "pair :point (int :a %x) (int :b %y) (string :c %z)" ~: "0x050200000073093100000067096500000021045b000000053a61202578045b000000053\ \a622025790468000000053a6320257a000000063a706f696e74096500000021045b00000\ \0053a61202578045b000000053a622025790468000000053a6320257a000000063a706f69\ \6e740200000000000000000320" ~: [aesonQQ| [ { "prim": "LAMBDA", "args": [ { "prim": "pair", "args": [ { "prim": "int", "annots": [ ":a", "%x" ] }, { "prim": "int", "annots": [ ":b", "%y" ] }, { "prim": "string", "annots": [ ":c", "%z" ] } ], "annots": [ ":point" ] }, { "prim": "pair", "args": [ { "prim": "int", "annots": [ ":a", "%x" ] }, { "prim": "int", "annots": [ ":b", "%y" ] }, { "prim": "string", "annots": [ ":c", "%z" ] } ], "annots": [ ":point" ] }, [] ] }, { "prim": "DROP" } ] |] , lambdaWrap "pair :threepoints\ \ (pair %first :point (int :a %x) (int :b %y) (string :c %z))\ \ (pair %second :point (int :a %x) (int :b %y) (string :c %z))\ \ (pair :point %third (int :a %x) (int :b %y) (string :c %z))" ~: "0x05020000018f0931000001830965000000a9096500000021045b00000005\ \3a61202578045b000000053a622025790468000000053a6320257a0000000d\ \3a706f696e7420256669727374096500000021045b000000053a6120257804\ \5b000000053a622025790468000000053a6320257a0000000e3a706f696e74\ \20257365636f6e64096500000021045b000000053a61202578045b00000005\ \3a622025790468000000053a6320257a0000000d3a706f696e742025746869\ \72640000000c3a7468726565706f696e74730965000000a909650000002104\ \5b000000053a61202578045b000000053a622025790468000000053a632025\ \7a0000000d3a706f696e7420256669727374096500000021045b000000053a\ \61202578045b000000053a622025790468000000053a6320257a0000000e3a\ \706f696e7420257365636f6e64096500000021045b000000053a6120257804\ \5b000000053a622025790468000000053a6320257a0000000d3a706f696e74\ \202574686972640000000c3a7468726565706f696e74730200000000000000000320" ~: [aesonQQ| [ { "prim": "LAMBDA", "args": [ { "prim": "pair", "args": [ { "prim": "pair", "args": [ { "prim": "int", "annots": [ ":a", "%x" ] }, { "prim": "int", "annots": [ ":b", "%y" ] }, { "prim": "string", "annots": [ ":c", "%z" ] } ], "annots": [ ":point", "%first" ] }, { "prim": "pair", "args": [ { "prim": "int", "annots": [ ":a", "%x" ] }, { "prim": "int", "annots": [ ":b", "%y" ] }, { "prim": "string", "annots": [ ":c", "%z" ] } ], "annots": [ ":point", "%second" ] }, { "prim": "pair", "args": [ { "prim": "int", "annots": [ ":a", "%x" ] }, { "prim": "int", "annots": [ ":b", "%y" ] }, { "prim": "string", "annots": [ ":c", "%z" ] } ], "annots": [ ":point", "%third" ] } ], "annots": [ ":threepoints" ] }, { "prim": "pair", "args": [ { "prim": "pair", "args": [ { "prim": "int", "annots": [ ":a", "%x" ] }, { "prim": "int", "annots": [ ":b", "%y" ] }, { "prim": "string", "annots": [ ":c", "%z" ] } ], "annots": [ ":point", "%first" ] }, { "prim": "pair", "args": [ { "prim": "int", "annots": [ ":a", "%x" ] }, { "prim": "int", "annots": [ ":b", "%y" ] }, { "prim": "string", "annots": [ ":c", "%z" ] } ], "annots": [ ":point", "%second" ] }, { "prim": "pair", "args": [ { "prim": "int", "annots": [ ":a", "%x" ] }, { "prim": "int", "annots": [ ":b", "%y" ] }, { "prim": "string", "annots": [ ":c", "%z" ] } ], "annots": [ ":point", "%third" ] } ], "annots": [ ":threepoints" ] }, [] ] }, { "prim": "DROP" } ] |] , lambdaWrap "pair :point (int %x) (pair (nat %y) (pair %node string int))" ~: "0x05020000006f09310000006309650000001f045b00000002257804620000000225\ \7908650368035b00000005256e6f6465000000063a706f696e7409650000001f045b\ \000000022578046200000002257908650368035b00000005256e6f6465000000063a\ \706f696e740200000000000000000320" ~: [aesonQQ| [ { "prim": "LAMBDA", "args": [ { "prim": "pair", "args": [ { "prim": "int", "annots": [ "%x" ] }, { "prim": "nat", "annots": [ "%y" ] }, { "prim": "pair", "args": [ { "prim": "string" }, { "prim": "int" } ], "annots": [ "%node" ] } ], "annots": [ ":point" ] }, { "prim": "pair", "args": [ { "prim": "int", "annots": [ "%x" ] }, { "prim": "nat", "annots": [ "%y" ] }, { "prim": "pair", "args": [ { "prim": "string" }, { "prim": "int" } ], "annots": [ "%node" ] } ], "annots": [ ":point" ] }, [] ] }, { "prim": "DROP" } ] |] , lambdaWrap "pair :point int (pair nat (pair %node string (pair int string)))" ~: "0x050200000063093100000057096500000019035b03620965000000060368035b03680\ \0000005256e6f6465000000063a706f696e74096500000019035b036209650000000603\ \68035b036800000005256e6f6465000000063a706f696e740200000000000000000320" ~: [aesonQQ| [ { "prim": "LAMBDA", "args": [ { "prim": "pair", "args": [ { "prim": "int" }, { "prim": "nat" }, { "prim": "pair", "args": [ { "prim": "string" }, { "prim": "int" }, { "prim": "string" } ], "annots": [ "%node" ] } ], "annots": [ ":point" ] }, { "prim": "pair", "args": [ { "prim": "int" }, { "prim": "nat" }, { "prim": "pair", "args": [ { "prim": "string" }, { "prim": "int" }, { "prim": "string" } ], "annots": [ "%node" ] } ], "annots": [ ":point" ] }, [] ] }, { "prim": "DROP" } ] |] ] where lambdaWrap ty = "LAMBDA (" <> ty <> ") (" <> ty <> ") {}; DROP" deserializeNegTest :: Spec deserializeNegTest = do describe "Wrong length specified" $ do unpackNegSpec "Too few list length" "0x05020000000300010002" -- { 1; 2 } unpackNegSpec "Too big list length" "0x05020000000500010002" -- { 1; 2 } unpackNegSpec "Wrong bytes length" "0x050b000000021234" -- 0x1234 describe "Invalid annotations specified" $ do deserializeNegSpec "Space char `20` in the middle of an annotation" "0x050200000009041600000003252061" [aesonQQ| [ { "prim": "CAR", "annots": [ "%a b" ] } ] |] deserializeNegSpec "Char from invalid range `00-1F` as part of an annotation" "0x050200000009041600000003251A61" [aesonQQ| [ { "prim": "CAR", "annots": [ "%\u001aa" ] } ] |] deserializeNegSpec "Char from invalid range `A0-FF` as part of an annotation" "0x05020000000904160000000325A361" [aesonQQ| [ { "prim": "CAR", "annots": [ "%!aa" ] } ] |] readableDeserializeTest :: Spec readableDeserializeTest = do describe "Deserialize primitives from Readable representation" $ do -- tezos-client convert data '"tz1akcPmG1Kyz2jXpS4RvVJ8uWr7tsiT9i6A"' from michelson to binary -- tezos-client convert data '"tz1akcPmG1Kyz2jXpS4RvVJ8uWr7tsiT9i6A"' from michelson to json deserializeReadableSpec @'TAddress "Deserialize readable address" "0x050100000024747a31616b63506d47314b797a326a587053345276564a38755772377473695439693641" [aesonQQ| { "string": "tz1akcPmG1Kyz2jXpS4RvVJ8uWr7tsiT9i6A" } |] -- ./tezos-client convert data '"edpktezaD1wnUa5pT2pvj1JGHNey18WGhPc9fk9bbppD33KNQ2vH8R"' -- from michelson to binary deserializeReadableSpec @'TKey "Deserialize readable public key" "0x0501000000366564706b74657a614431776e55613570543270766a314a4\ \7484e65793138574768506339666b39626270704433334b4e513276483852" [aesonQQ| { "string": "edpktezaD1wnUa5pT2pvj1JGHNey18WGhPc9fk9bbppD33KNQ2vH8R" } |] -- tezos-client convert data '"edsigtqgdc2JLMDcERHo61Y76mrxqCeqDE5YhHiBo\ -- \VtwjhFKahAkCT7RCZKQLhLJ3yJbrVyJCkVGEoiHbyKytHW846dDC4P121K"' from michelson to binary deserializeReadableSpec @'TSignature "Deserialize readable signature" "0x05010000006365647369677471676463324a4c4d44634552486f36315937\ \366d72787143657144453559684869426f5674776a68464b6168416b435437\ \52435a4b514c684c4a33794a627256794a436b5647456f694862794b797448\ \5738343664444334503132314b" [aesonQQ| { "string": "edsigtqgdc2JLMDcERHo61Y76mrxqCeqDE5YhHiBoVtwjhFKahAkCT7RCZKQLhLJ3yJbrVyJCkVGEoiHbyKytHW846dDC4P121K" } |] -- tezos-client convert data '"NetXUdfLh6Gm88t"' from michelson to binary deserializeReadableSpec @'TChainId "Deserialize readable chain_id" "0x05010000000f4e6574585564664c6836476d383874" [aesonQQ| { "string": "NetXUdfLh6Gm88t" } |] deserializeReadableSpec @'TTimestamp "Deserialize readable timestamp" "0x050100000014323032302d30382d30365431303a35303a35395a" [aesonQQ| { "string": "2020-08-06T10:50:59Z" } |] where deserializeReadableSpec :: forall t. UnpackedValScope t => String -> Text -> J.Value -> Spec deserializeReadableSpec name encodedHex json = describe name $ do it "From binary" $ let encoded = unsafe . fromHex $ stripOptional0x encodedHex in runUnpack @t encoded `shouldSatisfy` isRight it "From json" $ case J.eitherDecode' @Expression (J.encode json) of Left err -> expectationFailure $ pretty err Right expr -> do fromExpression @(Value t) expr `shouldSatisfy` isRight lengthsAreNotIgnoredTest :: Spec lengthsAreNotIgnoredTest = describe "Lengths are not ignored in ChainId" $ do let chainId = UnsafeChainId "\0\0\0\0" properEncoded = unsafe $ fromHex "050a0000000400000000" badEncodedGt = unsafe $ fromHex "050a0000000500000000" badEncodedLt = unsafe $ fromHex "050a0000000300000000" it "Can be properly encoded" $ unpackValue' @'TChainId properEncoded == Right (VChainId chainId) it "Caught when greater than necessary" $ isLeft $ unpackValue' @'TChainId badEncodedGt it "Caught when less than necessary" $ isLeft $ unpackValue' @'TChainId badEncodedLt deserializeIntAsNatTest :: Spec deserializeIntAsNatTest = do describe "non-negative 'int' can be parsed to 'nat'" $ do it "From binary" $ unpackValue' @'TNat (packValue' (VInt 1)) == Right (VNat 1) it "From json" $ fromExpression @(Value 'TNat) (toExpression @(Value 'TInt) (VInt 1)) == Right (VNat 1) describe "Can't be decoded because of negativity" $ do it "From binary" $ isLeft $ unpackValue' @'TNat (packValue' (VInt -1)) it "From json" $ isLeft $ fromExpression @(Value 'TNat) (toExpression @(Value 'TInt) (VInt -1)) deserializeComparablePairTest :: Spec deserializeComparablePairTest = do parseSerializeSpec "Deserialize a pair of comparable types" [ "LEFT (set (pair nat nat)) ; DROP ; UNIT" ~: "05020000000e053305660765036203620320034f" ~: [aesonQQ| [ { "prim": "LEFT", "args": [ { "prim": "set", "args": [ { "prim": "pair", "args": [ { "prim": "nat" }, { "prim": "nat" } ] } ] } ] }, { "prim": "DROP" }, { "prim": "UNIT" } ] |] , "LEFT (set (pair unit unit)) ; DROP ; UNIT" ~: "0x05020000000e053305660765036c036c0320034f" ~: [aesonQQ| [ { "prim": "LEFT", "args": [ { "prim": "set", "args": [ { "prim": "pair", "args": [ { "prim": "unit" }, { "prim": "unit" } ] } ] } ] }, { "prim": "DROP" }, { "prim": "UNIT" } ] |] ] deserializeComparableOrTest :: Spec deserializeComparableOrTest = do parseSerializeSpec "Deserialize comparable 'or'" [ "LEFT (set (or nat nat)) ; DROP ; UNIT" ~: "0x05020000000e053305660764036203620320034f" ~: [aesonQQ| [ { "prim": "LEFT", "args": [ { "prim": "set", "args": [ { "prim": "or", "args": [ { "prim": "nat" }, { "prim": "nat" } ] } ] } ] }, { "prim": "DROP" }, { "prim": "UNIT" } ] |] ] deserializeComparableOptionTest :: Spec deserializeComparableOptionTest = do parseSerializeSpec "Deserialize comparable 'option'" [ "LEFT (option unit) ; DROP ; UNIT" ~: "0x05020000000a05330563036c0320034f" ~: [aesonQQ| [ { "prim": "LEFT", "args": [ { "prim": "option", "args": [ { "prim": "unit" } ] } ] }, { "prim": "DROP" }, { "prim": "UNIT" } ] |] ] deserializeComparablesTest :: Spec deserializeComparablesTest = do parseSerializeSpec "Deserialize comparable simple types" [ "LEFT unit ; DROP ; UNIT" ~: "0x0502000000080533036c0320034f" ~: [aesonQQ| [ { "prim": "LEFT", "args": [ { "prim": "unit" } ] }, { "prim": "DROP" }, { "prim": "UNIT" } ] |] , "LEFT chain_id ; DROP ; UNIT" ~: "0x050200000008053303740320034f" ~: [aesonQQ| [ { "prim": "LEFT", "args": [ { "prim": "chain_id" } ] }, { "prim": "DROP" }, { "prim": "UNIT" } ] |] , "LEFT signature ; DROP ; UNIT" ~: "0x050200000008053303670320034f" ~: [aesonQQ| [ { "prim": "LEFT", "args": [ { "prim": "signature" } ] }, { "prim": "DROP" }, { "prim": "UNIT" } ] |] , "LEFT key ; DROP ; UNIT" ~: "0x0502000000080533035c0320034f" ~: [aesonQQ| [ { "prim": "LEFT", "args": [ { "prim": "key" } ] }, { "prim": "DROP" }, { "prim": "UNIT" } ] |] ] deserializeSeqOfEmptySeqsTest :: Spec deserializeSeqOfEmptySeqsTest = do parseSerializeSpec "unambiguously converting sequence of empty sequences" [ "PUSH (list (list int)) { {} }; DROP" ~: "0502000000140743055f055f035b020000000502000000000320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "list", "args": [ { "prim": "list", "args":[ { "prim": "int" } ] } ] }, [ [] ] ] }, { "prim": "DROP" } ] |] , "PUSH (lambda int int) { {} }; DROP" ~: "0502000000140743075e035b035b020000000502000000000320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "lambda", "args": [ { "prim": "int" }, { "prim": "int" } ] }, [ [] ] ] }, { "prim": "DROP" } ] |] , "PUSH (list (list (list int))) { { {} } }; DROP" ~: "05020000001b0743055f055f055f035b020000000a020000000502000000000320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "list", "args": [ { "prim": "list", "args": [ { "prim": "list", "args": [ { "prim": "int" } ] } ] } ] }, [ [ [] ] ] ] }, { "prim": "DROP" } ] |] , "PUSH (lambda int int) { { {} } }; DROP" ~: "0502000000190743075e035b035b020000000a020000000502000000000320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "lambda", "args": [ { "prim": "int" }, { "prim": "int" } ] }, [ [ [] ] ] ] }, { "prim": "DROP" } ] |] , "PUSH (lambda int int) { {}; { {} } }; DROP" ~: "05020000001e0743075e035b035b020000000f0200000000020000000502000000000320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "lambda", "args": [ { "prim": "int" }, { "prim": "int" } ] }, [ [], [ [] ] ] ] }, { "prim": "DROP" } ] |] , "PUSH (list (set int)) { {} }; DROP" ~: "0502000000140743055f0566035b020000000502000000000320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "list", "args": [ { "prim": "set", "args": [ { "prim": "int" } ] } ] }, [ [] ] ] }, { "prim": "DROP" } ] |] , "PUSH (list (map int int)) { {} }; DROP" ~: "0502000000160743055f0760035b035b020000000502000000000320" ~: [aesonQQ| [ { "prim": "PUSH", "args": [ { "prim": "list", "args": [ { "prim": "map", "args": [ { "prim": "int" }, { "prim": "int" } ] } ] }, [ [] ] ] }, { "prim": "DROP" } ] |] ]