bolt5

On-chain transaction handling for Lightning (docs.ppad.tech/bolt5).
git clone git://git.ppad.tech/bolt5.git
Log | Files | Refs | README | LICENSE

Main.hs (4801B)

      1 {-# LANGUAGE BangPatterns #-}
      2 {-# LANGUAGE OverloadedStrings #-}
      3 {-# OPTIONS_GHC -fno-warn-orphans #-}
      4 
      5 module Main where
      6 
      7 import Bitcoin.Prim.Tx.Sighash (SighashType(..))
      8 import Control.DeepSeq (NFData(..))
      9 import Criterion.Main
     10 import qualified Data.ByteString as BS
     11 import qualified Data.List.NonEmpty as NE
     12 import Lightning.Protocol.BOLT3 hiding
     13   (txout_value, txout_script)
     14 import qualified Lightning.Protocol.BOLT5 as B5
     15 
     16 -- NFData orphan instances for criterion -----------------------------
     17 
     18 instance NFData Satoshi where
     19   rnf (Satoshi x) = rnf x
     20 
     21 instance NFData MilliSatoshi where
     22   rnf (MilliSatoshi x) = rnf x
     23 
     24 instance NFData Script where
     25   rnf (Script bs) = rnf bs
     26 
     27 instance NFData Pubkey where
     28   rnf (Pubkey x) = rnf x
     29 
     30 instance NFData Point where
     31   rnf (Point x) = rnf x
     32 
     33 instance NFData RevocationPubkey where
     34   rnf (RevocationPubkey x) = rnf x
     35 
     36 instance NFData LocalDelayedPubkey where
     37   rnf (LocalDelayedPubkey p) = rnf p
     38 
     39 instance NFData FundingPubkey where
     40   rnf (FundingPubkey p) = rnf p
     41 
     42 instance NFData FeeratePerKw where
     43   rnf (FeeratePerKw x) = rnf x
     44 
     45 instance NFData ToSelfDelay where
     46   rnf (ToSelfDelay x) = rnf x
     47 
     48 instance NFData PaymentHash where
     49   rnf (PaymentHash x) = rnf x
     50 
     51 instance NFData CltvExpiry where
     52   rnf (CltvExpiry x) = rnf x
     53 
     54 instance NFData HTLCDirection where
     55   rnf HTLCOffered = ()
     56   rnf HTLCReceived = ()
     57 
     58 instance NFData HTLC where
     59   rnf (HTLC d a h c) =
     60     rnf d `seq` rnf a `seq` rnf h `seq` rnf c
     61 
     62 instance NFData SighashType
     63 
     64 instance NFData B5.OutputResolution where
     65   rnf B5.Resolved = ()
     66   rnf (B5.Revoke rk) = rnf rk
     67   rnf _ = ()
     68 
     69 instance NFData B5.UnresolvedOutput where
     70   rnf (B5.UnresolvedOutput op v t) =
     71     rnf op `seq` rnf v `seq` rnf t
     72 
     73 instance NFData B5.SpendingTx where
     74   rnf (B5.SpendingTx tx scr val sh) =
     75     rnf tx `seq` rnf scr `seq` rnf val `seq` rnf sh
     76 
     77 instance NFData B5.PenaltyContext where
     78   rnf (B5.PenaltyContext os rk d f) =
     79     rnf os `seq` rnf rk `seq` rnf d `seq` rnf f
     80 
     81 main :: IO ()
     82 main = defaultMain [
     83     spend_benchmarks
     84   , classify_benchmarks
     85   ]
     86 
     87 -- fixtures -----------------------------------------------------------
     88 
     89 dummyPubkey :: Pubkey
     90 dummyPubkey = case pubkey (BS.pack (0x02 : replicate 32 0x01)) of
     91   Just pk -> pk
     92   Nothing -> error "impossible"
     93 
     94 dummyTxId :: TxId
     95 dummyTxId = case mkTxId (BS.replicate 32 0x00) of
     96   Just tid -> tid
     97   Nothing  -> error "impossible"
     98 
     99 dummyOutPoint :: OutPoint
    100 dummyOutPoint = OutPoint dummyTxId 0
    101 
    102 dummyRevPk :: RevocationPubkey
    103 dummyRevPk = RevocationPubkey dummyPubkey
    104 
    105 dummyDelayedPk :: LocalDelayedPubkey
    106 dummyDelayedPk = LocalDelayedPubkey dummyPubkey
    107 
    108 dummyFundPk :: FundingPubkey
    109 dummyFundPk = FundingPubkey dummyPubkey
    110 
    111 dummyDest :: Script
    112 dummyDest = Script $ BS.pack [0x00, 0x14] <>
    113   BS.replicate 20 0xCC
    114 
    115 dummyFeerate :: FeeratePerKw
    116 dummyFeerate = FeeratePerKw 253
    117 
    118 dummyDelay :: ToSelfDelay
    119 dummyDelay = ToSelfDelay 144
    120 
    121 mkRevokedOutputs :: Int -> NE.NonEmpty B5.UnresolvedOutput
    122 mkRevokedOutputs n =
    123   let uo i = B5.UnresolvedOutput
    124         (OutPoint dummyTxId (fromIntegral i))
    125         (Satoshi 10000)
    126         (B5.Revoke dummyRevPk)
    127   in  uo 0 NE.:| [ uo i | i <- [1..n-1] ]
    128 
    129 -- benchmarks ---------------------------------------------------------
    130 
    131 spend_benchmarks :: Benchmark
    132 spend_benchmarks = bgroup "spend" [
    133     bench "spend_to_local" $
    134       nf (\v -> B5.spend_to_local
    135             dummyOutPoint v dummyRevPk dummyDelay
    136             dummyDelayedPk dummyDest dummyFeerate)
    137         (Satoshi 100000)
    138 
    139   , bench "spend_revoked_to_local" $
    140       nf (\v -> B5.spend_revoked_to_local
    141             dummyOutPoint v dummyRevPk dummyDelay
    142             dummyDelayedPk dummyDest dummyFeerate)
    143         (Satoshi 100000)
    144 
    145   , bench "spend_anchor_owner" $
    146       nf (\v -> B5.spend_anchor_owner
    147             dummyOutPoint v dummyFundPk dummyDest)
    148         (Satoshi 330)
    149 
    150   , bench "spend_revoked_batch/10" $
    151       nf B5.spend_revoked_batch
    152         (B5.PenaltyContext
    153           (mkRevokedOutputs 10)
    154           dummyRevPk dummyDest dummyFeerate)
    155 
    156   , bench "spend_revoked_batch/100" $
    157       nf B5.spend_revoked_batch
    158         (B5.PenaltyContext
    159           (mkRevokedOutputs 100)
    160           dummyRevPk dummyDest dummyFeerate)
    161 
    162   , bench "spend_revoked_batch/483" $
    163       nf B5.spend_revoked_batch
    164         (B5.PenaltyContext
    165           (mkRevokedOutputs 483)
    166           dummyRevPk dummyDest dummyFeerate)
    167   ]
    168 
    169 classify_benchmarks :: Benchmark
    170 classify_benchmarks = bgroup "classify" [
    171     bench "spending_fee" $
    172       nf (B5.spending_fee dummyFeerate) 538
    173 
    174   , bench "htlc_timed_out" $
    175       nf (B5.htlc_timed_out 500001)
    176         (HTLC HTLCOffered (MilliSatoshi 1000000)
    177               dummyPaymentHash (CltvExpiry 500000))
    178   ]
    179   where
    180     dummyPaymentHash = case paymentHash
    181       (BS.replicate 32 0xAA) of
    182         Just ph -> ph
    183         Nothing -> error "impossible"