Main.hs (8990B)
1 {-# OPTIONS_GHC -fno-warn-orphans #-} 2 {-# LANGUAGE BangPatterns #-} 3 {-# LANGUAGE NumericUnderscores #-} 4 {-# LANGUAGE OverloadedStrings #-} 5 6 module Main where 7 8 import Bitcoin.Prim.Script 9 import qualified Data.ByteString as BS 10 import qualified Data.ByteString.Base16 as B16 11 import qualified Data.Primitive.ByteArray as BA 12 import Test.Tasty 13 import qualified Test.Tasty.HUnit as H 14 import qualified Test.Tasty.QuickCheck as Q 15 16 -- types ---------------------------------------------------------------------- 17 18 newtype BS = BS BS.ByteString 19 deriving (Eq, Show) 20 21 bytes :: Int -> Q.Gen BS.ByteString 22 bytes k = do 23 l <- Q.chooseInt (0, k) 24 v <- Q.vectorOf l Q.arbitrary 25 pure (BS.pack v) 26 27 instance Q.Arbitrary BS where 28 arbitrary = do 29 b <- bytes 20_000 30 pure (BS b) 31 32 newtype HexBS = HexBS BS.ByteString 33 deriving (Eq, Show) 34 35 instance Q.Arbitrary HexBS where 36 arbitrary = do 37 b <- bytes 20_000 38 pure (HexBS (B16.encode b)) 39 40 instance Q.Arbitrary BA.ByteArray where 41 arbitrary = do 42 b <- bytes 20_000 43 pure (bs_to_ba b) 44 45 -- generated scripts will tend to be pathological due to pushdata 46 newtype RawScript = RawScript Script 47 deriving (Eq, Show) 48 49 instance Q.Arbitrary RawScript where 50 arbitrary = fmap (RawScript . Script) Q.arbitrary 51 52 -- XX better generators would be nice. 53 -- pushdata generation needs to be handled carefully. 54 55 newtype NonPathologicalScript = NonPathologicalScript Script 56 deriving (Eq, Show) 57 58 instance Q.Arbitrary NonPathologicalScript where 59 arbitrary = do 60 l <- Q.chooseInt (0, 1_024) 61 -- pushdata must be added with care; easy to blow up quickcheck 62 bs <- fmap BS.pack (Q.vectorOf l (Q.chooseEnum (80, 255))) 63 pure (NonPathologicalScript (Script (bs_to_ba bs))) 64 65 -- properties ----------------------------------------------------------------- 66 67 ba_to_bs_inverts_bs_to_ba :: BS -> Bool 68 ba_to_bs_inverts_bs_to_ba (BS bs) = ba_to_bs (bs_to_ba bs) == bs 69 70 bs_to_ba_inverts_ba_to_bs :: BA.ByteArray -> Bool 71 bs_to_ba_inverts_ba_to_bs ba = bs_to_ba (ba_to_bs ba) == ba 72 73 from_base16_inverts_to_base16 :: RawScript -> Bool 74 from_base16_inverts_to_base16 (RawScript s) = 75 let mscript = from_base16 (to_base16 s) 76 in case mscript of 77 Nothing -> False 78 Just script -> script == s 79 80 to_base16_inverts_from_base16 :: HexBS -> Bool 81 to_base16_inverts_from_base16 (HexBS bs) = 82 let mscript = from_base16 bs 83 in case mscript of 84 Nothing -> False 85 Just script -> to_base16 script == bs 86 87 -- we can only use 'from_script' on non-pathological scripts 88 -- 89 -- note the converse (from_script . to_script ~ id) is not true 90 to_script_inverts_from_script :: NonPathologicalScript -> Bool 91 to_script_inverts_from_script (NonPathologicalScript s) = 92 let !terms = from_script s 93 !script = to_script terms 94 in script == s 95 96 -- assertions ----------------------------------------------------------------- 97 98 decodes_to :: BS.ByteString -> [Term] -> H.Assertion 99 decodes_to bs ts = do 100 let mscript = from_base16 bs 101 case mscript of 102 Nothing -> H.assertFailure "invalid bytestring" 103 Just script -> do 104 let terms = from_script script 105 H.assertEqual mempty terms ts 106 107 -- p2pkh 108 p2pkh :: BS.ByteString 109 p2pkh = "76a91489abcdefabbaabbaabbaabbaabbaabbaabbaabba88ac" 110 111 p2pkh_terms :: [Term] 112 p2pkh_terms = [ 113 OPCODE OP_DUP,OPCODE OP_HASH160,OPCODE OP_PUSHBYTES_20,BYTE 0x89,BYTE 0xab 114 , BYTE 0xcd,BYTE 0xef,BYTE 0xab,BYTE 0xba,BYTE 0xab,BYTE 0xba,BYTE 0xab 115 , BYTE 0xba,BYTE 0xab,BYTE 0xba,BYTE 0xab,BYTE 0xba,BYTE 0xab,BYTE 0xba 116 , BYTE 0xab,BYTE 0xba,BYTE 0xab,BYTE 0xba,OPCODE OP_EQUALVERIFY 117 , OPCODE OP_CHECKSIG 118 ] 119 120 p2pkh_script_decodes_as_expected :: H.Assertion 121 p2pkh_script_decodes_as_expected = p2pkh `decodes_to` p2pkh_terms 122 123 -- p2sh 124 p2sh :: BS.ByteString 125 p2sh = "5221038282263212c609d9ea2a6e3e172de238d8c39cabe56f3f9e451d2c4c7739ba8721031b84c5567b126440995d3ed5aaba0565d71e1834604819ff9c17f5e9d5dd078f2102b4632d08485ff1df2db55b9dafd23347d1c47a457072a1e87be26896549a873753ae" 126 127 p2sh_terms :: [Term] 128 p2sh_terms = [OPCODE OP_2,OPCODE OP_PUSHBYTES_33,BYTE 0x03,BYTE 0x82,BYTE 0x82,BYTE 0x26,BYTE 0x32,BYTE 0x12,BYTE 0xc6,BYTE 0x09,BYTE 0xd9,BYTE 0xea,BYTE 0x2a,BYTE 0x6e,BYTE 0x3e,BYTE 0x17,BYTE 0x2d,BYTE 0xe2,BYTE 0x38,BYTE 0xd8,BYTE 0xc3,BYTE 0x9c,BYTE 0xab,BYTE 0xe5,BYTE 0x6f,BYTE 0x3f,BYTE 0x9e,BYTE 0x45,BYTE 0x1d,BYTE 0x2c,BYTE 0x4c,BYTE 0x77,BYTE 0x39,BYTE 0xba,BYTE 0x87,OPCODE OP_PUSHBYTES_33,BYTE 0x03,BYTE 0x1b,BYTE 0x84,BYTE 0xc5,BYTE 0x56,BYTE 0x7b,BYTE 0x12,BYTE 0x64,BYTE 0x40,BYTE 0x99,BYTE 0x5d,BYTE 0x3e,BYTE 0xd5,BYTE 0xaa,BYTE 0xba,BYTE 0x05,BYTE 0x65,BYTE 0xd7,BYTE 0x1e,BYTE 0x18,BYTE 0x34,BYTE 0x60,BYTE 0x48,BYTE 0x19,BYTE 0xff,BYTE 0x9c,BYTE 0x17,BYTE 0xf5,BYTE 0xe9,BYTE 0xd5,BYTE 0xdd,BYTE 0x07,BYTE 0x8f,OPCODE OP_PUSHBYTES_33,BYTE 0x02,BYTE 0xb4,BYTE 0x63,BYTE 0x2d,BYTE 0x08,BYTE 0x48,BYTE 0x5f,BYTE 0xf1,BYTE 0xdf,BYTE 0x2d,BYTE 0xb5,BYTE 0x5b,BYTE 0x9d,BYTE 0xaf,BYTE 0xd2,BYTE 0x33,BYTE 0x47,BYTE 0xd1,BYTE 0xc4,BYTE 0x7a,BYTE 0x45,BYTE 0x70,BYTE 0x72,BYTE 0xa1,BYTE 0xe8,BYTE 0x7b,BYTE 0xe2,BYTE 0x68,BYTE 0x96,BYTE 0x54,BYTE 0x9a,BYTE 0x87,BYTE 0x37,OPCODE OP_3,OPCODE OP_CHECKMULTISIG] 129 130 p2sh_script_decodes_as_expected :: H.Assertion 131 p2sh_script_decodes_as_expected = p2sh `decodes_to` p2sh_terms 132 133 -- p2wpkh 134 p2wpkh :: BS.ByteString 135 p2wpkh = "0014b472a266d0bd89c13706a4132ccfb16f7c3b9fcb" 136 137 p2wpkh_terms :: [Term] 138 p2wpkh_terms = [OPCODE OP_PUSHBYTES_0,OPCODE OP_PUSHBYTES_20,BYTE 0xb4,BYTE 0x72,BYTE 0xa2,BYTE 0x66,BYTE 0xd0,BYTE 0xbd,BYTE 0x89,BYTE 0xc1,BYTE 0x37,BYTE 0x06,BYTE 0xa4,BYTE 0x13,BYTE 0x2c,BYTE 0xcf,BYTE 0xb1,BYTE 0x6f,BYTE 0x7c,BYTE 0x3b,BYTE 0x9f,BYTE 0xcb] 139 140 p2wpkh_script_decodes_as_expected :: H.Assertion 141 p2wpkh_script_decodes_as_expected = p2wpkh `decodes_to` p2wpkh_terms 142 143 -- p2sh-p2wpkh 144 145 p2sh_p2wpkh :: BS.ByteString 146 p2sh_p2wpkh = "a9149c1185a5c5e9fc54612808977ee8f548b2258d3187" 147 148 p2sh_p2wpkh_terms :: [Term] 149 p2sh_p2wpkh_terms = [OPCODE OP_HASH160,OPCODE OP_PUSHBYTES_20,BYTE 0x9c,BYTE 0x11,BYTE 0x85,BYTE 0xa5,BYTE 0xc5,BYTE 0xe9,BYTE 0xfc,BYTE 0x54,BYTE 0x61,BYTE 0x28,BYTE 0x08,BYTE 0x97,BYTE 0x7e,BYTE 0xe8,BYTE 0xf5,BYTE 0x48,BYTE 0xb2,BYTE 0x25,BYTE 0x8d,BYTE 0x31,OPCODE OP_EQUAL] 150 151 p2sh_p2wpkh_script_decodes_as_expected :: H.Assertion 152 p2sh_p2wpkh_script_decodes_as_expected = 153 p2sh_p2wpkh `decodes_to` p2sh_p2wpkh_terms 154 155 -- p2wsh 156 p2wsh :: BS.ByteString 157 p2wsh = "0020e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855" 158 159 p2wsh_terms :: [Term] 160 p2wsh_terms = [OPCODE OP_PUSHBYTES_0,OPCODE OP_PUSHBYTES_32,BYTE 0xe3,BYTE 0xb0,BYTE 0xc4,BYTE 0x42,BYTE 0x98,BYTE 0xfc,BYTE 0x1c,BYTE 0x14,BYTE 0x9a,BYTE 0xfb,BYTE 0xf4,BYTE 0xc8,BYTE 0x99,BYTE 0x6f,BYTE 0xb9,BYTE 0x24,BYTE 0x27,BYTE 0xae,BYTE 0x41,BYTE 0xe4,BYTE 0x64,BYTE 0x9b,BYTE 0x93,BYTE 0x4c,BYTE 0xa4,BYTE 0x95,BYTE 0x99,BYTE 0x1b,BYTE 0x78,BYTE 0x52,BYTE 0xb8,BYTE 0x55] 161 162 p2wsh_script_decodes_as_expected :: H.Assertion 163 p2wsh_script_decodes_as_expected = p2wsh `decodes_to` p2wsh_terms 164 165 -- p2sh-p2wsh 166 167 -- identical to p2sh-p2wpkh at the script level 168 169 p2sh_p2wsh :: BS.ByteString 170 p2sh_p2wsh = "a9149c1185a5c5e9fc54612808977ee8f548b2258d3187" 171 172 p2sh_p2wsh_terms :: [Term] 173 p2sh_p2wsh_terms = [OPCODE OP_HASH160,OPCODE OP_PUSHBYTES_20,BYTE 0x9c,BYTE 0x11,BYTE 0x85,BYTE 0xa5,BYTE 0xc5,BYTE 0xe9,BYTE 0xfc,BYTE 0x54,BYTE 0x61,BYTE 0x28,BYTE 0x08,BYTE 0x97,BYTE 0x7e,BYTE 0xe8,BYTE 0xf5,BYTE 0x48,BYTE 0xb2,BYTE 0x25,BYTE 0x8d,BYTE 0x31,OPCODE OP_EQUAL] 174 175 p2sh_p2wsh_script_decodes_as_expected :: H.Assertion 176 p2sh_p2wsh_script_decodes_as_expected = 177 p2sh_p2wsh `decodes_to` p2sh_p2wsh_terms 178 179 -- main ----------------------------------------------------------------------- 180 181 main :: IO () 182 main = defaultMain $ 183 testGroup "ppad-script" [ 184 testGroup "property tests" [ 185 testGroup "inverses" [ 186 Q.testProperty "ba_to_bs . bs_to_ba ~ id" $ 187 Q.withMaxSuccess 100 ba_to_bs_inverts_bs_to_ba 188 , Q.testProperty "ba_to_bs . bs_to_ba ~ id" $ 189 Q.withMaxSuccess 100 bs_to_ba_inverts_ba_to_bs 190 , Q.testProperty "from_base16 . to_base16 ~ id" $ 191 Q.withMaxSuccess 100 from_base16_inverts_to_base16 192 , Q.testProperty "to_base16 . from_base16 ~ id" $ 193 Q.withMaxSuccess 100 to_base16_inverts_from_base16 194 , Q.testProperty "to_script . from_script ~ id" $ 195 Q.withMaxSuccess 1000 to_script_inverts_from_script 196 ] 197 ] 198 , testGroup "unit tests" [ 199 H.testCase "p2pkh script decodes to expected terms" 200 p2pkh_script_decodes_as_expected 201 , H.testCase "p2sh script decodes to expected terms" 202 p2sh_script_decodes_as_expected 203 , H.testCase "p2wpkh script decodes to expected terms" 204 p2wpkh_script_decodes_as_expected 205 , H.testCase "p2sh-p2wpkh script decodes to expected terms" 206 p2sh_p2wpkh_script_decodes_as_expected 207 , H.testCase "p2wsh script decodes to expected terms" 208 p2wsh_script_decodes_as_expected 209 , H.testCase "p2sh-p2wsh script decodes to expected terms" 210 p2sh_p2wsh_script_decodes_as_expected 211 ] 212 ] 213