Fixtures.hs (7602B)
1 {-# LANGUAGE DeriveGeneric #-} 2 {-# LANGUAGE OverloadedStrings #-} 3 4 module Fixtures ( 5 Fixtures(..) 6 , fixtures 7 , tex 8 ) where 9 10 import qualified Bitcoin.Prim.Tx as BT 11 import Control.DeepSeq (NFData, force) 12 import Control.Exception (evaluate) 13 import Control.Monad (foldM) 14 import qualified Crypto.Curve.Secp256k1 as S 15 import qualified Crypto.Hash.SHA256 as SHA256 16 import qualified Data.ByteString as BS 17 import qualified Data.ByteString.Base16 as B16 18 import GHC.Generics (Generic) 19 import qualified Lightning.Protocol.BOLT1 as BOLT1 20 import Lightning.Protocol.BOLT3 21 22 -- | Shared wNAF context. 23 tex :: S.Context 24 tex = S.precompute 25 {-# NOINLINE tex #-} 26 27 data Fixtures = Fixtures 28 { fx_secret :: !BOLT1.PerCommitmentSecret 29 , fx_seed :: !Seed 30 , fx_basepoint :: !BOLT1.Point 31 , fx_pcp :: !PerCommitmentPoint 32 , fx_rbp :: !RevocationBasepoint 33 , fx_seckey :: !Seckey 34 , fx_local_bps :: !Basepoints 35 , fx_remote_bps :: !Basepoints 36 , fx_local_fund :: !FundingPubkey 37 , fx_remote_fund :: !FundingPubkey 38 , fx_store :: !SecretStore 39 , fx_store_next :: !(SecretIndex, BOLT1.PerCommitmentSecret) 40 , fx_store_oldest :: !SecretIndex 41 , fx_ctx_simple :: !CommitmentContext 42 , fx_ctx_htlcs :: !CommitmentContext 43 , fx_ctx_anchors :: !CommitmentContext 44 , fx_commit :: !CommitmentTx 45 , fx_htlc_ctx :: !HTLCContext 46 , fx_htlc_tx :: !HTLCTx 47 , fx_closing :: !ClosingContext 48 , fx_legacy :: !LegacyClosingContext 49 , fx_closing_tx :: !ClosingTx 50 } deriving Generic 51 52 instance NFData Fixtures 53 54 hex :: BS.ByteString -> Maybe BS.ByteString 55 hex = B16.decode 56 57 pt :: BS.ByteString -> Maybe BOLT1.Point 58 pt h = hex h >>= BOLT1.point 59 60 -- | Benchmark fixtures, from the BOLT #3 Appendix C parameters, fully 61 -- evaluated. 62 fixtures :: IO Fixtures 63 fixtures = maybe (fail "invalid fixtures") (evaluate . force) build 64 65 build :: Maybe Fixtures 66 build = do 67 secret <- BOLT1.per_commitment_secret (BS.pack [31, 30 .. 0]) 68 sd <- seed (BS.replicate 32 0xff) 69 basepoint <- pt 70 "036d6caac248af96f6afa7f904f550253a0f3ef3f5aa2fe6838a95b216691468e2" 71 pcp <- PerCommitmentPoint <$> pt 72 "025f7117a78150fe2ef97db7cfc83bd57b2e2c0d0dd25eaf467a4a1c2a45ce1486" 73 sk <- seckey (BS.pack [0 .. 31]) 74 75 local_pay <- pt 76 "034f355bdcb7cc0af728ef3cceb9615d90684bb5b2ca5f859ab0f0b704075871aa" 77 remote_pay <- pt 78 "032c0b7cf95324a07d05398b240174dc0c2be444d96b159aa6c7f7b1e668680991" 79 local_delayed <- pt 80 "023c72addb4fdf09af94f0c94d7fe92a386a7e70cf8a1d85916386bb2535c7b1b1" 81 remote_rev <- pt 82 "02466d7fcae563e5cb09a0d1870bb580344804617879a14949cf22285f1bae3f27" 83 local_fund <- FundingPubkey <$> pt 84 "023da092f6980e58d2c037173180e9a465476026ee50f96695963e8efe436f54eb" 85 remote_fund <- FundingPubkey <$> pt 86 "030e9f7b623d2ccc7c9bd44d66d5ce21ce504c0acf6385a132cec6d3c39fa711c1" 87 let local_bps = Basepoints (RevocationBasepoint local_pay) 88 (PaymentBasepoint local_pay) (DelayedPaymentBasepoint local_delayed) 89 (HtlcBasepoint local_pay) 90 remote_bps = Basepoints (RevocationBasepoint remote_rev) 91 (PaymentBasepoint remote_pay) (DelayedPaymentBasepoint remote_pay) 92 (HtlcBasepoint remote_pay) 93 keys <- derive_commitment_keys local_bps local_fund remote_bps remote_fund 94 pcp 95 96 -- a store holding the 2^14 - 1 most recent secrets; the next index has 97 -- 14 trailing zeros, so inserting it checks every lower bucket 98 let n = 16383 :: Int 99 idxs <- traverse secret_index (take n [0xFFFFFFFFFFFF, 0xFFFFFFFFFFFE ..]) 100 store <- foldM (\st i -> insert_secret (generate_from_seed sd i) i st) 101 empty_secret_store idxs 102 next <- secret_index (0xFFFFFFFFFFFF - fromIntegral n) 103 oldest <- secret_index 0xFFFFFFFFFFFF 104 105 txid <- hex 106 "8984484a580b825b9972d7adb15050b3ab624ccd731946b3eeddb92f4e7ef6be" 107 outpoint <- (\t -> BT.OutPoint t 0) <$> BT.mk_txid (BS.reverse txid) 108 cn <- commitment_number 42 109 dust <- DustLimit <$> BOLT1.satoshi 546 110 to_local <- BOLT1.milli_satoshi 6988000000 111 to_remote <- BOLT1.milli_satoshi 3000000000 112 htlcs <- traverse htlc 113 [ (HTLCReceived, 1000000, 500, 0x00), (HTLCReceived, 2000000, 501, 0x01) 114 , (HTLCOffered, 2000000, 502, 0x02), (HTLCOffered, 3000000, 503, 0x03) 115 , (HTLCReceived, 4000000, 504, 0x04) ] 116 let ctx_simple = CommitmentContext 117 { cc_funding_outpoint = outpoint 118 , cc_commitment_number = cn 119 , cc_local_payment_bp = PaymentBasepoint local_pay 120 , cc_remote_payment_bp = PaymentBasepoint remote_pay 121 , cc_to_self_delay = ToSelfDelay 144 122 , cc_dust_limit = dust 123 , cc_feerate = FeeratePerKw 15000 124 , cc_format = StaticRemotekey 125 , cc_is_funder = True 126 , cc_to_local_msat = to_local 127 , cc_to_remote_msat = to_remote 128 , cc_htlcs = [] 129 , cc_keys = keys 130 } 131 ctx_htlcs = ctx_simple { cc_feerate = FeeratePerKw 644 132 , cc_htlcs = htlcs } 133 ctx_anchors = ctx_htlcs { cc_format = Anchors } 134 commit <- build_commitment_tx ctx_htlcs 135 htlc_out <- case htlcs of 136 (h : _) -> Just h 137 [] -> Nothing 138 let htlc_ctx = HTLCContext 139 { hc_commitment_txid = BT.txid (commitment_to_tx commit) 140 , hc_output_index = 0 141 , hc_htlc = htlc_out 142 , hc_to_self_delay = ToSelfDelay 144 143 , hc_feerate = FeeratePerKw 644 144 , hc_format = StaticRemotekey 145 , hc_revocation_pubkey = ck_revocation_pubkey keys 146 , hc_local_delayed = ck_local_delayed keys 147 } 148 htlc_tx <- build_htlc_tx htlc_ctx 149 150 fee <- BOLT1.satoshi 1000 151 let p2wpkh b = Script (BS.pack [0x00, 0x14] <> BS.replicate 20 b) 152 closing = ClosingContext 153 { clc_funding_outpoint = outpoint 154 , clc_closer_msat = to_local 155 , clc_closee_msat = to_remote 156 , clc_closer_script = p2wpkh 0x11 157 , clc_closee_script = p2wpkh 0x22 158 , clc_fee = fee 159 , clc_locktime = Locktime 0 160 , clc_outputs = CloserAndCloseeOutputs 161 } 162 legacy = LegacyClosingContext 163 { lcc_funding_outpoint = outpoint 164 , lcc_local_msat = to_local 165 , lcc_remote_msat = to_remote 166 , lcc_local_script = p2wpkh 0x11 167 , lcc_remote_script = p2wpkh 0x22 168 , lcc_dust_limit = dust 169 , lcc_fee = fee 170 , lcc_is_funder = True 171 , lcc_omit_local = False 172 } 173 closing_tx <- build_closing_tx closing 174 175 pure Fixtures 176 { fx_secret = secret 177 , fx_seed = sd 178 , fx_basepoint = basepoint 179 , fx_pcp = pcp 180 , fx_rbp = RevocationBasepoint basepoint 181 , fx_seckey = sk 182 , fx_local_bps = local_bps 183 , fx_remote_bps = remote_bps 184 , fx_local_fund = local_fund 185 , fx_remote_fund = remote_fund 186 , fx_store = store 187 , fx_store_next = (next, generate_from_seed sd next) 188 , fx_store_oldest = oldest 189 , fx_ctx_simple = ctx_simple 190 , fx_ctx_htlcs = ctx_htlcs 191 , fx_ctx_anchors = ctx_anchors 192 , fx_commit = commit 193 , fx_htlc_ctx = htlc_ctx 194 , fx_htlc_tx = htlc_tx 195 , fx_closing = closing 196 , fx_legacy = legacy 197 , fx_closing_tx = closing_tx 198 } 199 where 200 htlc (dir, amt, expiry, b) = do 201 a <- BOLT1.milli_satoshi amt 202 ph <- BOLT1.payment_hash (SHA256.hash (BS.replicate 32 b)) 203 pure (HTLC dir a ph (CltvExpiry expiry))