Message.hs (5808B)
1 {-# OPTIONS_HADDOCK prune #-} 2 {-# LANGUAGE DeriveGeneric #-} 3 {-# LANGUAGE DerivingStrategies #-} 4 5 -- | 6 -- Module: Lightning.Protocol.BOLT1.Message 7 -- Copyright: (c) 2025 Jared Tobin 8 -- License: MIT 9 -- Maintainer: Jared Tobin <jared@ppad.tech> 10 -- 11 -- Message types for BOLT #1. 12 13 module Lightning.Protocol.BOLT1.Message ( 14 -- * Message types 15 MsgType(..) 16 , msgTypeWord 17 , parseMsgType 18 19 -- * Channel identifiers 20 , ChannelId 21 , channelId 22 , unChannelId 23 , allChannels 24 25 -- * Setup messages 26 , Init(..) 27 , Error(..) 28 , Warning(..) 29 30 -- * Control messages 31 , Ping(..) 32 , Pong(..) 33 34 -- * Peer storage messages 35 , PeerStorage(..) 36 , PeerStorageRetrieval(..) 37 38 -- * Message envelope 39 , Message(..) 40 , messageType 41 , Envelope(..) 42 ) where 43 44 import Control.DeepSeq (NFData) 45 import qualified Data.ByteString as BS 46 import Data.Word (Word16) 47 import GHC.Generics (Generic) 48 import Lightning.Protocol.BOLT1.TLV 49 50 -- Message types --------------------------------------------------------------- 51 52 -- | BOLT #1 message type codes. 53 data MsgType 54 = MsgInit -- ^ 16 55 | MsgError -- ^ 17 56 | MsgPing -- ^ 18 57 | MsgPong -- ^ 19 58 | MsgWarning -- ^ 1 59 | MsgPeerStorage -- ^ 7 60 | MsgPeerStorageRet -- ^ 9 61 | MsgUnknown !Word16 -- ^ Unknown type 62 deriving stock (Eq, Show, Generic) 63 64 instance NFData MsgType 65 66 -- | Get the numeric type code for a message type. 67 msgTypeWord :: MsgType -> Word16 68 msgTypeWord MsgInit = 16 69 msgTypeWord MsgError = 17 70 msgTypeWord MsgPing = 18 71 msgTypeWord MsgPong = 19 72 msgTypeWord MsgWarning = 1 73 msgTypeWord MsgPeerStorage = 7 74 msgTypeWord MsgPeerStorageRet = 9 75 msgTypeWord (MsgUnknown w) = w 76 77 -- | Parse a message type from a word. 78 parseMsgType :: Word16 -> MsgType 79 parseMsgType 16 = MsgInit 80 parseMsgType 17 = MsgError 81 parseMsgType 18 = MsgPing 82 parseMsgType 19 = MsgPong 83 parseMsgType 1 = MsgWarning 84 parseMsgType 7 = MsgPeerStorage 85 parseMsgType 9 = MsgPeerStorageRet 86 parseMsgType w = MsgUnknown w 87 88 -- Channel identifiers --------------------------------------------------------- 89 90 -- | A 32-byte channel identifier. 91 -- 92 -- Use 'channelId' to construct, which validates the length. 93 -- Use 'allChannels' for connection-level errors (all-zeros channel ID). 94 newtype ChannelId = ChannelId BS.ByteString 95 deriving stock (Eq, Show, Generic) 96 97 instance NFData ChannelId 98 99 -- | Construct a 'ChannelId' from a 32-byte 'BS.ByteString'. 100 -- 101 -- Returns 'Nothing' if the input is not exactly 32 bytes. 102 -- 103 -- >>> channelId (BS.replicate 32 0x00) 104 -- Just (ChannelId "\NUL\NUL...") 105 -- >>> channelId "too short" 106 -- Nothing 107 channelId :: BS.ByteString -> Maybe ChannelId 108 channelId bs 109 | BS.length bs == 32 = Just (ChannelId bs) 110 | otherwise = Nothing 111 {-# INLINE channelId #-} 112 113 -- | The all-zeros channel ID, used for connection-level errors. 114 -- 115 -- Per BOLT #1, setting channel_id to all zeros means the error applies 116 -- to the connection rather than a specific channel. 117 allChannels :: ChannelId 118 allChannels = ChannelId (BS.replicate 32 0x00) 119 120 -- | Extract the raw bytes from a 'ChannelId'. 121 unChannelId :: ChannelId -> BS.ByteString 122 unChannelId (ChannelId bs) = bs 123 {-# INLINE unChannelId #-} 124 125 -- Message ADTs ---------------------------------------------------------------- 126 127 -- | The init message (type 16). 128 data Init = Init 129 { initGlobalFeatures :: !BS.ByteString 130 , initFeatures :: !BS.ByteString 131 , initTlvs :: ![InitTlv] 132 } deriving stock (Eq, Show, Generic) 133 134 instance NFData Init 135 136 -- | The error message (type 17). 137 data Error = Error 138 { errorChannelId :: !ChannelId 139 , errorData :: !BS.ByteString 140 } deriving stock (Eq, Show, Generic) 141 142 instance NFData Error 143 144 -- | The warning message (type 1). 145 data Warning = Warning 146 { warningChannelId :: !ChannelId 147 , warningData :: !BS.ByteString 148 } deriving stock (Eq, Show, Generic) 149 150 instance NFData Warning 151 152 -- | The ping message (type 18). 153 data Ping = Ping 154 { pingNumPongBytes :: {-# UNPACK #-} !Word16 155 , pingIgnored :: !BS.ByteString 156 } deriving stock (Eq, Show, Generic) 157 158 instance NFData Ping 159 160 -- | The pong message (type 19). 161 data Pong = Pong 162 { pongIgnored :: !BS.ByteString 163 } deriving stock (Eq, Show, Generic) 164 165 instance NFData Pong 166 167 -- | The peer_storage message (type 7). 168 data PeerStorage = PeerStorage 169 { peerStorageBlob :: !BS.ByteString 170 } deriving stock (Eq, Show, Generic) 171 172 instance NFData PeerStorage 173 174 -- | The peer_storage_retrieval message (type 9). 175 data PeerStorageRetrieval = PeerStorageRetrieval 176 { peerStorageRetrievalBlob :: !BS.ByteString 177 } deriving stock (Eq, Show, Generic) 178 179 instance NFData PeerStorageRetrieval 180 181 -- | All BOLT #1 messages. 182 data Message 183 = MsgInitVal !Init 184 | MsgErrorVal !Error 185 | MsgWarningVal !Warning 186 | MsgPingVal !Ping 187 | MsgPongVal !Pong 188 | MsgPeerStorageVal !PeerStorage 189 | MsgPeerStorageRetrievalVal !PeerStorageRetrieval 190 deriving stock (Eq, Show, Generic) 191 192 instance NFData Message 193 194 -- | Get the message type for a message. 195 messageType :: Message -> MsgType 196 messageType (MsgInitVal _) = MsgInit 197 messageType (MsgErrorVal _) = MsgError 198 messageType (MsgWarningVal _) = MsgWarning 199 messageType (MsgPingVal _) = MsgPing 200 messageType (MsgPongVal _) = MsgPong 201 messageType (MsgPeerStorageVal _) = MsgPeerStorage 202 messageType (MsgPeerStorageRetrievalVal _) = MsgPeerStorageRet 203 204 -- Message envelope ------------------------------------------------------------ 205 206 -- | A complete message envelope with type, payload, and optional extension. 207 data Envelope = Envelope 208 { envType :: !MsgType 209 , envPayload :: !BS.ByteString 210 , envExtension :: !(Maybe TlvStream) 211 } deriving stock (Eq, Show, Generic) 212 213 instance NFData Envelope