Fixtures.hs (5904B)
1 {-# LANGUAGE OverloadedStrings #-} 2 3 module Fixtures ( 4 Fixtures(..) 5 , fixtures 6 ) where 7 8 import Control.DeepSeq (NFData(..)) 9 import qualified Data.ByteString as BS 10 import qualified Lightning.Protocol.BOLT1 as BOLT1 11 import Lightning.Protocol.BOLT4 12 13 data Fixtures = Fixtures { 14 fx_session :: !SecretKey 15 , fx_ad :: !BS.ByteString 16 , fx_route_1 :: ![Hop] 17 , fx_route_5 :: ![Hop] 18 , fx_route_20 :: ![Hop] 19 , fx_first_node :: !SecretKey 20 , fx_onion_5 :: !OnionPacket 21 , fx_onion_1 :: !OnionPacket 22 , fx_secrets_5 :: ![SharedSecret] 23 , fx_secret :: !SharedSecret 24 , fx_blinded_node :: !SecretKey 25 , fx_blinded_onion :: !OnionPacket 26 , fx_path_key :: !BOLT1.Point 27 , fx_path_seed :: !SecretKey 28 , fx_path_nodes :: ![(BOLT1.Point, BlindedHopData)] 29 , fx_encrypted :: !BS.ByteString 30 , fx_failure :: !FailureMessage 31 , fx_error :: !ErrorPacket 32 , fx_returned :: !ErrorPacket 33 , fx_onion_bytes :: !BS.ByteString 34 , fx_payload :: !HopPayload 35 , fx_payload_bytes :: !BS.ByteString 36 } 37 38 instance NFData Fixtures where 39 rnf (Fixtures a b c d e f g h i j k l m n o p q r s t u v) = 40 rnf a `seq` rnf b `seq` rnf c `seq` rnf d `seq` rnf e `seq` rnf f 41 `seq` rnf g `seq` rnf h `seq` rnf i `seq` rnf j `seq` rnf k 42 `seq` rnf l `seq` rnf m `seq` rnf n `seq` rnf o `seq` rnf p 43 `seq` rnf q `seq` rnf r `seq` rnf s `seq` rnf t `seq` rnf u 44 `seq` rnf v 45 46 demand :: String -> Maybe a -> IO a 47 demand msg = maybe (ioError (userError msg)) pure 48 49 right :: Show e => String -> Either e a -> IO a 50 right msg = either (ioError . userError . (msg ++) . (": " ++) . show) pure 51 52 fixtures :: IO Fixtures 53 fixtures = do 54 let key b = demand "secret_key" (secret_key (BS.replicate 32 b)) 55 ad = BS.replicate 32 0x42 56 session <- key 0x41 57 nodes <- mapM key [1 .. 20] 58 amt <- demand "milli_satoshi" (BOLT1.milli_satoshi 100000) 59 scid <- demand "short_channel_id" (BOLT1.short_channel_id 800000 1 0) 60 ps <- demand "payment_secret" (payment_secret (BS.replicate 32 0xaa)) 61 let fwd = empty_hop_payload 62 { hp_amt_to_forward = Just amt 63 , hp_outgoing_cltv_value = Just 800000 64 , hp_short_channel_id = Just scid 65 } 66 final = empty_hop_payload 67 { hp_amt_to_forward = Just amt 68 , hp_outgoing_cltv_value = Just 800000 69 , hp_payment_data = Just (PaymentData ps amt) 70 } 71 route n = [ Hop (public_key k) fwd | k <- take (n - 1) nodes ] 72 ++ [ Hop (public_key k) final 73 | k <- take 1 (drop (n - 1) nodes) ] 74 first_node <- demand "node" (safe_head nodes) 75 (onion_5, secrets_5) <- right "construct" (construct session (route 5) ad) 76 (onion_1, _) <- right "construct" (construct session (route 1) ad) 77 78 -- a blinded route through nodes 1 to 3, entered at node 0 79 seed <- key 0x55 80 let relay = empty_blinded_hop_data 81 { bhd_short_channel_id = Just scid 82 , bhd_payment_relay = Just (PaymentRelay 40 100 1000) 83 } 84 path_nodes = [ (public_key k, relay) | k <- take 2 (drop 1 nodes) ] 85 ++ [ (public_key k, empty_blinded_hop_data 86 { bhd_path_id = Just (BS.replicate 32 1) }) 87 | k <- take 1 (drop 3 nodes) ] 88 path <- right "create_blinded_path" (create_blinded_path seed path_nodes) 89 hops <- case bp_hops path of 90 [h1, h2, h3] -> pure (h1, h2, h3) 91 _ -> ioError (userError "expected 3 blinded hops") 92 let (h1, h2, h3) = hops 93 bhop h pl = Hop (bh_blinded_node_id h) 94 pl { hp_encrypted_data = Just (bh_encrypted_data h) } 95 entry = Hop (public_key first_node) fwd 96 broute = [ entry 97 , Hop (bp_first_node_id path) empty_hop_payload 98 { hp_encrypted_data = Just (bh_encrypted_data h1) 99 , hp_current_path_key = Just (bp_first_path_key path) } 100 , bhop h2 empty_hop_payload 101 , bhop h3 empty_hop_payload 102 { hp_amt_to_forward = Just amt 103 , hp_outgoing_cltv_value = Just 800000 104 , hp_total_amount_msat = Just amt } ] 105 (bonion, _) <- right "construct" (construct session broute ad) 106 -- the onion received, with a path_key, by node 2 107 node1 <- demand "node" (safe_head (drop 1 nodes)) 108 node2 <- demand "node" (safe_head (drop 2 nodes)) 109 f0 <- forwarded (process first_node bonion ad Nothing) 110 f1 <- forwarded (process node1 (fwd_next_packet f0) ad Nothing) 111 b1 <- demand "blinded" (fwd_blinded f1) 112 113 -- node 4 fails a 5-hop payment 114 ss4 <- demand "secret" (safe_head (drop 4 secrets_5)) 115 let failure = FailureMessage TemporaryNodeFailure BOLT1.empty_tlv_stream 116 err <- right "construct_error" (construct_error ss4 failure) 117 let returned = foldr wrap_error err (take 4 secrets_5) 118 119 payload_bytes <- right "encode_hop_payload" (encode_hop_payload final) 120 pure Fixtures { 121 fx_session = session 122 , fx_ad = ad 123 , fx_route_1 = route 1 124 , fx_route_5 = route 5 125 , fx_route_20 = route 20 126 , fx_first_node = first_node 127 , fx_onion_5 = onion_5 128 , fx_onion_1 = onion_1 129 , fx_secrets_5 = secrets_5 130 , fx_secret = ss4 131 , fx_blinded_node = node2 132 , fx_blinded_onion = fwd_next_packet f1 133 , fx_path_key = bi_next_path_key b1 134 , fx_path_seed = seed 135 , fx_path_nodes = path_nodes 136 , fx_encrypted = bh_encrypted_data h2 137 , fx_failure = failure 138 , fx_error = err 139 , fx_returned = returned 140 , fx_onion_bytes = encode_onion_packet onion_5 141 , fx_payload = final 142 , fx_payload_bytes = payload_bytes 143 } 144 where 145 safe_head xs = case xs of 146 x : _ -> Just x 147 [] -> Nothing 148 forwarded r = case r of 149 Right (Forward f) -> pure f 150 _ -> ioError (userError ("expected Forward: " ++ show r))