Message.hs (5376B)
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 , msgUnknown 17 , msgTypeWord 18 , parseMsgType 19 20 -- * Channel identifiers 21 , ChannelId 22 , channelId 23 , unChannelId 24 , allChannels 25 26 -- * Setup messages 27 , Init(..) 28 , Error(..) 29 , Warning(..) 30 31 -- * Control messages 32 , Ping(..) 33 , Pong(..) 34 35 -- * Peer storage messages 36 , PeerStorage(..) 37 , PeerStorageRetrieval(..) 38 39 -- * Message envelope 40 , Message(..) 41 , messageType 42 , Envelope(..) 43 , envelope 44 ) where 45 46 import Control.DeepSeq (NFData) 47 import qualified Data.ByteString as BS 48 import Data.Word (Word16) 49 import GHC.Generics (Generic) 50 import Lightning.Protocol.BOLT1.Prim (ChannelId, channelId, 51 unChannelId, allChannels) 52 import Lightning.Protocol.BOLT1.TLV 53 54 -- Message types --------------------------------------------------------------- 55 56 -- | BOLT #1 message type codes. 57 data MsgType 58 = MsgInit -- ^ 16 59 | MsgError -- ^ 17 60 | MsgPing -- ^ 18 61 | MsgPong -- ^ 19 62 | MsgWarning -- ^ 1 63 | MsgPeerStorage -- ^ 7 64 | MsgPeerStorageRet -- ^ 9 65 | MsgUnknown !Word16 -- ^ Unknown type 66 deriving stock (Eq, Show, Generic) 67 68 instance NFData MsgType 69 70 -- | Get the numeric type code for a message type. 71 msgTypeWord :: MsgType -> Word16 72 msgTypeWord MsgInit = 16 73 msgTypeWord MsgError = 17 74 msgTypeWord MsgPing = 18 75 msgTypeWord MsgPong = 19 76 msgTypeWord MsgWarning = 1 77 msgTypeWord MsgPeerStorage = 7 78 msgTypeWord MsgPeerStorageRet = 9 79 msgTypeWord (MsgUnknown w) = w 80 81 -- | Parse a message type from a word. 82 parseMsgType :: Word16 -> MsgType 83 parseMsgType 16 = MsgInit 84 parseMsgType 17 = MsgError 85 parseMsgType 18 = MsgPing 86 parseMsgType 19 = MsgPong 87 parseMsgType 1 = MsgWarning 88 parseMsgType 7 = MsgPeerStorage 89 parseMsgType 9 = MsgPeerStorageRet 90 parseMsgType w = MsgUnknown w 91 92 -- | Smart constructor for unknown message types. 93 -- 94 -- Returns the appropriate known constructor for known 95 -- type codes (16, 17, 18, 19, 1, 7, 9) and only uses 96 -- 'MsgUnknown' for truly unknown codes. 97 msgUnknown :: Word16 -> MsgType 98 msgUnknown = parseMsgType 99 {-# INLINE msgUnknown #-} 100 101 -- Message ADTs ---------------------------------------------------------------- 102 103 -- | The init message (type 16). 104 data Init = Init 105 { initGlobalFeatures :: !BS.ByteString 106 , initFeatures :: !BS.ByteString 107 , initTlvs :: ![InitTlv] 108 } deriving stock (Eq, Show, Generic) 109 110 instance NFData Init 111 112 -- | The error message (type 17). 113 data Error = Error 114 { errorChannelId :: !ChannelId 115 , errorData :: !BS.ByteString 116 } deriving stock (Eq, Show, Generic) 117 118 instance NFData Error 119 120 -- | The warning message (type 1). 121 data Warning = Warning 122 { warningChannelId :: !ChannelId 123 , warningData :: !BS.ByteString 124 } deriving stock (Eq, Show, Generic) 125 126 instance NFData Warning 127 128 -- | The ping message (type 18). 129 data Ping = Ping 130 { pingNumPongBytes :: {-# UNPACK #-} !Word16 131 , pingIgnored :: !BS.ByteString 132 } deriving stock (Eq, Show, Generic) 133 134 instance NFData Ping 135 136 -- | The pong message (type 19). 137 data Pong = Pong 138 { pongIgnored :: !BS.ByteString 139 } deriving stock (Eq, Show, Generic) 140 141 instance NFData Pong 142 143 -- | The peer_storage message (type 7). 144 data PeerStorage = PeerStorage 145 { peerStorageBlob :: !BS.ByteString 146 } deriving stock (Eq, Show, Generic) 147 148 instance NFData PeerStorage 149 150 -- | The peer_storage_retrieval message (type 9). 151 data PeerStorageRetrieval = PeerStorageRetrieval 152 { peerStorageRetrievalBlob :: !BS.ByteString 153 } deriving stock (Eq, Show, Generic) 154 155 instance NFData PeerStorageRetrieval 156 157 -- | All BOLT #1 messages. 158 data Message 159 = MsgInitVal !Init 160 | MsgErrorVal !Error 161 | MsgWarningVal !Warning 162 | MsgPingVal !Ping 163 | MsgPongVal !Pong 164 | MsgPeerStorageVal !PeerStorage 165 | MsgPeerStorageRetrievalVal !PeerStorageRetrieval 166 deriving stock (Eq, Show, Generic) 167 168 instance NFData Message 169 170 -- | Get the message type for a message. 171 messageType :: Message -> MsgType 172 messageType (MsgInitVal _) = MsgInit 173 messageType (MsgErrorVal _) = MsgError 174 messageType (MsgWarningVal _) = MsgWarning 175 messageType (MsgPingVal _) = MsgPing 176 messageType (MsgPongVal _) = MsgPong 177 messageType (MsgPeerStorageVal _) = MsgPeerStorage 178 messageType (MsgPeerStorageRetrievalVal _) = MsgPeerStorageRet 179 180 -- Message envelope ------------------------------------------------------------ 181 182 -- | A complete message envelope with type, payload, 183 -- and optional extension. 184 data Envelope = Envelope 185 { envType :: !MsgType 186 , envPayload :: !BS.ByteString 187 , envExtension :: !(Maybe TlvStream) 188 } deriving stock (Eq, Show, Generic) 189 190 instance NFData Envelope 191 192 -- | Construct an 'Envelope' from a 'Message' and optional 193 -- extension TLV stream. The 'envType' is derived 194 -- automatically from the 'Message'. 195 envelope :: Message -> Maybe TlvStream -> Envelope 196 envelope msg mext = Envelope 197 { envType = messageType msg 198 , envPayload = BS.empty 199 , envExtension = mext 200 } 201 {-# INLINE envelope #-}