ppad-bolt2-0.1.0: bench/Fixtures.hs

{-# LANGUAGE OverloadedStrings #-}

module Fixtures (
    Fixtures(..)
  , fixtures
  ) where

import qualified Bitcoin.Prim.Tx as Tx
import qualified Data.ByteString as BS
import qualified Lightning.Protocol.BOLT1 as BOLT1
import Lightning.Protocol.BOLT2
import qualified Lightning.Protocol.BOLT9 as BOLT9

-- representative messages, with their encoded payloads
data Fixtures = Fixtures
  { fx_open_channel                :: !OpenChannel
  , fx_open_channel_bytes          :: !BS.ByteString
  , fx_accept_channel2             :: !AcceptChannel2
  , fx_accept_channel2_bytes       :: !BS.ByteString
  , fx_tx_signatures               :: !TxSignatures
  , fx_tx_signatures_bytes         :: !BS.ByteString
  , fx_closing_complete            :: !ClosingComplete
  , fx_closing_complete_bytes      :: !BS.ByteString
  , fx_update_add_htlc             :: !UpdateAddHtlc
  , fx_update_add_htlc_bytes       :: !BS.ByteString
  , fx_update_add_htlc_wire        :: !BS.ByteString
  , fx_update_fulfill_htlc         :: !UpdateFulfillHtlc
  , fx_update_fulfill_htlc_bytes   :: !BS.ByteString
  , fx_commitment_signed           :: !CommitmentSigned
  , fx_commitment_signed_bytes     :: !BS.ByteString
  , fx_commitment_signed_483       :: !CommitmentSigned
  , fx_commitment_signed_483_bytes :: !BS.ByteString
  , fx_revoke_and_ack              :: !RevokeAndAck
  , fx_revoke_and_ack_bytes        :: !BS.ByteString
  , fx_channel_reestablish         :: !ChannelReestablish
  , fx_channel_reestablish_bytes   :: !BS.ByteString
  }

ok :: Either e a -> Maybe a
ok = either (const Nothing) Just

empty :: BOLT1.TlvStream
empty = BOLT1.empty_tlv_stream

fixtures :: Maybe Fixtures
fixtures = do
  ch   <- BOLT1.chain_hash (BS.replicate 32 0x6f)
  cid  <- BOLT1.channel_id (BS.replicate 32 0xab)
  pts  <- traverse (\b -> BOLT1.point (BS.cons 0x02 (BS.replicate 32 b)))
            [0x11, 0x22, 0x33, 0x44, 0x55, 0x66, 0x77]
  sig  <- BOLT1.signature (BS.replicate 64 0xa1)
  txid <- Tx.mk_txid (BS.replicate 32 0x7e)
  spk  <- script_pubkey ("\x00\x14" <> BS.replicate 20 0x88)
  fund <- BOLT1.satoshi 1000000
  dust <- BOLT1.satoshi 546
  res  <- BOLT1.satoshi 10000
  push <- BOLT1.milli_satoshi 0
  hmin <- BOLT1.milli_satoshi 1000
  amt  <- BOLT1.milli_satoshi 100000
  fee  <- BOLT1.satoshi 500
  ph   <- BOLT1.payment_hash (BS.replicate 32 0x9a)
  pre  <- BOLT1.payment_preimage (BS.replicate 32 0x50)
  sec  <- BOLT1.per_commitment_secret (BS.replicate 32 0x5e)
  onion <- onion_routing_packet (BS.replicate 1366 0x44)
  att  <- attribution_data (BS.replicate 920 0x0b)
  ws   <- traverse witness
            [ "\x02\x47" <> BS.replicate 71 0x30 <> "\x21"
                <> BS.replicate 33 0x02
            , "\x01\x40" <> BS.replicate 64 0x01 ]
  ext  <- BOLT1.tlv_stream [BOLT1.TlvRecord 43 (BS.replicate 16 0x2a)]
  (p1, p2, p3, p4, p5, p6, p7) <- case pts of
    [a, b, c, d, e, f, g] -> Just (a, b, c, d, e, f, g)
    _ -> Nothing
  let ctype = BOLT9.channel_type_features
        (BOLT9.ChannelType BOLT9.BasicAnchors False False)

      oc = OpenChannel ch cid fund push dust maxBound res hmin 253 144 483
             p1 p2 p3 p4 p5 p6 1 (Just spk) (Just ctype) empty
      ac2 = AcceptChannel2 cid fund dust maxBound hmin 3 144 483
              p1 p2 p3 p4 p5 p6 p7 (Just spk) (Just ctype) True ext
      txs = TxSignatures cid txid ws empty
      cc = ClosingComplete cid spk spk fee 0 (Just sig) Nothing (Just sig)
             empty
      add = UpdateAddHtlc cid (HtlcId 42) amt ph 800000 onion (Just p1)
              empty
      ful = UpdateFulfillHtlc cid (HtlcId 42) pre (Just att) Nothing empty
      cs0 = CommitmentSigned cid sig [] (Just txid) empty
      cs483 = CommitmentSigned cid sig (replicate 483 sig) (Just txid)
                empty
      raa = RevokeAndAck cid sec p1 empty
      rst = ChannelReestablish cid 5 4 sec p1 (Just (NextFunding txid 1))
              empty

  oc_b   <- ok (encode_open_channel oc)
  ac2_b  <- ok (encode_accept_channel2 ac2)
  txs_b  <- ok (encode_tx_signatures txs)
  cc_b   <- ok (encode_closing_complete cc)
  add_b  <- ok (encode_update_add_htlc add)
  add_w  <- ok (encode_message (MsgUpdateAddHtlc add))
  ful_b  <- ok (encode_update_fulfill_htlc ful)
  cs0_b  <- ok (encode_commitment_signed cs0)
  cs483_b <- ok (encode_commitment_signed cs483)
  rst_b  <- ok (encode_channel_reestablish rst)
  pure Fixtures
    { fx_open_channel                = oc
    , fx_open_channel_bytes          = oc_b
    , fx_accept_channel2             = ac2
    , fx_accept_channel2_bytes       = ac2_b
    , fx_tx_signatures               = txs
    , fx_tx_signatures_bytes         = txs_b
    , fx_closing_complete            = cc
    , fx_closing_complete_bytes      = cc_b
    , fx_update_add_htlc             = add
    , fx_update_add_htlc_bytes       = add_b
    , fx_update_add_htlc_wire        = add_w
    , fx_update_fulfill_htlc         = ful
    , fx_update_fulfill_htlc_bytes   = ful_b
    , fx_commitment_signed           = cs0
    , fx_commitment_signed_bytes     = cs0_b
    , fx_commitment_signed_483       = cs483
    , fx_commitment_signed_483_bytes = cs483_b
    , fx_revoke_and_ack              = raa
    , fx_revoke_and_ack_bytes        = encode_revoke_and_ack raa
    , fx_channel_reestablish         = rst
    , fx_channel_reestablish_bytes   = rst_b
    }