Main.hs (42221B)
1 {-# LANGUAGE OverloadedStrings #-} 2 3 module Main where 4 5 import qualified Bitcoin.Prim.Tx as BT 6 import qualified Bitcoin.Prim.Tx.Sighash as Sighash 7 import Control.Monad (foldM, forM_) 8 import qualified Crypto.Curve.Secp256k1 as S 9 import qualified Crypto.Hash.SHA256 as SHA256 10 import Data.Bits (xor) 11 import qualified Data.ByteString as BS 12 import qualified Data.ByteString.Base16 as B16 13 import qualified Data.List.NonEmpty as NE 14 import Data.Maybe (isJust, isNothing) 15 import Data.Word (Word8, Word64) 16 import qualified Lightning.Protocol.BOLT1 as BOLT1 17 import Lightning.Protocol.BOLT3 18 import Test.Tasty 19 import Test.Tasty.HUnit 20 import Test.Tasty.QuickCheck 21 import Vectors 22 23 -- Shared wNAF context. 24 tex :: S.Context 25 tex = S.precompute 26 {-# NOINLINE tex #-} 27 28 main :: IO () 29 main = defaultMain $ testGroup "ppad-bolt3" [ 30 keyTests 31 , secretGenerationTests 32 , secretStorageTests 33 , fundingTests 34 , testGroup "Commitment and HTLC transactions (Appendix C)" $ 35 fmap (commitVectorTests StaticRemotekey) appendix_c 36 , testGroup "Commitment and HTLC transactions (Appendix F)" $ 37 fmap (commitVectorTests Anchors) appendix_f 38 , commitmentTests 39 , htlcTxTests 40 , closingTests 41 , scriptTests 42 , feeTests 43 , constructorTests 44 , propertyTests 45 ] 46 47 -- helpers -------------------------------------------------------------------- 48 49 -- | Decode a hex literal, failing the enclosing test on bad input. 50 hex :: BS.ByteString -> IO BS.ByteString 51 hex h = case B16.decode h of 52 Just bs -> pure bs 53 Nothing -> assertFailure ("invalid hex literal: " ++ show h) 54 55 -- | Unwrap a Just, failing the enclosing test on Nothing. 56 need :: String -> Maybe a -> IO a 57 need msg = maybe (assertFailure msg) pure 58 59 pt :: BS.ByteString -> IO BOLT1.Point 60 pt h = hex h >>= need ("invalid point " ++ show h) . BOLT1.point 61 62 sat :: Word64 -> IO BOLT1.Satoshi 63 sat = need "invalid satoshi amount" . BOLT1.satoshi 64 65 msat :: Word64 -> IO BOLT1.MilliSatoshi 66 msat = need "invalid millisatoshi amount" . BOLT1.milli_satoshi 67 68 sk :: BS.ByteString -> IO Seckey 69 sk h = hex h >>= need ("invalid secret key " ++ show h) . seckey 70 71 pcsecret :: BS.ByteString -> IO BOLT1.PerCommitmentSecret 72 pcsecret h = hex h >>= need "invalid secret" . BOLT1.per_commitment_secret 73 74 idx :: Word64 -> IO SecretIndex 75 idx = need "invalid secret index" . secret_index 76 77 unpoint :: BOLT1.Point -> BS.ByteString 78 unpoint = BOLT1.un_point 79 80 unsecret :: BOLT1.PerCommitmentSecret -> BS.ByteString 81 unsecret = BOLT1.un_per_commitment_secret 82 83 -- | The compressed public key of a secret key. 84 pubkey_of :: Seckey -> Maybe BS.ByteString 85 pubkey_of k = do 86 w <- S.parse_int256 (un_seckey k) 87 S.serialize_point <$> S.derive_pub w 88 89 -- Appendix E, and the internal values of Appendix C -------------------------- 90 91 e_base_secret, e_per_commitment_secret, e_base_point, 92 e_per_commitment_point :: BS.ByteString 93 e_base_secret = 94 "000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f" 95 e_per_commitment_secret = 96 "1f1e1d1c1b1a191817161514131211100f0e0d0c0b0a09080706050403020100" 97 e_base_point = 98 "036d6caac248af96f6afa7f904f550253a0f3ef3f5aa2fe6838a95b216691468e2" 99 e_per_commitment_point = 100 "025f7117a78150fe2ef97db7cfc83bd57b2e2c0d0dd25eaf467a4a1c2a45ce1486" 101 102 -- | Appendix C's (commented) derivation inputs. 103 c_local_delayed_payment_basepoint_secret, c_local_delayed_payment_basepoint, 104 c_remote_revocation_basepoint, c_local_per_commitment_point, 105 c_local_delayed_privkey :: BS.ByteString 106 c_local_delayed_payment_basepoint_secret = 107 "3333333333333333333333333333333333333333333333333333333333333333" 108 c_local_delayed_payment_basepoint = 109 "023c72addb4fdf09af94f0c94d7fe92a386a7e70cf8a1d85916386bb2535c7b1b1" 110 c_remote_revocation_basepoint = 111 "02466d7fcae563e5cb09a0d1870bb580344804617879a14949cf22285f1bae3f27" 112 c_local_per_commitment_point = 113 "025f7117a78150fe2ef97db7cfc83bd57b2e2c0d0dd25eaf467a4a1c2a45ce1486" 114 c_local_delayed_privkey = 115 "adf3464ce9c2f230fd2582fda4c6965e4993ca5524e8c9580e3df0cf226981ad" 116 117 keyTests :: TestTree 118 keyTests = testGroup "Key derivation (Appendix E)" [ 119 testCase "per_commitment_point from per_commitment_secret" $ do 120 s <- pcsecret e_per_commitment_secret 121 expected <- hex e_per_commitment_point 122 PerCommitmentPoint p <- need "derive_per_commitment_point" 123 (derive_per_commitment_point s) 124 unpoint p @?= expected 125 PerCommitmentPoint p' <- need "derive_per_commitment_point'" 126 (derive_per_commitment_point' tex s) 127 unpoint p' @?= expected 128 129 , testCase "localpubkey from basepoint and per_commitment_point" $ do 130 bp <- pt e_base_point 131 pcp <- PerCommitmentPoint <$> pt e_per_commitment_point 132 expected <- hex 133 "0235f2dbfaa89b57ec7b055afe29849ef7ddfeb1cefdb9ebdc43f5494984db29e5" 134 fmap unpoint (derive_pubkey bp pcp) @?= Just expected 135 136 , testCase "localprivkey from basepoint secret" $ do 137 bs <- sk e_base_secret 138 pcp <- PerCommitmentPoint <$> pt e_per_commitment_point 139 expected <- hex 140 "cbced912d3b21bf196a766651e436aff192362621ce317704ea2f75d87e7be0f" 141 fmap un_seckey (derive_privkey bs pcp) @?= Just expected 142 143 , testCase "revocationpubkey from basepoint and per_commitment_point" $ do 144 rbp <- RevocationBasepoint <$> pt e_base_point 145 pcp <- PerCommitmentPoint <$> pt e_per_commitment_point 146 expected <- hex 147 "02916e326636d19c33f13e8c0c3a03dd157f332f3e99c317c141dd865eb01f8ff0" 148 fmap (\(RevocationPubkey p) -> unpoint p) 149 (derive_revocationpubkey rbp pcp) @?= Just expected 150 151 , testCase "revocationprivkey from secrets" $ do 152 rbs <- sk e_base_secret 153 pcs <- pcsecret e_per_commitment_secret 154 expected <- hex 155 "d09ffff62ddb2297ab000cc85bcb4283fdeb6aa052affbc9dddcf33b61078110" 156 fmap un_seckey (derive_revocationprivkey rbs pcs) @?= Just expected 157 158 , testCase "Appendix C local_delayed_privkey" $ do 159 bs <- sk c_local_delayed_payment_basepoint_secret 160 pcp <- PerCommitmentPoint <$> pt c_local_per_commitment_point 161 expected <- hex c_local_delayed_privkey 162 fmap un_seckey (derive_privkey bs pcp) @?= Just expected 163 -- whose public key is Appendix C's local_delayedpubkey 164 expected_pub <- hex c_local_delayedpubkey 165 (pubkey_of =<< derive_privkey bs pcp) @?= Just expected_pub 166 167 , testCase "Appendix C commitment keys from basepoints" $ do 168 keys <- vectorKeys 169 pcp <- PerCommitmentPoint <$> pt c_local_per_commitment_point 170 local_bp <- pt c_local_payment_basepoint 171 remote_bp <- pt c_remote_payment_basepoint 172 local_delayed_bp <- pt c_local_delayed_payment_basepoint 173 remote_rev_bp <- pt c_remote_revocation_basepoint 174 let local = Basepoints 175 { bp_revocation = RevocationBasepoint local_bp 176 , bp_payment = PaymentBasepoint local_bp 177 , bp_delayed_payment = 178 DelayedPaymentBasepoint local_delayed_bp 179 , bp_htlc = HtlcBasepoint local_bp 180 } 181 remote = Basepoints 182 { bp_revocation = RevocationBasepoint remote_rev_bp 183 , bp_payment = PaymentBasepoint remote_bp 184 , bp_delayed_payment = DelayedPaymentBasepoint remote_bp 185 , bp_htlc = HtlcBasepoint remote_bp 186 } 187 derived = derive_commitment_keys local (ck_local_funding keys) 188 remote (ck_remote_funding keys) pcp 189 derived @?= Just keys 190 derive_commitment_keys' tex local (ck_local_funding keys) 191 remote (ck_remote_funding keys) pcp @?= Just keys 192 193 , testCase "rejects a basepoint off the curve" $ do 194 bad <- pt 195 "020000000000000000000000000000000000000000000000000000000000000000" 196 pcp <- PerCommitmentPoint <$> pt e_per_commitment_point 197 isNothing (derive_pubkey bad pcp) @?= True 198 isNothing (derive_revocationpubkey (RevocationBasepoint bad) pcp) 199 @?= True 200 201 , testCase "rejects a per_commitment_point off the curve" $ do 202 rbp <- RevocationBasepoint <$> pt e_base_point 203 bad <- PerCommitmentPoint <$> pt 204 "020000000000000000000000000000000000000000000000000000000000000000" 205 isNothing (derive_revocationpubkey rbp bad) @?= True 206 207 , testCase "rejects an invalid per_commitment_secret" $ do 208 zero <- pcsecret 209 "0000000000000000000000000000000000000000000000000000000000000000" 210 big <- pcsecret 211 "ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff" 212 rbs <- sk e_base_secret 213 isNothing (derive_per_commitment_point zero) @?= True 214 isNothing (derive_per_commitment_point big) @?= True 215 isNothing (derive_per_commitment_point' tex big) @?= True 216 isNothing (derive_revocationprivkey rbs zero) @?= True 217 isNothing (derive_revocationprivkey rbs big) @?= True 218 ] 219 220 -- Appendix D: generation ----------------------------------------------------- 221 222 secretGenerationTests :: TestTree 223 secretGenerationTests = testGroup "Secret generation (Appendix D)" [ 224 gen "generate_from_seed 0 final node" 225 "0000000000000000000000000000000000000000000000000000000000000000" 226 281474976710655 227 "02a40c85b6f28da08dfdbe0926c53fab2de6d28c10301f8f7c4073d5e42e3148" 228 , gen "generate_from_seed FF final node" 229 "ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff" 230 281474976710655 231 "7cc854b54e3e0dcdb010d7a3fee464a9687be6e8db3be6854c475621e007a5dc" 232 , gen "generate_from_seed FF alternate bits 1" 233 "ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff" 234 0xaaaaaaaaaaa 235 "56f4008fb007ca9acf0e15b054d5c9fd12ee06cea347914ddbaed70d1c13a528" 236 , gen "generate_from_seed FF alternate bits 2" 237 "ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff" 238 0x555555555555 239 "9015daaeb06dba4ccc05b91b2f73bd54405f2be9f217fbacd3c5ac2e62327d31" 240 , gen "generate_from_seed 01 last nontrivial node" 241 "0101010101010101010101010101010101010101010101010101010101010101" 242 1 243 "915c75942a26bb3a433a8ce2cb0427c29ec6c1775cfc78328b57f6ba7bfeaa9c" 244 , testCase "commitment_secret_index" $ do 245 cn <- need "commitment_number" (commitment_number 42) 246 un_secret_index (commitment_secret_index cn) @?= 0xFFFFFFFFFFFF - 42 247 ] 248 where 249 gen name s i expected = testCase name $ do 250 sd <- hex s >>= need "seed" . seed 251 ix <- idx i 252 e <- hex expected 253 unsecret (generate_from_seed sd ix) @?= e 254 255 -- Appendix D: storage -------------------------------------------------------- 256 257 secretStorageTests :: TestTree 258 secretStorageTests = testGroup "Secret storage (Appendix D)" $ 259 fmap storageVectorTest appendix_d_storage 260 ++ [ 261 testCase "derive_old_secret after each correct insert" $ do 262 known <- correctSequence 263 let step (store, seen) (i, s) = do 264 store' <- need ("rejected correct secret at I=" ++ show i) 265 (insert_secret s i store) 266 let seen' = (i, s) : seen 267 forM_ seen' $ \(j, t) -> 268 assertEqual 269 ("after I=" ++ show i ++ ", derive_old_secret " ++ show j) 270 (Just (unsecret t)) 271 (fmap unsecret (derive_old_secret j store')) 272 pure (store', seen') 273 (store, _) <- foldM step (empty_secret_store, []) known 274 -- the next index has not been received 275 next <- idx 281474976710647 276 isNothing (derive_old_secret next store) @?= True 277 278 , testCase "un_secret_store/secret_store round trip" $ do 279 known <- correctSequence 280 store <- need "insert" (foldM (\st (i, s) -> insert_secret s i st) 281 empty_secret_store known) 282 store' <- need "secret_store" (secret_store (un_secret_store store)) 283 forM_ known $ \(i, s) -> 284 fmap unsecret (derive_old_secret i store') @?= Just (unsecret s) 285 -- entry order doesn't matter 286 store'' <- need "secret_store (reversed)" 287 (secret_store (reverse (un_secret_store store))) 288 forM_ known $ \(i, s) -> 289 fmap unsecret (derive_old_secret i store'') @?= Just (unsecret s) 290 291 , testCase "secret_store rejects a repeated bucket" $ do 292 known <- correctSequence 293 case known of 294 ((i0, s0) : _ : (i2, s2) : _) -> 295 -- indices 2^48-1 and 2^48-3 both have no trailing zeros 296 isNothing (secret_store [(i0, s0), (i2, s2)]) @?= True 297 _ -> assertFailure "short sequence" 298 299 , testCase "secret_store rejects contradictory entries" $ do 300 known <- correctSequence 301 bad <- pcsecret 302 "0000000000000000000000000000000000000000000000000000000000000000" 303 case known of 304 ((i0, _) : (i1, s1) : _) -> 305 -- index 2^48-1 is derivable from index 2^48-2 306 isNothing (secret_store [(i0, bad), (i1, s1)]) @?= True 307 _ -> assertFailure "short sequence" 308 309 , testCase "Show is redacted" $ do 310 known <- correctSequence 311 store <- need "insert" (foldM (\st (i, s) -> insert_secret s i st) 312 empty_secret_store known) 313 show store @?= "SecretStore <redacted>" 314 sd <- need "seed" (seed (BS.replicate 32 0xff)) 315 show sd @?= "Seed <redacted>" 316 k <- sk e_base_secret 317 show k @?= "Seckey <redacted>" 318 ] 319 320 -- | The spec's correct storage sequence, as (index, secret) pairs. 321 correctSequence :: IO [(SecretIndex, BOLT1.PerCommitmentSecret)] 322 correctSequence = do 323 steps <- case filter isCorrect appendix_d_storage of 324 (v : _) -> pure (sv_steps v) 325 [] -> assertFailure "missing correct sequence vector" 326 traverse (\st -> (,) <$> idx (ss_index st) <*> pcsecret (ss_secret st)) 327 steps 328 where 329 isCorrect v = sv_name v == "insert_secret correct sequence" 330 331 -- | Run a storage vector, asserting that each insert_secret call is 332 -- accepted or rejected exactly as the spec says. 333 storageVectorTest :: StorageVector -> TestTree 334 storageVectorTest (StorageVector name steps) = 335 testCase name (go empty_secret_store steps) 336 where 337 go _ [] = pure () 338 go store (StorageStep i ok s : rest) = do 339 sec <- pcsecret s 340 ix <- idx i 341 case (insert_secret sec ix store, ok) of 342 (Just store', True) -> go store' rest 343 (Nothing, False) -> go store rest 344 (Just _, False) -> 345 assertFailure ("accepted incorrect secret at I=" ++ show i) 346 (Nothing, True) -> 347 assertFailure ("rejected correct secret at I=" ++ show i) 348 349 -- Appendix B ----------------------------------------------------------------- 350 351 fundingTests :: TestTree 352 fundingTests = testGroup "Funding transaction (Appendix B)" [ 353 testCase "funding witness script" $ do 354 (lpk, rpk) <- fundingPubkeys 355 wscript <- hex b_funding_wscript 356 funding_script lpk rpk @?= Script wscript 357 funding_script rpk lpk @?= Script wscript 358 359 , testCase "funding output" $ do 360 (lpk, rpk) <- fundingPubkeys 361 tx <- hex b_funding_tx >>= decodeTx 362 txid <- hex b_funding_txid 363 BT.un_txid (BT.txid tx) @?= BS.reverse txid 364 case drop (fromIntegral b_funding_output) (NE.toList (BT.tx_outputs tx)) 365 of 366 (BT.TxOut value spk : _) -> do 367 value @?= b_funding_satoshis 368 Script spk @?= to_p2wsh (funding_script lpk rpk) 369 [] -> assertFailure "missing funding output" 370 ] 371 where 372 fundingPubkeys = do 373 lpk <- FundingPubkey <$> pt b_local_funding_pubkey 374 rpk <- FundingPubkey <$> pt b_remote_funding_pubkey 375 pure (lpk, rpk) 376 377 -- Appendices C and F --------------------------------------------------------- 378 379 -- | Decode a serialized transaction, failing the test on bad input. 380 decodeTx :: BS.ByteString -> IO BT.Tx 381 decodeTx = need "undecodable transaction" . BT.from_bytes 382 383 -- | The single input's witness stack of a spec transaction. 384 witnessOf :: BT.Tx -> IO [BS.ByteString] 385 witnessOf tx = case NE.toList (BT.tx_inputs tx) of 386 [i] | BT.Witness items <- BT.txin_witness i -> pure items 387 _ -> assertFailure "expected one input" 388 389 -- | A test HTLC from the Appendix C parameters. 390 testHtlc :: Int -> IO HTLC 391 testHtlc i = case drop i c_htlcs of 392 (TestHtlc offered amt expiry pre : _) -> do 393 preimage <- hex pre 394 amount <- msat amt 395 ph <- need "payment hash" (BOLT1.payment_hash (SHA256.hash preimage)) 396 pure HTLC 397 { htlc_direction = if offered then HTLCOffered else HTLCReceived 398 , htlc_amount_msat = amount 399 , htlc_payment_hash = ph 400 , htlc_cltv_expiry = CltvExpiry expiry 401 } 402 [] -> assertFailure ("no test HTLC #" ++ show i) 403 404 testPreimage :: Int -> IO BOLT1.PaymentPreimage 405 testPreimage i = case drop i c_htlcs of 406 (TestHtlc _ _ _ pre : _) -> 407 hex pre >>= need "preimage" . BOLT1.payment_preimage 408 [] -> assertFailure ("no test HTLC #" ++ show i) 409 410 -- | Commitment keys from the Appendix C parameters, which Appendix F 411 -- shares. The vectors use the payment basepoints as HTLC 412 -- basepoints; to_remote pays the remote payment basepoint. 413 vectorKeys :: IO CommitmentKeys 414 vectorKeys = do 415 revocation <- pt c_local_revocation_pubkey 416 delayed <- pt c_local_delayedpubkey 417 local_htlc <- pt c_local_htlcpubkey 418 remote_htlc <- pt c_remote_htlcpubkey 419 remote_payment <- pt c_remote_payment_basepoint 420 local_funding <- pt c_local_funding_pubkey 421 remote_funding <- pt c_remote_funding_pubkey 422 pure CommitmentKeys 423 { ck_revocation_pubkey = RevocationPubkey revocation 424 , ck_local_delayed = LocalDelayedPubkey delayed 425 , ck_local_htlc = LocalHtlcPubkey local_htlc 426 , ck_remote_htlc = RemoteHtlcPubkey remote_htlc 427 , ck_remote_payment = RemotePubkey remote_payment 428 , ck_local_funding = FundingPubkey local_funding 429 , ck_remote_funding = FundingPubkey remote_funding 430 } 431 432 vectorOutpoint :: IO BT.OutPoint 433 vectorOutpoint = do 434 txid <- hex c_funding_txid 435 t <- need "invalid txid" (BT.mk_txid (BS.reverse txid)) 436 pure (BT.OutPoint t c_funding_output_index) 437 438 -- | The commitment context for a vector: local's commitment, with local 439 -- as the opener. 440 vectorContext :: CommitmentFormat -> CommitVector -> IO CommitmentContext 441 vectorContext fmt v = do 442 keys <- vectorKeys 443 outpoint <- vectorOutpoint 444 local_bp <- PaymentBasepoint <$> pt c_local_payment_basepoint 445 remote_bp <- PaymentBasepoint <$> pt c_remote_payment_basepoint 446 cn <- need "commitment number" (commitment_number c_commitment_number) 447 htlcs <- traverse testHtlc (cv_htlcs v) 448 dust <- DustLimit <$> sat (cv_dust_limit_sat v) 449 to_local <- msat (cv_to_local_msat v) 450 to_remote <- msat (cv_to_remote_msat v) 451 pure CommitmentContext 452 { cc_funding_outpoint = outpoint 453 , cc_commitment_number = cn 454 , cc_local_payment_bp = local_bp 455 , cc_remote_payment_bp = remote_bp 456 , cc_to_self_delay = ToSelfDelay c_local_delay 457 , cc_dust_limit = dust 458 , cc_feerate = FeeratePerKw (cv_feerate_per_kw v) 459 , cc_format = fmt 460 , cc_is_funder = True 461 , cc_to_local_msat = to_local 462 , cc_to_remote_msat = to_remote 463 , cc_htlcs = htlcs 464 , cc_keys = keys 465 } 466 467 -- | Assert that the commitment tx and each HTLC tx of a vector match 468 -- the spec's, with witnesses stripped, and that the spec's witnesses 469 -- are those the witness functions build. 470 commitVectorTests :: CommitmentFormat -> CommitVector -> TestTree 471 commitVectorTests fmt v = testGroup (cv_name v) $ 472 testCase "commitment tx" (do 473 ctx <- vectorContext fmt v 474 spec <- hex (cv_commit_tx v) >>= decodeTx 475 commit <- need "no commitment tx" (build_commitment_tx ctx) 476 encode_commitment_tx commit @?= BT.to_bytes_legacy spec 477 -- the funding witness, with its signatures in either order 478 w <- witnessOf spec 479 case w of 480 [_, s1, s2, _] -> do 481 let keys = cc_keys ctx 482 lpk = ck_local_funding keys 483 rpk = ck_remote_funding keys 484 funding_witness lpk s1 rpk s2 @?= BT.Witness w 485 funding_witness rpk s2 lpk s1 @?= BT.Witness w 486 _ -> assertFailure "unexpected funding witness") 487 : fmap htlcTxTest (cv_htlc_txs v) 488 where 489 htlcTxTest (HtlcTxVector kind i out raw) = 490 testCase (kindName kind ++ " for htlc #" ++ show i 491 ++ " (output " ++ show out ++ ")") $ do 492 ctx <- vectorContext fmt v 493 commit <- need "no commitment tx" (build_commitment_tx ctx) 494 expected_htlc <- testHtlc i 495 -- the output names its HTLC 496 htlc <- case drop (fromIntegral out) (NE.toList (ctx_outputs commit)) 497 of 498 (CommitmentOutput _ _ (OutputHTLC h) : _) -> pure h 499 _ -> assertFailure "not an HTLC output" 500 htlc @?= expected_htlc 501 let keys = cc_keys ctx 502 hctx = HTLCContext 503 { hc_commitment_txid = BT.txid (commitment_to_tx commit) 504 , hc_output_index = out 505 , hc_htlc = htlc 506 , hc_to_self_delay = cc_to_self_delay ctx 507 , hc_feerate = cc_feerate ctx 508 , hc_format = fmt 509 , hc_revocation_pubkey = ck_revocation_pubkey keys 510 , hc_local_delayed = ck_local_delayed keys 511 } 512 spec <- hex raw >>= decodeTx 513 htx <- need "no htlc tx" (build_htlc_tx hctx) 514 encode_htlc_tx htx @?= BT.to_bytes_legacy spec 515 -- the input witness 516 w <- witnessOf spec 517 let rev = ck_revocation_pubkey keys 518 rh = ck_remote_htlc keys 519 lh = ck_local_htlc keys 520 ph = htlc_payment_hash htlc 521 case (kind, w) of 522 (HtlcSuccess, [_, rsig, lsig, _, _]) -> do 523 pre <- testPreimage i 524 let ws = received_htlc_script rev rh lh ph 525 (htlc_cltv_expiry htlc) fmt 526 htlc_success_witness rsig lsig pre ws @?= BT.Witness w 527 sighashes rsig lsig 528 (HtlcTimeout, [_, rsig, lsig, _, _]) -> do 529 let ws = offered_htlc_script rev rh lh ph fmt 530 htlc_timeout_witness rsig lsig ws @?= BT.Witness w 531 sighashes rsig lsig 532 _ -> assertFailure "unexpected htlc witness" 533 534 -- the remote signature uses remote_htlc_sighash, the local one 535 -- SIGHASH_ALL 536 sighashes rsig lsig = do 537 let flag = fromIntegral . Sighash.encode_sighash 538 fmap snd (BS.unsnoc rsig) @?= Just (flag (remote_htlc_sighash fmt)) 539 fmap snd (BS.unsnoc lsig) @?= Just (flag Sighash.SIGHASH_ALL) 540 541 kindName HtlcSuccess = "htlc-success tx" 542 kindName HtlcTimeout = "htlc-timeout tx" 543 544 -- commitment transactions ---------------------------------------------------- 545 546 simpleVector :: IO CommitVector 547 simpleVector = case appendix_c of 548 (v : _) -> pure v 549 [] -> assertFailure "missing Appendix C vectors" 550 551 commitmentTests :: TestTree 552 commitmentTests = testGroup "Commitment transactions" [ 553 testCase "obscured_commitment_number (Appendix C)" $ do 554 o <- PaymentBasepoint <$> pt c_local_payment_basepoint 555 a <- PaymentBasepoint <$> pt c_remote_payment_basepoint 556 cn <- need "commitment_number" (commitment_number 42) 557 obscured_commitment_number o a cn @?= 0x2bb038521914 `xor` 42 558 559 , testCase "obscured commitment number from the accepter's side" $ do 560 v <- simpleVector 561 opener_ctx <- vectorContext StaticRemotekey v 562 spec <- hex (cv_commit_tx v) >>= decodeTx 563 -- the accepter's (remote's) commitment, with the owner-relative 564 -- payment basepoints swapped and the owner not the funder 565 let accepter_ctx = opener_ctx 566 { cc_local_payment_bp = cc_remote_payment_bp opener_ctx 567 , cc_remote_payment_bp = cc_local_payment_bp opener_ctx 568 , cc_is_funder = False 569 } 570 commit <- need "no commitment tx" (build_commitment_tx accepter_ctx) 571 let Locktime lt = ctx_locktime commit 572 Sequence sq = ctx_input_sequence commit 573 lt @?= BT.tx_locktime spec 574 [sq] @?= fmap BT.txin_sequence (NE.toList (BT.tx_inputs spec)) 575 -- the obscured number is 0x2bb038521914 ^ 42 576 let obscured = 0x2bb038521914 `xor` 42 :: Word64 577 lt @?= 0x20000000 + fromIntegral (obscured `mod` 0x1000000) 578 sq @?= 0x80000000 + fromIntegral (obscured `div` 0x1000000) 579 580 , testCase "fee taken from the remote output when it funds" $ do 581 v <- simpleVector 582 ctx <- vectorContext StaticRemotekey v 583 commit <- need "no commitment tx" (build_commitment_tx ctx 584 { cc_is_funder = False }) 585 -- the 10860 sat base fee comes from to_remote's 3000000 sat 586 let values = [ (co_type o, BOLT1.un_satoshi (co_value o)) 587 | o <- NE.toList (ctx_outputs commit) ] 588 values @?= [(OutputToRemote, 2989140), (OutputToLocal, 7000000)] 589 590 , testCase "no outputs" $ do 591 v <- simpleVector 592 ctx <- vectorContext Anchors v 593 zero <- msat 0 594 isNothing (build_commitment_tx ctx 595 { cc_to_local_msat = zero, cc_to_remote_msat = zero }) 596 @?= True 597 598 , testCase "anchors: only the anchor of a materialized output" $ do 599 v <- simpleVector 600 ctx <- vectorContext Anchors v 601 zero <- msat 0 602 commit <- need "no commitment tx" (build_commitment_tx ctx 603 { cc_to_remote_msat = zero }) 604 fmap co_type (NE.toList (ctx_outputs commit)) 605 @?= [OutputLocalAnchor, OutputToLocal] 606 ] 607 608 -- HTLC transactions ---------------------------------------------------------- 609 610 htlcTxTests :: TestTree 611 htlcTxTests = testGroup "HTLC transactions" [ 612 testCase "fee exceeding the amount" $ do 613 keys <- vectorKeys 614 outpoint <- vectorOutpoint 615 h <- testHtlc 2 -- offered, 2000 sat 616 let ctx = HTLCContext 617 { hc_commitment_txid = BT.op_txid outpoint 618 , hc_output_index = 0 619 , hc_htlc = h 620 , hc_to_self_delay = ToSelfDelay 144 621 , hc_feerate = FeeratePerKw 5000 -- fee 3315 622 , hc_format = StaticRemotekey 623 , hc_revocation_pubkey = ck_revocation_pubkey keys 624 , hc_local_delayed = ck_local_delayed keys 625 } 626 isNothing (build_htlc_tx ctx) @?= True 627 -- zero-fee under anchors 628 htx <- need "anchors htlc tx" (build_htlc_tx ctx { hc_format = Anchors }) 629 BOLT1.un_satoshi (htx_output_value htx) @?= 2000 630 htx_input_sequence htx @?= Sequence 1 631 htx_locktime htx @?= Locktime 502 632 ] 633 634 -- closing transactions ------------------------------------------------------- 635 636 p2wpkh :: Word8 -> Script 637 p2wpkh b = Script (BS.pack [0x00, 0x14] <> BS.replicate 20 b) 638 639 closingValues :: ClosingTx -> [(Word64, Script)] 640 closingValues c = 641 [ (BOLT1.un_satoshi (clo_value o), clo_script o) 642 | o <- NE.toList (cltx_outputs c) ] 643 644 closingTests :: TestTree 645 closingTests = testGroup "Closing transactions" [ 646 testGroup "legacy" [ 647 testCase "fee from the funder, outputs in BIP69 order" $ do 648 ctx <- legacy 6000500 4000999 546 1000 True False 649 c <- need "no closing tx" (build_legacy_closing_tx ctx) 650 closingValues c @?= [(4000, remote_spk), (5000, local_spk)] 651 cltx_locktime c @?= Locktime 0 652 cltx_input_sequence c @?= Sequence 0xFFFFFFFF 653 cltx_version c @?= 2 654 655 , testCase "fee from the remote output when it funds" $ do 656 ctx <- legacy 6000000 4000000 546 1000 False False 657 c <- need "no closing tx" (build_legacy_closing_tx ctx) 658 closingValues c @?= [(3000, remote_spk), (6000, local_spk)] 659 660 , testCase "the signer's dust limit applies to both outputs" $ do 661 ctx <- legacy 100000000 600000 1000 500 True False 662 c <- need "no closing tx" (build_legacy_closing_tx ctx) 663 closingValues c @?= [(99500, local_spk)] 664 665 , testCase "the signer may omit its own output" $ do 666 ctx <- legacy 6000000 4000000 546 1000 True True 667 c <- need "no closing tx" (build_legacy_closing_tx ctx) 668 closingValues c @?= [(4000, remote_spk)] 669 670 , testCase "fee exceeding the funder's balance" $ do 671 ctx <- legacy 999999 4000000 546 1000 True False 672 isNothing (build_legacy_closing_tx ctx) @?= True 673 674 , testCase "no outputs" $ do 675 ctx <- legacy 500000 500000 546 0 True False 676 isNothing (build_legacy_closing_tx ctx) @?= True 677 ] 678 679 , testGroup "option_simple_close" [ 680 testCase "closer pays the fee, outputs in BIP69 order" $ do 681 ctx <- simple 10000999 5000000 500 CloserAndCloseeOutputs 682 c <- need "no closing tx" (build_closing_tx ctx) 683 closingValues c @?= [(5000, remote_spk), (9500, local_spk)] 684 cltx_locktime c @?= Locktime 800000 685 cltx_input_sequence c @?= Sequence 0xFFFFFFFD 686 cltx_version c @?= 2 687 688 , testCase "closer output only" $ do 689 ctx <- simple 10000000 5000000 500 CloserOutputOnly 690 c <- need "no closing tx" (build_closing_tx ctx) 691 closingValues c @?= [(9500, local_spk)] 692 693 , testCase "closee output only" $ do 694 ctx <- simple 10000000 5000000 500 CloseeOutputOnly 695 c <- need "no closing tx" (build_closing_tx ctx) 696 closingValues c @?= [(5000, remote_spk)] 697 698 , testCase "OP_RETURN outputs have amount zero and are kept" $ do 699 ctx <- simple 10000000 5000000 500 CloserAndCloseeOutputs 700 let op_return = Script (BS.pack [0x6a, 0x01, 0x00]) 701 c <- need "no closing tx" (build_closing_tx ctx 702 { clc_closer_script = op_return }) 703 closingValues c @?= [(0, op_return), (5000, remote_spk)] 704 c' <- need "no closing tx" (build_closing_tx ctx 705 { clc_closee_script = op_return }) 706 closingValues c' @?= [(0, op_return), (9500, local_spk)] 707 708 , testCase "dust outputs are not trimmed" $ do 709 ctx <- simple 10000000 100000 500 CloserAndCloseeOutputs 710 c <- need "no closing tx" (build_closing_tx ctx) 711 closingValues c @?= [(100, remote_spk), (9500, local_spk)] 712 713 , testCase "fee exceeding the closer's balance" $ do 714 ctx <- simple 499999 5000000 500 CloseeOutputOnly 715 isNothing (build_closing_tx ctx) @?= True 716 ] 717 ] 718 where 719 local_spk = p2wpkh 0x11 720 remote_spk = p2wpkh 0x22 721 722 legacy l r dust fee funder omit = do 723 outpoint <- vectorOutpoint 724 lm <- msat l 725 rm <- msat r 726 d <- DustLimit <$> sat dust 727 f <- sat fee 728 pure LegacyClosingContext 729 { lcc_funding_outpoint = outpoint 730 , lcc_local_msat = lm 731 , lcc_remote_msat = rm 732 , lcc_local_script = local_spk 733 , lcc_remote_script = remote_spk 734 , lcc_dust_limit = d 735 , lcc_fee = f 736 , lcc_is_funder = funder 737 , lcc_omit_local = omit 738 } 739 740 simple closer closee fee outs = do 741 outpoint <- vectorOutpoint 742 cm <- msat closer 743 em <- msat closee 744 f <- sat fee 745 pure ClosingContext 746 { clc_funding_outpoint = outpoint 747 , clc_closer_msat = cm 748 , clc_closee_msat = em 749 , clc_closer_script = local_spk 750 , clc_closee_script = remote_spk 751 , clc_fee = f 752 , clc_locktime = Locktime 800000 753 , clc_outputs = outs 754 } 755 756 -- scripts -------------------------------------------------------------------- 757 758 scriptTests :: TestTree 759 scriptTests = testGroup "Scripts and witnesses" [ 760 testCase "to_remote scriptPubKeys" $ do 761 pk <- RemotePubkey <$> pt c_remote_payment_basepoint 762 let Script ws = to_remote_witness_script pk 763 -- <remotepubkey> OP_CHECKSIGVERIFY 1 OP_CHECKSEQUENCEVERIFY 764 BS.length ws @?= 37 765 BS.drop 34 ws @?= BS.pack [0xad, 0x51, 0xb2] 766 to_remote_script_pubkey pk Anchors @?= to_p2wsh (Script ws) 767 -- P2WPKH, as in Appendix C's to_remote output 768 v <- simpleVector 769 spec <- hex (cv_commit_tx v) >>= decodeTx 770 let p2wpkhs = [ spk | BT.TxOut _ spk <- NE.toList (BT.tx_outputs spec) 771 , BS.length spk == 22 ] 772 [to_remote_script_pubkey pk StaticRemotekey] @?= fmap Script p2wpkhs 773 774 , testCase "to_remote witnesses" $ do 775 pk@(RemotePubkey p) <- RemotePubkey <$> pt c_remote_payment_basepoint 776 to_remote_witness "sig" pk StaticRemotekey 777 @?= BT.Witness ["sig", unpoint p] 778 let Script ws = to_remote_witness_script pk 779 to_remote_witness "sig" pk Anchors @?= BT.Witness ["sig", ws] 780 781 , testCase "to_local witnesses" $ do 782 keys <- vectorKeys 783 let s@(Script ws) = to_local_script (ck_revocation_pubkey keys) 784 (ToSelfDelay 144) (ck_local_delayed keys) 785 to_local_witness_spend "sig" s @?= BT.Witness ["sig", "", ws] 786 to_local_witness_revoke "sig" s @?= BT.Witness ["sig", "\x01", ws] 787 788 , testCase "anchor witnesses" $ do 789 keys <- vectorKeys 790 let fpk = ck_local_funding keys 791 Script ws = anchor_script fpk 792 anchor_witness_owner "sig" fpk @?= BT.Witness ["sig", ws] 793 anchor_witness_anyone fpk @?= BT.Witness ["", ws] 794 795 , testCase "HTLC output witnesses" $ do 796 keys <- vectorKeys 797 h <- testHtlc 2 798 pre <- testPreimage 2 799 let rev@(RevocationPubkey rp) = ck_revocation_pubkey keys 800 off@(Script ows) = offered_htlc_script rev (ck_remote_htlc keys) 801 (ck_local_htlc keys) (htlc_payment_hash h) Anchors 802 rcv@(Script rws) = received_htlc_script rev (ck_remote_htlc keys) 803 (ck_local_htlc keys) (htlc_payment_hash h) (htlc_cltv_expiry h) 804 Anchors 805 offered_htlc_witness_preimage "sig" pre off 806 @?= BT.Witness ["sig", BOLT1.un_payment_preimage pre, ows] 807 offered_htlc_witness_revoke "sig" rev off 808 @?= BT.Witness ["sig", unpoint rp, ows] 809 received_htlc_witness_timeout "sig" rcv 810 @?= BT.Witness ["sig", "", rws] 811 received_htlc_witness_revoke "sig" rev rcv 812 @?= BT.Witness ["sig", unpoint rp, rws] 813 814 , testCase "remote_htlc_sighash" $ do 815 remote_htlc_sighash StaticRemotekey @?= Sighash.SIGHASH_ALL 816 remote_htlc_sighash Anchors @?= Sighash.SIGHASH_SINGLE_ANYONECANPAY 817 818 , testCase "CSV delays and CLTV expiries are minimally encoded" $ do 819 keys <- vectorKeys 820 h <- testHtlc 0 821 let rev = ck_revocation_pubkey keys 822 delayed = ck_local_delayed keys 823 delay d = let Script s = to_local_script rev (ToSelfDelay d) delayed 824 in BS.take 4 (BS.drop 36 s) 825 expiry e = 826 let Script s = received_htlc_script rev (ck_remote_htlc keys) 827 (ck_local_htlc keys) (htlc_payment_hash h) (CltvExpiry e) 828 StaticRemotekey 829 in BS.take 5 (BS.drop 130 s) 830 delay 16 @?= BS.pack [0x60, 0xb2, 0x75, 0x21] 831 delay 17 @?= BS.pack [0x01, 0x11, 0xb2, 0x75] 832 delay 0x80 @?= BS.pack [0x02, 0x80, 0x00, 0xb2] 833 delay 0x8000 @?= BS.pack [0x03, 0x00, 0x80, 0x00] 834 expiry 500 @?= BS.pack [0x02, 0xf4, 0x01, 0xb1, 0x75] 835 expiry 0x800000 @?= BS.pack [0x04, 0x00, 0x00, 0x80, 0x00] 836 ] 837 838 -- fees and trimming ---------------------------------------------------------- 839 840 feeTests :: TestTree 841 feeTests = testGroup "Fees and trimming (BOLT #3 fee example)" [ 842 testCase "HTLC transaction fees" $ do 843 fmap BOLT1.un_satoshi 844 [ htlc_timeout_fee rate StaticRemotekey 845 , htlc_success_fee rate StaticRemotekey 846 , htlc_timeout_fee rate Anchors 847 , htlc_success_fee rate Anchors ] 848 @?= [3315, 3515, 0, 0] 849 850 , testCase "trim thresholds" $ do 851 d <- DustLimit <$> sat 546 852 fmap (BOLT1.un_satoshi . htlc_trim_threshold d rate StaticRemotekey) 853 [HTLCOffered, HTLCReceived] @?= [3861, 4061] 854 855 , testCase "trimmed HTLCs and base fee" $ do 856 d <- DustLimit <$> sat 546 857 hs <- sequence 858 [ example HTLCOffered 5000000, example HTLCOffered 1000000 859 , example HTLCReceived 7000000, example HTLCReceived 800000 ] 860 fmap (is_trimmed d rate StaticRemotekey) hs 861 @?= [False, True, False, True] 862 BOLT1.un_satoshi (commitment_fee rate StaticRemotekey 2) @?= 5340 863 BOLT1.un_satoshi (commitment_fee rate Anchors 0) @?= 5620 864 865 , testCase "commitment fee saturates" $ 866 commitment_fee (FeeratePerKw maxBound) StaticRemotekey maxBound 867 @?= BOLT1.max_satoshi 868 ] 869 where 870 rate = FeeratePerKw 5000 871 example dir amt = do 872 a <- msat amt 873 ph <- need "payment hash" (BOLT1.payment_hash (BS.replicate 32 0)) 874 pure (HTLC dir a ph (CltvExpiry 500)) 875 876 -- smart constructors --------------------------------------------------------- 877 878 constructorTests :: TestTree 879 constructorTests = testGroup "Smart constructors" [ 880 testCase "commitment_number" $ do 881 isJust (commitment_number 0) @?= True 882 isJust (commitment_number 0xFFFFFFFFFFFF) @?= True 883 isNothing (commitment_number 0x1000000000000) @?= True 884 , testCase "next_commitment_number" $ do 885 cn <- need "commitment_number" (commitment_number 0xFFFFFFFFFFFE) 886 fmap un_commitment_number (next_commitment_number cn) 887 @?= Just 0xFFFFFFFFFFFF 888 top <- need "commitment_number" (commitment_number 0xFFFFFFFFFFFF) 889 isNothing (next_commitment_number top) @?= True 890 , testCase "secret_index" $ do 891 isJust (secret_index 0xFFFFFFFFFFFF) @?= True 892 isNothing (secret_index 0x1000000000000) @?= True 893 , testCase "seed" $ do 894 isJust (seed (BS.replicate 32 0)) @?= True 895 isNothing (seed (BS.replicate 31 0)) @?= True 896 isNothing (seed (BS.replicate 33 0)) @?= True 897 , testCase "seckey" $ do 898 isJust (seckey (BS.replicate 32 0x01)) @?= True 899 isNothing (seckey (BS.replicate 31 0x01)) @?= True 900 isNothing (seckey (BS.replicate 32 0x00)) @?= True 901 -- the group order n is out of range, n - 1 in range 902 n <- hex 903 "fffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364141" 904 n1 <- hex 905 "fffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364140" 906 isNothing (seckey n) @?= True 907 isJust (seckey n1) @?= True 908 ] 909 910 -- properties ----------------------------------------------------------------- 911 912 propertyTests :: TestTree 913 propertyTests = testGroup "Properties" [ 914 testProperty "derive_privkey matches derive_pubkey" propPrivkey 915 , testProperty "derive_revocationprivkey matches derive_revocationpubkey" 916 propRevocationPrivkey 917 , testProperty "derive_per_commitment_point' = derive_per_commitment_point" 918 propPcpWnaf 919 , testProperty "derive_commitment_keys' = derive_commitment_keys" 920 propCommitmentKeysWnaf 921 , testProperty "every inserted secret is derivable, before and after \ 922 \a round trip through un_secret_store" propSecretStore 923 , testProperty "commitment_number accepts exactly 48-bit values" 924 propCommitmentNumber 925 , testProperty "commitment_secret_index counts down from 2^48 - 1" 926 propSecretIndex 927 ] 928 929 genBytes :: Int -> Gen BS.ByteString 930 genBytes n = BS.pack <$> vectorOf n arbitrary 931 932 -- | A random valid secret key. 933 genSeckey :: Gen Seckey 934 genSeckey = do 935 bs <- genBytes 32 936 maybe genSeckey pure (seckey bs) 937 938 -- | A random point (as the public key of a random secret key). 939 genPoint :: Gen BOLT1.Point 940 genPoint = do 941 k <- genSeckey 942 case pubkey_of k >>= BOLT1.point of 943 Just p -> pure p 944 Nothing -> genPoint 945 946 genSecret :: Gen BOLT1.PerCommitmentSecret 947 genSecret = do 948 k <- genSeckey 949 maybe genSecret pure (BOLT1.per_commitment_secret (un_seckey k)) 950 951 genBasepoints :: Gen Basepoints 952 genBasepoints = Basepoints 953 <$> fmap RevocationBasepoint genPoint 954 <*> fmap PaymentBasepoint genPoint 955 <*> fmap DelayedPaymentBasepoint genPoint 956 <*> fmap HtlcBasepoint genPoint 957 958 propPrivkey :: Property 959 propPrivkey = forAll genSeckey $ \k -> forAll genPoint $ \p -> 960 let pcp = PerCommitmentPoint p 961 bp = pubkey_of k >>= BOLT1.point 962 in (pubkey_of =<< derive_privkey k pcp) 963 === fmap unpoint (bp >>= \b -> derive_pubkey b pcp) 964 965 propRevocationPrivkey :: Property 966 propRevocationPrivkey = forAll genSeckey $ \k -> forAll genSecret $ \s -> 967 let rbp = fmap RevocationBasepoint (pubkey_of k >>= BOLT1.point) 968 pcp = derive_per_commitment_point s 969 expected = do 970 r <- rbp 971 c <- pcp 972 RevocationPubkey p <- derive_revocationpubkey r c 973 pure (unpoint p) 974 in (pubkey_of =<< derive_revocationprivkey k s) === expected 975 976 propPcpWnaf :: Property 977 propPcpWnaf = forAll genSecret $ \s -> 978 derive_per_commitment_point' tex s === derive_per_commitment_point s 979 980 propCommitmentKeysWnaf :: Property 981 propCommitmentKeysWnaf = 982 forAll genBasepoints $ \l -> forAll genBasepoints $ \r -> 983 forAll genPoint $ \lf -> forAll genPoint $ \rf -> forAll genPoint $ \p -> 984 let args f = f l (FundingPubkey lf) r (FundingPubkey rf) 985 (PerCommitmentPoint p) 986 in args (derive_commitment_keys' tex) === args derive_commitment_keys 987 988 -- | After inserting a prefix of a correct sequence (descending from 989 -- 2^48-1, all from one seed), every inserted index is derivable, and 990 -- stays so after a round trip through the store's entries. 991 propSecretStore :: Property 992 propSecretStore = 993 forAll (genBytes 32) $ \sd -> 994 forAll (choose (1, 600)) $ \n -> 995 case seed sd of 996 Nothing -> counterexample "seed" False 997 Just s -> 998 let idxs = [ i | Just i <- fmap secret_index 999 (take n [0xFFFFFFFFFFFF, 0xFFFFFFFFFFFE ..]) ] 1000 secret = generate_from_seed s 1001 insert st i = st >>= insert_secret (secret i) i 1002 derivable st = conjoin 1003 [ fmap unsecret (derive_old_secret i st) 1004 === Just (unsecret (secret i)) 1005 | i <- idxs ] 1006 in case foldl insert (Just empty_secret_store) idxs of 1007 Nothing -> counterexample "insert_secret rejected" False 1008 Just store -> case secret_store (un_secret_store store) of 1009 Nothing -> counterexample "secret_store rejected" False 1010 Just store' -> derivable store .&&. derivable store' 1011 1012 propCommitmentNumber :: Property 1013 propCommitmentNumber = forAll (choose (0, maxBound)) $ \n -> 1014 case commitment_number n of 1015 Just cn -> n <= 0xFFFFFFFFFFFF && un_commitment_number cn == n 1016 Nothing -> n > 0xFFFFFFFFFFFF 1017 1018 propSecretIndex :: Property 1019 propSecretIndex = forAll (choose (0, 0xFFFFFFFFFFFF)) $ \n -> 1020 case commitment_number n of 1021 Nothing -> counterexample "commitment_number" False 1022 Just cn -> 1023 un_secret_index (commitment_secret_index cn) === 0xFFFFFFFFFFFF - n