-- SPDX-FileCopyrightText: 2020 Tocqueville Group -- -- SPDX-License-Identifier: LicenseRef-MIT-TQ {-# LANGUAGE OverloadedLists #-} module Test.Serialization.Michelson ( spec_Packing ) where import Prelude hiding (Ordering(..)) import qualified Data.Text as T import Data.Typeable ((:~:)(..), eqT, typeRep) import Test.Hspec (Expectation, Spec, describe, it, shouldBe, shouldSatisfy) import Text.Hex (decodeHex, encodeHex) import Michelson.Interpret (runUnpack) import Michelson.Interpret.Pack (packValue') import Michelson.Interpret.Unpack (unpackValue') import Michelson.Macro (expandList) import qualified Michelson.Parser as Parser import Michelson.Test.Util import Michelson.Text import Michelson.TypeCheck (HST(..), SomeInstr(..), SomeInstrOut(..), typeCheckList, getWTP) import Michelson.Typed import Michelson.Untyped (noAnn) import Test.Util.Parser import Tezos.Address (Address(..), unsafeParseAddress) import Tezos.Core (ChainId(..), Mutez, Timestamp, parseChainId, timestampFromSeconds, unsafeMkMutez) import Tezos.Crypto (KeyHash(..), parseKeyHash, parsePublicKey, parseSignature) spec_Packing :: Spec spec_Packing = do describe "pack tests for comparable values (CValue)" $ do intTest natTest stringTest bytesTest mutezTest boolTest keyHashTest timestampTest addressTest describe "pack tests for non-comparable values" $ do keyTest unitTest signatureTest chainIdTest optionTest listTest setTest contractTest pairTest orTest mapTest describe "pack tests for instructions" $ do instrTest typesTest unpackNegTest unpackVarAnnTest readableUnpackTest lengthsAreNotIgnoredTest stripOptional0x :: Text -> Text stripOptional0x h = T.stripPrefix "0x" h ?: h fromHex :: HasCallStack => Text -> ByteString fromHex hex = decodeHex (stripOptional0x hex) ?: error ("Invalid hex: " <> show hex) -- | Dummy wrapper for what do we test - pack or unpack. data TestMethod t = TestMethod { _tmName :: String , _tmApply :: Value t -> Text -> Expectation } packTestMethods :: (PackedValScope t, HasCallStack) => [TestMethod t] packTestMethods = one $ TestMethod "Pack" $ \val encodedHex -> encodeHex (packValue' val) `shouldBe` stripOptional0x encodedHex unpackTestMethods :: (UnpackedValScope t, HasCallStack) => [TestMethod t] unpackTestMethods = one $ TestMethod "Unpack" $ \val encodedHex -> runUnpack (fromHex encodedHex) `shouldBe` Right val allTestMethods :: (UnpackedValScope t, HasCallStack) => [TestMethod t] allTestMethods = packTestMethods <> unpackTestMethods packSpecManual :: (Show x, HasCallStack) => String -> [TestMethod t] -> (x -> Value t) -> [(x, Text)] -> Spec packSpecManual name testMethods toVal' suites = forM_ @[_] testMethods $ \(TestMethod mname method) -> describe mname $ describe name $ forM_ suites $ \(x, h) -> it (show x) $ method (toVal' x) h packSpec :: forall x (t :: T). ( IsoValue x, Show x, ToT x ~ t , Typeable t, UnpackedValScope t , HasCallStack ) => [(x, Text)] -> Spec packSpec = packSpecManual typeName allTestMethods toVal where typeName = show $ typeRep (Proxy @(Value t)) parsePackSpec :: forall (inp :: T) (out :: T). (Each [Typeable, SingI] [inp, out], HasCallStack) => String -> [(Text, Text)] -> Spec parsePackSpec name suites = parseVLamSpec @inp @out name allTestMethods suites parseUnpackOnlySpec :: forall (inp :: T) (out :: T). (Each [Typeable, SingI] [inp, out], HasCallStack) => String -> [(Text, Text)] -> Spec parseUnpackOnlySpec name suites = parseVLamSpec @inp @out name unpackTestMethods suites parseVLamSpec :: forall (inp :: T) (out :: T). (Each [Typeable, SingI] [inp, out], HasCallStack) => String -> [TestMethod ('TLambda inp out)] -> [(Text, Text)] -> Spec parseVLamSpec name testMethods suites = forM_ @[_] testMethods $ \(TestMethod mname method) -> describe mname $ describe name $ forM_ suites $ \(codeText, packed) -> it (truncateName $ toString codeText) $ do parsed <- Parser.codeEntry `shouldParse` ("{" <> codeText <> "}") let code = expandList parsed let _ :/ typed = typeCheckList code initStack & runExceptT & evaluatingState initTypeCheckST & leftToShowPanic case typed of AnyOutInstr instr -> method (VLam @inp @out $ RfAlwaysFails instr) packed (instr :: Instr '[inp] outs) ::: _ -> case eqT @'[out] @outs of Just Refl -> method (VLam @inp @out $ RfNormal instr) packed Nothing -> error "Output type unexpectedly mismatched" where truncateName s | length s < 60 = s | otherwise = take 60 s <> " ..." initTypeCheckST = error "Type check state is not defined" initStack = case getWTP @inp of Just Dict -> (starNotes @inp, Dict, noAnn) ::& SNil Nothing -> error "Type is not well typed" unpackNegSpec :: forall (t :: T). (UnpackedValScope t) => String -> Text -> Spec unpackNegSpec name encodedHex = it name $ let encoded = decodeHex (stripOptional0x encodedHex) ?: error ("Invalid hex: " <> show encodedHex) in runUnpack @t encoded `shouldSatisfy` isLeft -- | Helper for defining tests cases for 'packSpec'. -- Read it as "is packed as". (~:) :: a -> b -> (a, b) (~:) = (,) infix 0 ~: intTest :: Spec intTest = packSpec @Integer [ (-64, "0500c001") , (-63, "05007f") , (-2, "050042") , (-1, "050041") , (0, "050000") , (1, "050001") , (2, "050002") , (63, "05003f") , (64, "05008001") , (65, "05008101") , (-65, "0500c101") , (127, "0500bf01") , (128, "05008002") , (129, "05008102") , (-127, "0500ff01") , (191, "0500bf02") , (192, "05008003") , (193, "05008103") , (2028, "0500ac1f") , (5000, "0500884e") , (10000, "0500909c01") , (20000, "0500a0b802") , (-5000, "0500c84e") , (-10000, "0500d09c01") , (-20000, "0500e0b802") ] natTest :: Spec natTest = packSpec @Natural [ (0, "050000") , (1, "050001") , (63, "05003f") , (64, "05008001") , (65, "05008101") , (127, "0500bf01") , (128, "05008002") , (129, "05008102") , (191, "0500bf02") , (192, "05008003") , (193, "05008103") ] stringTest :: Spec stringTest = packSpec @MText [ [mt|Hello World!|] ~: "05010000000c48656c6c6f20576f726c6421" , [mt|HODL: Hold On for Dear Life|] ~: "05010000001b484f444c3a20486f6c64204f6e20666f722044656172204c696665" , [mt|\n|] ~: "0501000000010a" ] bytesTest :: Spec bytesTest = packSpec @ByteString [ "000123" ~: "050a00000006303030313233" , "A rose by any other name would smell as sweet" ~: "050a0000002d4120726f736520627920616e79206f74686572206e616\ \d6520776f756c6420736d656c6c206173207377656574" ] mutezTest :: Spec mutezTest = packSpec @Mutez [ (unsafeMkMutez 0 , "050000") , (unsafeMkMutez 1 , "050001") , (unsafeMkMutez 63 , "05003f") , (unsafeMkMutez 64 , "05008001") , (unsafeMkMutez 65 , "05008101") , (unsafeMkMutez 127, "0500bf01") , (unsafeMkMutez 128, "05008002") , (unsafeMkMutez 129, "05008102") , (unsafeMkMutez 191, "0500bf02") , (unsafeMkMutez 192, "05008003") , (unsafeMkMutez 193, "05008103") ] boolTest :: Spec boolTest = packSpec @Bool [ (True , "05030a") , (False, "050303") ] keyHashTest :: Spec keyHashTest = do packSpec @KeyHash [ ( leftToShowPanic $ parseKeyHash "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" , "050a000000150002298c03ed7d454a101eb7022bc95f7e5f41ac78" ) ] timestampTest :: Spec timestampTest = do packSpec @Timestamp $ convertTimestamps [ (205027200, "050080dec3c301") , (1552564995, "0500838cd2c80b") ] where convertTimestamps = map . first $ timestampFromSeconds addressTest :: Spec addressTest = do packSpec @Address $ parseAddrs [ ( "tz1PYgf9fBGLXvwx8ag8sdwjLJzmyGdNiswM" , "050a0000001600002addb327dbca405f07aeef318bba0ec2f714a755" ) , ( "tz1Z1nn9Y7vzyvtf6rAYMPhPNGqMJXw88xGH" , "050a00000016000092b72c0fa1064331a641131f572e7f2abb9a890b" ) , ( "tz2EfqCbLmpfv7mNiLcMmhxAwdgHtPTcwR4W" , "050a00000016000145b5e7d31bf6612e61ebfa7a6d929ce7800a55a4" ) , ( "tz3UoffC7FG7zfpmvmjUmUeAaHvzdcUvAj6r" , "050a0000001600025cfa532f50de3e12befc0ad21603835dd7698d35" ) , ( "KT1AEseqMV6fk2vtvQCVyA7ZCaxv7cpxtXdB" , "050a0000001601122d038abd69be91b4b6803f2f098a088e259e7200" ) , ( "KT1NSrmSJrSueZiWPKrcAUScYr6k2BkUVALr" , "050a00000016019812c669d9e8ff1a61bf8c57e33b955f074d832600" ) ] where parseAddrs = map $ first unsafeParseAddress keyTest :: Spec keyTest = packSpecManual "key" allTestMethods VKey [ item "edpkupH22qrz1sNQt5HSvWfRJFfyJ9dhNbZLptE6GR4JbMoBcACZZH" "050a00000021009a85e0f3f47852869ae667adc3b03a20fa9f324d046174dff6834e7d1fab0e8d" , item "edpkuwTWKgQNnhR5v17H2DYHbfcxYepARyrPGbf1tbMoGQAj8Ljr3V" "050a0000002100aad3f16293766169f7db278c5e0e9db4fb82ffe1cbcc35258059617dc0fec082" , item "sppk7cdA7Afj8MvuBFrP6KsTLfbM5DtH9GwYaRZwCf5tBVCz6UKGQFR" "050a000000220103b524d0184276467c848ac13557fb0ff8bec5907960f72683f22af430503edfc1" , item "sppk7Ze7NMs6EHF2uB8qq8GrEgJvE9PWYkUijN3LcesafzQuGyniHBD" "050a0000002201022c380cd1ff286a0a1a7c3aad6e891d237fa82e2a7cdeec08ccb55e90fdef995f" , item "p2pk67K1dwkDFPB63RZU5H3SoMCvmJdKZDZszc7U4FiGKN2YypKdDCB" "050a00000022020368afbb09255d849813712108a4144237dc1fdd5bb74e68335f4c68c12c1e5723" , item "p2pk68C6tJr7pNLvgBH63K3hBVoztCPCA36zcWhXFUGywQJTjYBfpxk" "050a000000220203dcb1916c475902f2b1083212e1b4e6f8ce1531710218c7d34340439f47040e7c" ] where item keyStr keyBytes = ( leftToShowPanic $ parsePublicKey keyStr, keyBytes) unitTest :: Spec unitTest = packSpec @() [() ~: "05030b"] signatureTest :: Spec signatureTest = packSpecManual "signature" allTestMethods VSignature [ item "edsigtrs8bK7vNfiR4Kd9dWasVa1bAWaQSu2ipnmLGZuwQa8\ \ktCEMYVKqbWsbJ7zTS8dgYT9tiSUKorWCPFHosL5zPsiDwBQ6vb" "050a0000004091ac1e7fd668854fc7a40feec4034e42c06c068cce10622c607fda232d\ \b34c8cf5d8da83098dd891cd4cb4299b3fa0352ae323ad99b24541e54b91888fdc8201" , item "spsig1Ng2bs4PXCbjaFGuojk9K5Pt3CkfbUZyHLLrBxHSmTq\ \rUUxQggi4yJBit3Ljqnqr61UpdTewTLiu4schSCfZvaRwu412oZ" "0x050a0000004080e4e72ffecf72953789625b1125e9f45f432c14e53a01ec68a1e1b77\ \d60cfe96a97443733ba0f7f42db3a56d7a433df2b4fc0035c05ab92d062f33c5bab0244" , item "p2sigRmXDp38VNVaEQH28LYukfLPn8QB5hPEberhvQrrUpRs\ \cDZJrrApbRh2u46PTVTwKXjxTLKNN9dyLhPQU6U6jWPGxe4d9v" "0x050a00000040222222222222222222222222222222222222222222222222222222222\ \22222222222222222222222222222222222222222222222222222222222222222222222" , item "sigrZRt6CTBNtRzjMFQYSZhUm1QcDg5gopVgiRTLMQsgikeR\ \LmrmsA5vmFqjrnBhofzqvKtc9k5VhTzCMCio5epRvu9no73S" "0x050a00000040da632d7f267673fab5a40562778a6890b6ada9665d53d7ff318e3399e\ \032b3986588dadcf3bf3b549592f7b8ea1365273fbef5f4883c3430ed32e8ae24017be1" ] where item sigStr sigBytes = ( leftToShowPanic $ parseSignature sigStr, sigBytes) chainIdTest :: Spec chainIdTest = packSpecManual "chain_id" allTestMethods VChainId [ ( leftToShowPanic $ parseChainId "NetXUdfLh6Gm88t" , "0x050a00000004458aa837" ) ] optionTest :: Spec optionTest = do packSpec @(Maybe Integer) [ Just 123 ~: "05050900bb01" , Nothing ~: "050306" ] packSpec @(Maybe MText) [ Just [mt|Goodnight World!|] ~: "0505090100000010476f6f646e6967687420576f726c6421" ] listTest :: Spec listTest = packSpec @[Integer] [ [] ~: "050200000000" , [1] ~: "0502000000020001" , [1..3] ~: "050200000006000100020003" ] setTest :: Spec setTest = packSpec @(Set Integer) [ [] ~: "050200000000" , [1] ~: "0502000000020001" , [0, 10, 24, 35, 100, 1000] ~: "05020000000e0000000a0018002300a40100a80f" ] contractTest :: Spec contractTest = do packSpecManual "simple contract" packTestMethods (addressToVContract @'TUnit) $ parseAddrs [ "tz1PYgf9fBGLXvwx8ag8sdwjLJzmyGdNiswM" ~: "050a0000001600002addb327dbca405f07aeef318bba0ec2f714a755" , "tz1Z1nn9Y7vzyvtf6rAYMPhPNGqMJXw88xGH" ~: "050a00000016000092b72c0fa1064331a641131f572e7f2abb9a890b" ] packSpecManual "non-unit contract" packTestMethods (addressToVContract @'TInt) $ parseAddrs [ "KT1AEseqMV6fk2vtvQCVyA7ZCaxv7cpxtXdB" ~: "0x050a0000001601122d038abd69be91b4b6803f2f098a088e259e7200" ] packSpecManual "contract with entrypoint" packTestMethods (mkEpVContract @'TInt) $ parseEpAddrs [ "KT1AEseqMV6fk2vtvQCVyA7ZCaxv7cpxtXdB%" ~: "0x050a0000001601122d038abd69be91b4b6803f2f098a088e259e7200" , "KT1AEseqMV6fk2vtvQCVyA7ZCaxv7cpxtXdB%abacaba" ~: "0x050a0000001d01122d038abd69be91b4b6803f2f098a088e259e720061626163616261" , "tz1Z1nn9Y7vzyvtf6rAYMPhPNGqMJXw88xGH%a" ~: "0x050a00000017000092b72c0fa1064331a641131f572e7f2abb9a890b61" ] where parseAddrs = map $ first unsafeParseAddress parseEpAddrs = map $ first unsafeParseEpAddress mkEpVContract :: forall p. ParameterScope p => EpAddress -> Value ('TContract p) mkEpVContract EpAddress{..} = VContract eaAddress (SomeEpc epcCallRootUnsafe{ epcName = eaEntryPoint }) pairTest :: Spec pairTest = do packSpec @(MText, Integer) [ ([mt|Good Night!|], 5) ~: "050707010000000b476f6f64204e69676874210005" ] packSpec @(Integer, (Integer, MText)) [ (120, (5, [mt|What is that?|])) ~: "05070700b80107070005010000000d5768617420697320746861743f" ] orTest :: Spec orTest = packSpec @(Either MText Bool) [ Left [mt|Error|] ~: "05050501000000054572726f72" , Right True ~: "050508030a" ] mapTest :: Spec mapTest = do packSpec @(Map Integer MText) [ [] ~: "050200000000" , [(0, [mt|Hello|]), (1, [mt|Goodbye|]), (2, [mt|Goodnight|])] ~: "05020000003007040000010000000548656c6c6f07040001010000000\ \7476f6f64627965070400020100000009476f6f646e69676874" ] packSpec @(Map MText (Integer, Bool)) [ [ ([mt|Tudor|], (123, True)) , ([mt|Lancaster|], (22323, False)) , ([mt|Stuart|], (-832988, True)) ] ~: "050200000040070401000000094c616e636173746572070700b3dc0203\ \0307040100000006537475617274070700dcd765030a07040100000005\ \5475646f72070700bb01030a" ] instrTest :: Spec instrTest = do -- Values we compare against are produced with command -- ./alphanet.sh client hash data "{ $instrs }" of type 'lambda int int' parsePackSpec @'TInt @'TInt "instr" [ "" ~: "0x050200000000" , "PUSH int 1; DROP" ~: "0x0502000000080743035b00010320" , "DUP; SWAP; DROP" ~: "0x0502000000060321034c0320" , "UNIT; DUUP; DROP 2" ~: "0x050200000016034f020000000b051f02000000020321034c05200002" , "UNIT; UNIT; DUUUP; DROP 3" ~: "0x05020000001c034f034f020000000f071f0002020000000203210570000305200003" , "DIG 0" ~: "0x05020000000405700000" , "UNIT; DIG 1; DIP { DROP }" ~: "0x05020000000f034f05700001051f02000000020320" , "DUG 0" ~: "0x05020000000405710000" , "UNIT; DUG 1; DIP { DROP }" ~: "0x05020000000f034f05710001051f02000000020320" , "UNIT; DROP" ~: "0x050200000004034f0320" , "UNIT :u; DROP" ~: "0x05020000000a044f000000023a750320" , "UNIT; DROP 1" ~: "0x050200000006034f05200001" , "DROP 0" ~: "0x05020000000405200000" , "UNIT; UNIT; UNIT; DROP 3" ~: "0x05020000000a034f034f034f05200003" , "PUSH int 1; SOME; IF_NONE {} {DROP}" ~: "0x0502000000160743035b00010346072f020000000002000000020320" , "PUSH int 1; SOME; IF_SOME {DROP} {}" ~: "0x05020000001b0743035b00010346020000000e072f020000000002000000020320" , "PUSH int 1; SOME :s; IF_SOME {DROP} {}" ~: "0x0502000000210743035b00010446000000023a73020000000e072f020000000\ \002000000020320" , "NONE int; DROP" ~: "0x050200000006053e035b0320" , "NONE :n int; DROP" ~: "0x05020000000c063e035b000000023a6e0320" , "PUSH int 1; PAIR; CAR" ~: "0x05020000000a0743035b000103420316" , "PUSH int 1; PAIR :p; CAR" ~: "0x0502000000100743035b00010442000000023a700316" , "PUSH int 1; PAIR % %o; CAR" ~: "0x0502000000120743035b00010442000000042520256f0316" , "PUSH int 1; PAIR %o %; CAR" ~: "0x0502000000100743035b0001044200000002256f0316" , "PUSH int 1; PAIR %o; CAR" ~: "0x0502000000100743035b0001044200000002256f0316" , "PUSH int 1; PAIR :p %l %r; CAR" ~: "0x0502000000160743035b00010442000000083a7020256c2025720316" , "PUSH int 1; PAIR %l %r; CAR %l" ~: "0x0502000000190743035b0001044200000005256c202572041600000002256c" , "PUSH int 1; PAIR %l %r; CDR %r" ~: "0x0502000000190743035b0001044200000005256c2025720417000000022572" , "LEFT unit; IF_LEFT {} { DROP; PUSH int 1 }" ~: "0x0502000000180533036c072e0200000000020000000803200743035b0001" , "LEFT :lu %l %r unit; IF_LEFT {} { DROP; PUSH int 1 }" ~: "0x0502000000250633036c000000093a6c7520256c202572072e0200000000020\ \000000803200743035b0001" , "RIGHT unit; IF_RIGHT {} { DROP; PUSH int 1 }" ~: "0x05020000001d0544036c0200000014072e020000000803200743035b00010200000000" , "DUP; NIL int; SWAP; CONS; SIZE; DROP" ~: "0x05020000000e0321053d035b034c031b03450320" , "NIL int; IF_CONS { DROP; DROP } {}" ~: "0x050200000014053d035b072d0200000004032003200200000000" , "NIL :ni int; IF_CONS { DROP; DROP } {}" ~: "0x05020000001b063d035b000000033a6e69072d0200000004032003200200000000" , "EMPTY_SET int; ITER { DROP }" ~: "0x05020000000d0524035b055202000000020320" , "EMPTY_SET :si int; ITER { DROP }" ~: "0x0502000000140624035b000000033a7369055202000000020320" , "EMPTY_MAP int unit; MAP {}; DROP" ~: "0x05020000000f0723035b036c053802000000000320" , "EMPTY_MAP :miu int unit; MAP {}; DROP" ~: "0x0502000000170823035b036c000000043a6d6975053802000000000320" , "EMPTY_MAP int unit; PUSH int 1; MEM; DROP" ~: "0x0502000000100723035b036c0743035b000103390320" , "EMPTY_MAP int unit; PUSH int 1; GET; DROP" ~: "0x0502000000100723035b036c0743035b000103290320" , "EMPTY_MAP int unit; NONE unit; PUSH int 1; UPDATE; DROP" ~: "0x0502000000140723035b036c053e036c0743035b000103500320" , "EMPTY_BIG_MAP int unit; PUSH int 1; GET; DROP" ~: "0x0502000000100772035b036c0743035b000103290320" , "EMPTY_BIG_MAP :bmiu int unit; PUSH int 1; GET; DROP" ~: "0x0502000000190872035b036c000000053a626d69750743035b000103290320" , "PUSH bool True; IF {} {}" ~: "0x05020000001207430359030a072c02000000000200000000" , "PUSH bool True; LOOP { PUSH bool False }" ~: "0x05020000001307430359030a05340200000006074303590303" , "PUSH (or int int) (Left 1); LOOP_LEFT { RIGHT int }; DROP" ~: "0x05020000001907430764035b035b05050001055302000000040544035b0320" , "LAMBDA int int { PUSH int 1; DROP }; SWAP; EXEC" ~: "0x05020000001f093100000011035b035b02000000080743035b0001032000000000034c0326" , "DUP; LAMBDA (pair int int) int { CAR }; SWAP; APPLY; SWAP; EXEC" ~: "0x050200000023032109310000000f0765035b035b035b0200000002031600000000034c0373\ \034c0326" , "DIP {}" ~: "0x050200000007051f0200000000" , "DIP 1 {}" ~: "0x050200000009071f00010200000000" , "DIP 0 {}" ~: "0x050200000009071f00000200000000" , "UNIT; UNIT; DIP 3 { UNIT; DROP }; DROP; DROP" ~: "0x050200000015034f034f071f00030200000004034f032003200320" , "UNIT; UNIT; DIIIP { UNIT; DROP }; DROP; DROP" ~: "0x050200000015034f034f071f00030200000004034f032003200320" , "FAILWITH" ~: "0x0502000000020327" , "CAST int" ~: "0x0502000000040557035b" , "RENAME" ~: "0x0502000000020358" , "DUP; PACK; UNPACK unit; DROP" ~: "0x05020000000a0321030c050d036c0320" , "DUP; PACK; UNPACK :uu unit; DROP" ~: "0x0502000000110321030c060d036c000000033a75750320" , "PUSH string \"\"; DUP; CONCAT; DROP" ~: "0x05020000000f0743036801000000000321031a0320" , "NIL string; CONCAT; DROP" ~: "0x050200000008053d0368031a0320" , "PUSH string \"\"; PUSH nat 1; PUSH nat 2; SLICE; DROP" ~: "0x050200000019074303680100000000074303620001074303620002036f0320" , "PUSH int 1; ISNAT; DROP" ~: "0x05020000000a0743035b000103560320" -- Arithmetic instructions are below , "PUSH nat 1; INT; DROP" ~: "0x05020000000a07430362000103300320" -- SELF cannot appear in lambda -- CONTRACT - IMPLICIT_ACCOUNT go below , "NOW; DROP" ~: "0x05020000000403400320" , "AMOUNT; DROP" ~: "0x05020000000403130320" , "BALANCE; DROP" ~: "0x05020000000403150320" -- CHECK_SIGNATURE goes below , "PUSH bytes 0x; SHA256; DROP" ~: "0x05020000000d074303690a00000000030f0320" , "PUSH bytes 0x; SHA512; DROP" ~: "0x05020000000d074303690a0000000003100320" , "PUSH bytes 0x; BLAKE2B; DROP" ~: "0x05020000000d074303690a00000000030e0320" -- HASH_KEY goes below , "SOURCE; DROP" ~: "0x05020000000403470320" , "SENDER; DROP" ~: "0x05020000000403480320" -- ADDRESS goes below , "CHAIN_ID; DROP" ~: "0x05020000000403750320" -- DUP macro , "PUSH nat 1; PUSH nat 1; DUP 2; DROP; DROP; DROP" ~: "0x050200000022074303620001074303620001020000000b051f02000000020321034c032003200320" , "PUSH nat 1; PUSH nat 1; DUUP; DROP; DROP; DROP" ~: "0x050200000022074303620001074303620001020000000b051f02000000020321034c032003200320" ] parsePackSpec @'TUnit @'TUnit "arith instr" [ "PUSH int 1; PUSH int 2; ADD; DROP" ~: "0x0502000000100743035b00010743035b000203120320" , "PUSH int 1; PUSH int 2; SUB; DROP" ~: "0x0502000000100743035b00010743035b0002034b0320" , "PUSH int 1; PUSH int 2; MUL; DROP" ~: "0x0502000000100743035b00010743035b0002033a0320" , "PUSH int 1; PUSH int 2; EDIV; DROP" ~: "0x0502000000100743035b00010743035b000203220320" , "PUSH int 1; ABS; DROP" ~: "0x05020000000a0743035b000103110320" , "PUSH int 1; NEG @kek; DROP" ~: "0x05020000000a0743035b0001033b0320" , "PUSH nat 1; PUSH nat 2; LSL; DROP" ~: "0x05020000001007430362000107430362000203350320" , "PUSH nat 1; PUSH nat 2; LSR; DROP" ~: "0x05020000001007430362000107430362000203360320" , "PUSH nat 1; PUSH nat 2; OR; DROP" ~: "0x05020000001007430362000107430362000203410320" , "PUSH nat 1; PUSH nat 2; XOR; DROP" ~: "0x05020000001007430362000107430362000203510320" , "PUSH int 1; NOT; DROP" ~: "0x05020000000a0743035b0001033f0320" , "PUSH nat 1; PUSH nat 2; COMPARE; DROP" ~: "0x05020000001007430362000107430362000203190320" , "PUSH int 1; EQ; DROP" ~: "0x05020000000a0743035b000103250320" , "PUSH int 1; NEQ; DROP" ~: "0x05020000000a0743035b0001033c0320" , "PUSH int 1; LT; DROP" ~: "0x05020000000a0743035b000103370320" , "PUSH int 1; GT; DROP" ~: "0x05020000000a0743035b0001032a0320" , "PUSH int 1; LE; DROP" ~: "0x05020000000a0743035b000103320320" , "PUSH int 1; GE; DROP" ~: "0x05020000000a0743035b000103280320" ] parsePackSpec @'TAddress @'TUnit "instrs address-related" [ "CONTRACT unit; DROP; PUSH unit Unit" ~: "0x05020000000c0555036c03200743036c030b" , "CONTRACT %entrypnt unit; DROP; PUSH unit Unit" ~: "0x0502000000190655036c0000000925656e747279706e7403200743036c030b" ] parsePackSpec @('TContract 'TUnit) @'TUnit "instrs contract-related" [ "PUSH mutez 5; PUSH unit Unit; TRANSFER_TOKENS; DROP; PUSH unit Unit" ~: "0x0502000000160743036a00050743036c030b034d03200743036c030b" , "ADDRESS; DROP; PUSH unit Unit" ~: "0x05020000000a035403200743036c030b" ] parsePackSpec @'TKeyHash @'TUnit "instrs key-hash-related" [ "SOME; SET_DELEGATE; DROP; PUSH unit Unit" ~: "0x05020000000c0346034e03200743036c030b" , "SOME; DIP{ PUSH unit Unit; PUSH mutez 5; }; \ \ CREATE_CONTRACT{ \ \ parameter unit; \ \ storage unit; \ \ code { DROP; UNIT; NIL operation; PAIR } \ \ }; \ \ DROP; DROP; PUSH unit Unit \ \" ~: "0x05020000003f0346051f020000000c0743036c030b0743036a0005051d020000\ \00190500036c0501036c0502020000000a0320034f053d036d0342032003200743\ \036c030b" , "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" , "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\ \f0500045b000000083a702025726f6f740501045b000000023a730502020000000e\ \03200743035b000a053d036d0342032003200743036c030b" , "IMPLICIT_ACCOUNT; DROP; PUSH unit Unit" ~: "0x05020000000a031e03200743036c030b" ] parsePackSpec @'TKey @'TKeyHash "instrs public-key-related" [ "HASH_KEY" ~: "0x050200000002032b" ] parsePackSpec @('TPair 'TSignature 'TKey) @'TBool "instrs public-key-related" [ "DIP{ PUSH bytes 0x }; DUP; DIP {CAR}; CDR; CHECK_SIGNATURE" ~: "0x05020000001f051f0200000009074303690a000000000321051f020000\ \0002031603170318" ] typesTest :: Spec typesTest = do -- Bytes we compare agains are produced with command -- ./alphanet.sh client hash data '{ LAMBDA ($ty) ($ty) {}; DROP }' of type 'lambda unit unit' / -- | tr -d '\n' | awk '{ print $45 }' | sed 's/Hash://' parsePackSpec @'TUnit @'TUnit "types" [ lambdaWrap "int" ~: "0x050200000015093100000009035b035b0200000000000000000320" , lambdaWrap "int :i" ~: "0x050200000021093100000015045b000000023a69045b000000023a690200000\ \000000000000320" , lambdaWrap "nat" ~: "0x050200000015093100000009036203620200000000000000000320" , lambdaWrap "string" ~: "0x050200000015093100000009036803680200000000000000000320" , lambdaWrap "bytes" ~: "0x050200000015093100000009036903690200000000000000000320" , lambdaWrap "mutez" ~: "0x050200000015093100000009036a036a0200000000000000000320" , lambdaWrap "bool" ~: "0x050200000015093100000009035903590200000000000000000320" , lambdaWrap "key_hash" ~: "0x050200000015093100000009035d035d0200000000000000000320" , lambdaWrap "timestamp" ~: "0x050200000015093100000009036b036b0200000000000000000320" , lambdaWrap "address" ~: "0x050200000015093100000009036e036e0200000000000000000320" , lambdaWrap "key" ~: "0x050200000015093100000009035c035c0200000000000000000320" , lambdaWrap "unit" ~: "0x050200000015093100000009036c036c0200000000000000000320" , lambdaWrap "signature" ~: "0x050200000015093100000009036703670200000000000000000320" , lambdaWrap "chain_id" ~: "0x050200000015093100000009037403740200000000000000000320" , lambdaWrap "option unit" ~: "0x05020000001909310000000d0563036c0563036c0200000000000000000320" , lambdaWrap "set int" ~: "0x05020000001909310000000d0566035b0566035b0200000000000000000320" , lambdaWrap "set :s int" ~: "0x0502000000250931000000190666035b000000023a730666035b000000023a7\ \30200000000000000000320" , lambdaWrap "set :s (int :i)" ~: "0x0502000000310931000000250666045b000000023a69000000023a730666045\ \b000000023a69000000023a730200000000000000000320" , lambdaWrap "operation" ~: "0x050200000015093100000009036d036d0200000000000000000320" , lambdaWrap "contract unit" ~: "0x05020000001909310000000d055a036c055a036c0200000000000000000320" , lambdaWrap "pair unit int" ~: "0x05020000001d0931000000110765036c035b0765036c035b0200000000000000000320" , lambdaWrap "pair :point (int %x) (int %y)" ~: "0x05020000004909310000003d0865045b000000022578045b000000022579000\ \000063a706f696e740865045b000000022578045b000000022579000000063a70\ \6f696e740200000000000000000320" , lambdaWrap "pair :point3d (pair :point (int %x) (int %y)) (int %z)" ~: "0x05020000007509310000006908650865045b000000022578045b00000002257\ \9000000063a706f696e74045b00000002257a000000083a706f696e7433640865\ \0865045b000000022578045b000000022579000000063a706f696e74045b00000\ \002257a000000083a706f696e7433640200000000000000000320" , lambdaWrap "or unit int" ~: "0x05020000001d0931000000110764036c035b0764036c035b0200000000000000000320" , lambdaWrap "or (unit :u %l) (int :i %r)" ~: "0x0502000000410931000000350764046c000000053a7520256c045b000000053\ \a692025720764046c000000053a7520256c045b000000053a6920257202000000\ \00000000000320" , lambdaWrap "lambda unit int" ~: "0x05020000001d093100000011075e036c035b075e036c035b0200000000000000000320" , lambdaWrap "lambda :l (unit :n) (int :t)" ~: "0x050200000041093100000035085e046c000000023a6e045b000000023a74000\ \000023a6c085e046c000000023a6e045b000000023a74000000023a6c02000000\ \00000000000320" , lambdaWrap "map int unit" ~: "0x05020000001d0931000000110760035b036c0760035b036c0200000000000000000320" , lambdaWrap "big_map int unit" ~: "0x05020000001d0931000000110761035b036c0761035b036c0200000000000000000320" ] where lambdaWrap ty = "LAMBDA " <> ty <> " " <> ty <> " {}; DROP" unpackNegTest :: Spec unpackNegTest = do describe "Bad entries order" $ do unpackNegSpec @('TSet 'TInt) "Unordered set elements" "0x050200000006000300020001" -- { 3; 2; 1 } unpackNegSpec @('TMap 'TInt $ 'TInt) "Unordered map elements" "0x05020000000c070400020006070400010007" -- { Elt 2 6; Elt 1 7 } describe "Wrong length specified" $ do unpackNegSpec @('TList $ 'TInt) "Too few list length" "0x05020000000300010002" -- { 1; 2 } unpackNegSpec @('TList $ 'TInt) "Too big list length" "0x05020000000500010002" -- { 1; 2 } unpackNegSpec @('TList $ 'TInt) "Wrong bytes length" "0x050b000000021234" -- 0x1234 describe "Type check failures" $ do unpackNegSpec @('TUnit) "Value type mismatch" "0x050008" -- 8 unpackNegSpec @('TLambda 'TUnit 'TKey) "Lambda type mismatch" "0x050200000000" -- {} unpackNegSpec @('TLambda 'TUnit 'TKey) "Lambda too large output stack size" "0x0502000000060743035b0005" -- {PUSH int 5} unpackNegSpec @('TLambda 'TUnit 'TKey) "Lambda empty output stack size" "0x0502000000020320" -- {DROP} describe "Invalid annotations specified" $ do unpackNegSpec @('TLambda ('TPair 'TInt 'TInt) 'TInt) "Space char `20` in the middle of an annotation" "0x050200000009041600000003252061" unpackNegSpec @('TLambda ('TPair 'TInt 'TInt) 'TInt) "Char from invalid range `00-1F` as part of an annotation" "0x050200000009041600000003251A61" unpackNegSpec @('TLambda ('TPair 'TInt 'TInt) 'TInt) "Char from invalid range `A0-FF` as part of an annotation" "0x05020000000904160000000325A361" unpackVarAnnTest :: Spec unpackVarAnnTest = do describe "Unpack instructions with Variable Annotations" $ do parseUnpackOnlySpec @'TInt @'TInt "VarAnn instr" [ "DUP @dp; SWAP; DROP" ~: "0x05020000000d042100000003406470034c0320" , "UNIT @un; DROP" ~: "0x05020000000b044f0000000340756e0320" , "NONE @nn int; DROP" ~: "0x05020000000d063e035b00000003406e6e0320" , "PUSH @vn int 1; PAIR @vpn; CAR @vn" ~: "0x0502000000200843035b00010000000340766e0442000000044076706e0416\ \0000000340766e" , "PUSH int 1; PAIR; CDR @dr" ~: "0x0502000000110743035b00010342041700000003406472" , "LEFT @ll unit; IF_LEFT {} { DROP; PUSH int 1 }" ~: "0x05020000001f0633036c00000003406c6c072e020000000002000000080320\ \0743035b0001" , "RIGHT @rl unit; IF_RIGHT {} { DROP; PUSH int 1 }" ~: "0x0502000000240644036c0000000340726c0200000014072e02000000080320\ \0743035b00010200000000" , "DUP; NIL @al int; SWAP; CONS @dl; SIZE @sl; DROP" ~: "0x0502000000230321063d035b0000000340616c034c041b0000000340646c04\ \450000000340736c0320" , "EMPTY_SET :si @si int; ITER { DROP }" ~: "0x0502000000180624035b000000073a736920407369055202000000020320" , "EMPTY_MAP @em :miu int unit; MAP @dm {}; DROP" ~: "0x0502000000220823035b036c0000000840656d203a6d697506380200000000\ \0000000340646d0320" , "EMPTY_MAP @sm int unit; PUSH int 1; MEM @mmm; DROP" ~: "0x05020000001f0823035b036c0000000340736d0743035b0001043900000004406d6d6d0320" , "EMPTY_MAP int unit; NONE unit; PUSH int 1; UPDATE @ups; DROP" ~: "0x05020000001c0723035b036c053e036c0743035b0001045000000004407570730320" , "EMPTY_BIG_MAP int unit; PUSH int 1; GET @gg; DROP" ~: "0x0502000000170772035b036c0743035b00010429000000034067670320" , "LAMBDA @lii int int { PUSH int 1; DROP }; SWAP; EXEC" ~: "0x050200000023093100000011035b035b02000000080743035b000103200000\ \0004406c6969034c0326" , "PUSH string \"\"; DUP; CONCAT @c; DROP" ~: "0x0502000000150743036801000000000321041a0000000240630320" , "PUSH int 1; PUSH int 2; ADD @a; DROP" ~: "0x0502000000160743035b00010743035b000204120000000240610320" , "PUSH int 1; PUSH int 2; SUB @s; DROP" ~: "0x0502000000160743035b00010743035b0002044b0000000240730320" , "PUSH int 1; PUSH int 2; MUL @m; DROP" ~: "0x0502000000160743035b00010743035b0002043a00000002406d0320" , "PUSH int 1; PUSH int 2; EDIV @edv; DROP" ~: "0x0502000000180743035b00010743035b0002042200000004406564760320" , "PUSH int 1; ABS @a; DROP" ~: "0x0502000000100743035b000104110000000240610320" , "PUSH int 1; NEG @n; DROP" ~: "0x0502000000100743035b0001043b00000002406e0320" , "PUSH nat 1; PUSH nat 2; LSL @ll; DROP" ~: "0x050200000017074303620001074303620002043500000003406c6c0320" , "PUSH nat 1; PUSH nat 2; LSR @lr; DROP" ~: "0x050200000017074303620001074303620002043600000003406c720320" , "PUSH nat 1; PUSH nat 2; OR @o; DROP" ~: "0x050200000016074303620001074303620002044100000002406f0320" , "PUSH nat 1; PUSH nat 2; XOR @x; DROP" ~: "0x05020000001607430362000107430362000204510000000240780320" , "PUSH int 1; NOT @n; DROP" ~: "0x0502000000100743035b0001043f00000002406e0320" , "PUSH nat 1; PUSH nat 2; COMPARE @cp; DROP" ~: "0x0502000000170743036200010743036200020419000000034063700320" , "PUSH int 1; EQ @e; DROP" ~: "0x0502000000100743035b000104250000000240650320" , "PUSH int 1; NEQ @ne; DROP" ~: "0x0502000000110743035b0001043c00000003406e650320" , "PUSH int 1; LT @l; DROP" ~: "0x0502000000100743035b0001043700000002406c0320" , "PUSH int 1; GT @g; DROP" ~: "0x0502000000100743035b0001042a0000000240670320" , "PUSH int 1; LE @e; DROP" ~: "0x0502000000100743035b000104320000000240650320" , "PUSH int 1; GE @g; DROP" ~: "0x0502000000100743035b000104280000000240670320" , "PUSH int 1; ISNAT @i; DROP" ~: "0x0502000000100743035b000104560000000240690320" , "PUSH nat 1; INT @i; DROP" ~: "0x05020000001007430362000104300000000240690320" , "NOW @n; DROP" ~: "0x05020000000a044000000002406e0320" , "AMOUNT @a; DROP" ~: "0x05020000000a04130000000240610320" , "BALANCE @b; DROP" ~: "0x05020000000a04150000000240620320" , "PUSH bytes 0x; BLAKE2B @b2b; DROP" ~: "0x050200000015074303690a00000000040e00000004406232620320" , "SOURCE @src; DROP" ~: "0x05020000000c044700000004407372630320" , "SENDER @s; DROP" ~: "0x05020000000a04480000000240730320" , "CHAIN_ID @cid; DROP" ~: "0x05020000000c047500000004406369640320" , "CAST @c int" ~: "0x05020000000a0657035b000000024063" , "RENAME @r" ~: "0x0502000000080458000000024072" ] parseUnpackOnlySpec @'TAddress @'TUnit "VarAnn instrs address-related" [ "CONTRACT @c unit; DROP; PUSH unit Unit" ~: "0x0502000000120655036c00000002406303200743036c030b" ] parseUnpackOnlySpec @('TContract 'TUnit) @'TUnit "VarAnn instrs contract-related" [ "ADDRESS @a; DROP; PUSH unit Unit" ~: "0x050200000010045400000002406103200743036c030b" ] parseUnpackOnlySpec @'TKeyHash @'TUnit "VarAnn instrs key-hash-related" [ "SOME; SET_DELEGATE @d; DROP; PUSH unit Unit" ~: "0x0502000000120346044e00000002406403200743036c030b" , "SOME; DIP{ PUSH int 1; PUSH mutez 5 }; \ \ CREATE_CONTRACT @ez { \ \ parameter (int :p); \ \ storage (int :s); \ \ code { DROP; PUSH int 10; NIL operation; PAIR } \ \ }; \ \ DROP; DROP; PUSH unit Unit \ \" ~: "0x0502000000560346051f020000000c0743035b00010743036a0005061d02000\ \000290500045b000000023a700501045b000000023a730502020000000e032007\ \43035b000a053d036d03420000000340657a032003200743036c030b" , "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" , "IMPLICIT_ACCOUNT @i; DROP; PUSH unit Unit" ~: "0x050200000010041e00000002406903200743036c030b" ] parseUnpackOnlySpec @'TKey @'TKeyHash "VarAnn instrs public-key-related" [ "HASH_KEY @h" ~: "0x050200000008042b000000024068" ] parseUnpackOnlySpec @('TPair 'TSignature 'TKey) @'TBool "VarAnn instrs public-key-related" [ "DIP{ PUSH bytes 0x }; DUP; DIP {CAR}; CDR; CHECK_SIGNATURE @c" ~: "0x050200000025051f0200000009074303690a000000000321051f0200000002\ \031603170418000000024063" ] readableUnpackTest :: Spec readableUnpackTest = do describe "Unpack crypto primitives from Readable representation" $ do -- ./tezos-client hash data '"tz1akcPmG1Kyz2jXpS4RvVJ8uWr7tsiT9i6A"' of type 'string' unpackReadableSpec @'TAddress "Unpack readable address" "0x050100000024747a31666173774354446369527a45346f4a396a6e32566\ \d3264766a6579413966557a55" -- ./tezos-client hash data '"edpktezaD1wnUa5pT2pvj1JGHNey18WGhPc9fk9bbppD33KNQ2vH8R"' -- of type 'string' unpackReadableSpec @'TKey "Unpack readable public key" "0x0501000000366564706b74657a614431776e55613570543270766a314a4\ \7484e65793138574768506339666b39626270704433334b4e513276483852" -- ./tezos-client-babylonnet hash data '"edsigtqgdc2JLMDcERHo61Y76mrxqCeqDE5YhHiBo\ -- \VtwjhFKahAkCT7RCZKQLhLJ3yJbrVyJCkVGEoiHbyKytHW846dDC4P121K"' of type 'string' unpackReadableSpec @'TSignature "Unpack readable signature" "0x05010000006365647369677471676463324a4c4d44634552486f36315937\ \366d72787143657144453559684869426f5674776a68464b6168416b435437\ \52435a4b514c684c4a33794a627256794a436b5647456f694862794b797448\ \5738343664444334503132314b" -- ./tezos-client-babylonnet hash data '"NetXUdfLh6Gm88t"' of type string unpackReadableSpec @'TChainId "Unpack readable chain_id" "0x05010000000f4e6574585564664c6836476d383874" where unpackReadableSpec :: forall t. (UnpackedValScope t) => String -> Text -> Spec unpackReadableSpec name encodedHex = it name $ let encoded = decodeHex (stripOptional0x encodedHex) ?: error ("Invalid hex: " <> show encodedHex) in runUnpack @t encoded `shouldSatisfy` isRight lengthsAreNotIgnoredTest :: Spec lengthsAreNotIgnoredTest = describe "Lengths are not ignored in ChainId" $ do let chainId = ChainIdUnsafe "\0\0\0\0" properEncoded = fromHex "050a0000000400000000" badEncodedGt = fromHex "050a0000000500000000" badEncodedLt = 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