Fixtures.hs (6590B)
1 {-# LANGUAGE DeriveGeneric #-} 2 {-# LANGUAGE OverloadedStrings #-} 3 4 module Fixtures ( 5 Fixtures(..) 6 , fixtures 7 ) where 8 9 import qualified Bitcoin.Prim.Tx as BT 10 import Control.DeepSeq (NFData, force) 11 import Control.Exception (evaluate) 12 import qualified Crypto.Hash.SHA256 as SHA256 13 import qualified Data.ByteString as BS 14 import Data.Word (Word8, Word32, Word64) 15 import GHC.Generics (Generic) 16 import qualified Lightning.Protocol.BOLT1 as BOLT1 17 import Lightning.Protocol.BOLT3 18 19 data Fixtures = Fixtures 20 { fx_keys :: !CommitmentKeys 21 , fx_commit :: !CommitmentTx 22 -- ^ BOLT #3 Appendix C commitment with five untrimmed HTLCs 23 , fx_other :: !CommitmentTx 24 -- ^ as 'fx_commit', with a different balance 25 , fx_raw :: !BS.ByteString 26 -- ^ serialized 'fx_commit' 27 , fx_outpoint :: !BT.OutPoint 28 , fx_value :: !BOLT1.Satoshi 29 , fx_anchor :: !BOLT1.Satoshi 30 , fx_dest :: !Script 31 , fx_feerate :: !FeeratePerKw 32 , fx_delay :: !ToSelfDelay 33 , fx_offered :: !HTLC 34 , fx_received :: !HTLC 35 , fx_htlc_ctx :: !HTLCContext 36 -- ^ for 'fx_offered' 37 , fx_hash :: !BOLT1.PaymentHash 38 -- ^ payment hash of 'fx_offered' and 'fx_received' 39 , fx_claim :: !BT.Witness 40 -- ^ remote preimage claim of an offered HTLC 41 , fx_success :: !BT.Witness 42 -- ^ HTLC-success transaction witness 43 } deriving Generic 44 45 instance NFData Fixtures 46 47 pt :: BS.ByteString -> Maybe BOLT1.Point 48 pt h = unhex h >>= BOLT1.point 49 50 -- | Decode a hex string. 51 unhex :: BS.ByteString -> Maybe BS.ByteString 52 unhex bs 53 | odd (BS.length bs) = Nothing 54 | otherwise = BS.pack <$> go (BS.unpack bs) 55 where 56 go (a:b:rest) = (:) <$> byte a b <*> go rest 57 go _ = Just [] 58 byte a b = (\hi lo -> hi * 16 + lo) <$> nibble a <*> nibble b 59 nibble c 60 | c >= 0x30 && c <= 0x39 = Just (c - 0x30) 61 | c >= 0x61 && c <= 0x66 = Just (c - 0x57) 62 | otherwise = Nothing 63 64 -- | Benchmark fixtures, from the BOLT #3 Appendix C parameters, fully 65 -- evaluated. 66 fixtures :: IO Fixtures 67 fixtures = maybe (fail "invalid fixtures") (evaluate . force) build 68 69 build :: Maybe Fixtures 70 build = do 71 rev <- pt 72 "0212a140cd0c6539d07cd08dfe09984dec3251ea808b892efeac3ede9402bf2b19" 73 delayed <- pt 74 "03fd5960528dc152014952efdb702a88f71e3c1653b2314431701ec77e57fde83c" 75 local_htlc <- pt 76 "030d417a46946384f88d5f3337267c5e579765875dc4daca813e21734b140639e7" 77 remote_htlc <- pt 78 "0394854aa6eab5b2a8122cc726e9dded053a2184d88256816826d6231c068d4a5b" 79 local_pay <- pt 80 "034f355bdcb7cc0af728ef3cceb9615d90684bb5b2ca5f859ab0f0b704075871aa" 81 remote_pay <- pt 82 "032c0b7cf95324a07d05398b240174dc0c2be444d96b159aa6c7f7b1e668680991" 83 local_fund <- pt 84 "023da092f6980e58d2c037173180e9a465476026ee50f96695963e8efe436f54eb" 85 remote_fund <- pt 86 "030e9f7b623d2ccc7c9bd44d66d5ce21ce504c0acf6385a132cec6d3c39fa711c1" 87 funding_txid <- BT.mk_txid =<< unhex 88 "bef67e4e2fb9ddeeb3461973cd4c62abb35050b1add772995b820b584a488489" 89 cn <- commitment_number 42 90 dust <- BOLT1.satoshi 546 91 value <- BOLT1.satoshi 100000 92 anchor <- BOLT1.satoshi 330 93 to_remote <- BOLT1.milli_satoshi 3000000000 94 h0 <- htlc HTLCReceived 1000000 500 0x00 95 h1 <- htlc HTLCReceived 2000000 501 0x01 96 h2 <- htlc HTLCOffered 2000000 502 0x02 97 h3 <- htlc HTLCOffered 3000000 503 0x03 98 h4 <- htlc HTLCReceived 4000000 504 0x04 99 preimage <- BOLT1.payment_preimage (BS.replicate 32 0x01) 100 let keys = CommitmentKeys 101 { ck_revocation_pubkey = RevocationPubkey rev 102 , ck_local_delayed = LocalDelayedPubkey delayed 103 , ck_local_htlc = LocalHtlcPubkey local_htlc 104 , ck_remote_htlc = RemoteHtlcPubkey remote_htlc 105 , ck_remote_payment = RemotePubkey remote_pay 106 , ck_local_funding = FundingPubkey local_fund 107 , ck_remote_funding = FundingPubkey remote_fund 108 } 109 ctx to_local = do 110 tl <- BOLT1.milli_satoshi to_local 111 pure CommitmentContext 112 { cc_funding_outpoint = BT.OutPoint funding_txid 0 113 , cc_commitment_number = cn 114 , cc_local_payment_bp = PaymentBasepoint local_pay 115 , cc_remote_payment_bp = PaymentBasepoint remote_pay 116 , cc_to_self_delay = ToSelfDelay 144 117 , cc_dust_limit = DustLimit dust 118 , cc_feerate = FeeratePerKw 0 119 , cc_format = StaticRemotekey 120 , cc_is_funder = True 121 , cc_to_local_msat = tl 122 , cc_to_remote_msat = to_remote 123 , cc_htlcs = [h0, h1, h2, h3, h4] 124 , cc_keys = keys 125 } 126 sig = BS.replicate 71 0xCC 127 script_of h = case htlc_direction h of 128 HTLCOffered -> offered_htlc_script (RevocationPubkey rev) 129 (RemoteHtlcPubkey remote_htlc) (LocalHtlcPubkey local_htlc) 130 (htlc_payment_hash h) StaticRemotekey 131 HTLCReceived -> received_htlc_script (RevocationPubkey rev) 132 (RemoteHtlcPubkey remote_htlc) (LocalHtlcPubkey local_htlc) 133 (htlc_payment_hash h) (htlc_cltv_expiry h) StaticRemotekey 134 offered = h2 { htlc_payment_hash = htlc_payment_hash h1 } 135 commit <- build_commitment_tx =<< ctx 6988000000 136 other <- build_commitment_tx =<< ctx 6987000000 137 pure Fixtures 138 { fx_keys = keys 139 , fx_commit = commit 140 , fx_other = other 141 , fx_raw = encode_commitment_tx commit 142 , fx_outpoint = BT.OutPoint funding_txid 1 143 , fx_value = value 144 , fx_anchor = anchor 145 , fx_dest = Script (BS.pack [0x00, 0x14] <> BS.replicate 20 0xCC) 146 , fx_feerate = FeeratePerKw 253 147 , fx_delay = ToSelfDelay 144 148 , fx_offered = offered 149 , fx_received = h1 150 , fx_htlc_ctx = HTLCContext 151 { hc_commitment_txid = funding_txid 152 , hc_output_index = 2 153 , hc_htlc = offered 154 , hc_to_self_delay = ToSelfDelay 144 155 , hc_feerate = FeeratePerKw 253 156 , hc_format = StaticRemotekey 157 , hc_revocation_pubkey = RevocationPubkey rev 158 , hc_local_delayed = LocalDelayedPubkey delayed 159 } 160 , fx_hash = htlc_payment_hash h1 161 , fx_claim = 162 offered_htlc_witness_preimage sig preimage (script_of offered) 163 , fx_success = htlc_success_witness sig sig preimage (script_of h1) 164 } 165 where 166 htlc :: HTLCDirection -> Word64 -> Word32 -> Word8 -> Maybe HTLC 167 htlc dir amt expiry b = do 168 a <- BOLT1.milli_satoshi amt 169 ph <- BOLT1.payment_hash (SHA256.hash (BS.replicate 32 b)) 170 pure (HTLC dir a ph (CltvExpiry expiry))