Weight.hs (10194B)
1 {-# LANGUAGE BangPatterns #-} 2 {-# LANGUAGE OverloadedStrings #-} 3 4 module Main where 5 6 import qualified Data.ByteString as BS 7 import Data.Word (Word16, Word32, Word64) 8 import Data.Int (Int8, Int16, Int32, Int64) 9 import Lightning.Protocol.BOLT1 10 import Lightning.Protocol.BOLT1.Codec 11 import Lightning.Protocol.BOLT1.TLV (encodeTlvRecord) 12 import Weigh 13 14 -- Fixtures -------------------------------------------------------------------- 15 16 -- Prevent constant folding with NOINLINE 17 18 {-# NOINLINE w16Val #-} 19 w16Val :: Word16 20 w16Val = 0x1234 21 22 {-# NOINLINE w32Val #-} 23 w32Val :: Word32 24 w32Val = 0x12345678 25 26 {-# NOINLINE w64Val #-} 27 w64Val :: Word64 28 w64Val = 0x0102030405060708 29 30 {-# NOINLINE s8Val #-} 31 s8Val :: Int8 32 s8Val = -42 33 34 {-# NOINLINE s16Val #-} 35 s16Val :: Int16 36 s16Val = -1000 37 38 {-# NOINLINE s32Val #-} 39 s32Val :: Int32 40 s32Val = -100000 41 42 {-# NOINLINE s64Val #-} 43 s64Val :: Int64 44 s64Val = -10000000000 45 46 {-# NOINLINE tu16Small #-} 47 tu16Small :: Word16 48 tu16Small = 0x7f 49 50 {-# NOINLINE tu16Full #-} 51 tu16Full :: Word16 52 tu16Full = 0xffff 53 54 {-# NOINLINE tu32Small #-} 55 tu32Small :: Word32 56 tu32Small = 0x42 57 58 {-# NOINLINE tu32Full #-} 59 tu32Full :: Word32 60 tu32Full = 0xffffffff 61 62 {-# NOINLINE tu64Small #-} 63 tu64Small :: Word64 64 tu64Small = 0x10 65 66 {-# NOINLINE tu64Full #-} 67 tu64Full :: Word64 68 tu64Full = 0xffffffffffffffff 69 70 {-# NOINLINE bigSizeSmall #-} 71 bigSizeSmall :: Word64 72 bigSizeSmall = 0xfc 73 74 {-# NOINLINE bigSizeMedium #-} 75 bigSizeMedium :: Word64 76 bigSizeMedium = 0x1000 77 78 {-# NOINLINE bigSizeLarge #-} 79 bigSizeLarge :: Word64 80 bigSizeLarge = 0x100000000 81 82 -- Pre-encoded bytes for decoder benchmarks 83 84 {-# NOINLINE u16Bytes #-} 85 u16Bytes :: BS.ByteString 86 u16Bytes = encodeU16 w16Val 87 88 {-# NOINLINE u32Bytes #-} 89 u32Bytes :: BS.ByteString 90 u32Bytes = encodeU32 w32Val 91 92 {-# NOINLINE u64Bytes #-} 93 u64Bytes :: BS.ByteString 94 u64Bytes = encodeU64 w64Val 95 96 {-# NOINLINE s8Bytes #-} 97 s8Bytes :: BS.ByteString 98 s8Bytes = encodeS8 s8Val 99 100 {-# NOINLINE s16Bytes #-} 101 s16Bytes :: BS.ByteString 102 s16Bytes = encodeS16 s16Val 103 104 {-# NOINLINE s32Bytes #-} 105 s32Bytes :: BS.ByteString 106 s32Bytes = encodeS32 s32Val 107 108 {-# NOINLINE s64Bytes #-} 109 s64Bytes :: BS.ByteString 110 s64Bytes = encodeS64 s64Val 111 112 {-# NOINLINE bigSizeBytes #-} 113 bigSizeBytes :: BS.ByteString 114 bigSizeBytes = encodeBigSize bigSizeLarge 115 116 -- TLV fixtures 117 118 {-# NOINLINE tlvRecord1 #-} 119 tlvRecord1 :: TlvRecord 120 tlvRecord1 = TlvRecord 1 "test-value" 121 122 {-# NOINLINE tlvStream1 #-} 123 tlvStream1 :: TlvStream 124 tlvStream1 = unsafeTlvStream [tlvRecord1] 125 126 {-# NOINLINE tlvStream5 #-} 127 tlvStream5 :: TlvStream 128 tlvStream5 = unsafeTlvStream 129 [ TlvRecord 1 "value1" 130 , TlvRecord 3 "value3" 131 , TlvRecord 5 "value5" 132 , TlvRecord 7 "value7" 133 , TlvRecord 9 "value9" 134 ] 135 136 {-# NOINLINE tlvStream20 #-} 137 tlvStream20 :: TlvStream 138 tlvStream20 = unsafeTlvStream 139 [ TlvRecord (2 * i + 1) (BS.replicate 10 (fromIntegral i)) 140 | i <- [0..19] 141 ] 142 143 {-# NOINLINE tlvStreamBytes1 #-} 144 tlvStreamBytes1 :: BS.ByteString 145 tlvStreamBytes1 = encodeTlvStream tlvStream1 146 147 {-# NOINLINE tlvStreamBytes5 #-} 148 tlvStreamBytes5 :: BS.ByteString 149 tlvStreamBytes5 = encodeTlvStream tlvStream5 150 151 {-# NOINLINE tlvStreamBytes20 #-} 152 tlvStreamBytes20 :: BS.ByteString 153 tlvStreamBytes20 = encodeTlvStream tlvStream20 154 155 -- Message fixtures 156 157 {-# NOINLINE minimalInit #-} 158 minimalInit :: Init 159 minimalInit = Init BS.empty BS.empty [] 160 161 {-# NOINLINE initWithFeatures #-} 162 initWithFeatures :: Init 163 initWithFeatures = Init "\x00\x08" "\x00\x0a\x8a" [] 164 165 {-# NOINLINE initWithTlvs #-} 166 initWithTlvs :: Init 167 initWithTlvs = Init BS.empty "\x00\x01" [InitRemoteAddr "127.0.0.1"] 168 169 {-# NOINLINE errorMsg #-} 170 errorMsg :: Error 171 errorMsg = Error allChannels "something bad happened" 172 173 {-# NOINLINE warningMsg #-} 174 warningMsg :: Warning 175 warningMsg = Warning allChannels "something concerning" 176 177 {-# NOINLINE pingMinimal #-} 178 pingMinimal :: Ping 179 pingMinimal = Ping 4 BS.empty 180 181 {-# NOINLINE pingWithPadding #-} 182 pingWithPadding :: Ping 183 pingWithPadding = Ping 4 (BS.replicate 64 0x00) 184 185 {-# NOINLINE pongMsg #-} 186 pongMsg :: Pong 187 pongMsg = Pong (BS.replicate 4 0x00) 188 189 {-# NOINLINE peerStorageMsg #-} 190 peerStorageMsg :: PeerStorage 191 peerStorageMsg = PeerStorage (BS.replicate 100 0xab) 192 193 {-# NOINLINE peerStorageRetrievalMsg #-} 194 peerStorageRetrievalMsg :: PeerStorageRetrieval 195 peerStorageRetrievalMsg = PeerStorageRetrieval (BS.replicate 50 0xcd) 196 197 -- Pre-encoded message bytes for decoder benchmarks 198 199 {-# NOINLINE initMinimalBytes #-} 200 initMinimalBytes :: BS.ByteString 201 initMinimalBytes = either (const BS.empty) id (encodeInit minimalInit) 202 203 {-# NOINLINE initWithTlvsBytes #-} 204 initWithTlvsBytes :: BS.ByteString 205 initWithTlvsBytes = either (const BS.empty) id (encodeInit initWithTlvs) 206 207 {-# NOINLINE errorBytes #-} 208 errorBytes :: BS.ByteString 209 errorBytes = either (const BS.empty) id (encodeError errorMsg) 210 211 {-# NOINLINE warningBytes #-} 212 warningBytes :: BS.ByteString 213 warningBytes = either (const BS.empty) id (encodeWarning warningMsg) 214 215 {-# NOINLINE pingMinimalBytes #-} 216 pingMinimalBytes :: BS.ByteString 217 pingMinimalBytes = either (const BS.empty) id (encodePing pingMinimal) 218 219 {-# NOINLINE pingWithPaddingBytes #-} 220 pingWithPaddingBytes :: BS.ByteString 221 pingWithPaddingBytes = either (const BS.empty) id (encodePing pingWithPadding) 222 223 {-# NOINLINE pongBytes #-} 224 pongBytes :: BS.ByteString 225 pongBytes = either (const BS.empty) id (encodePong pongMsg) 226 227 {-# NOINLINE peerStorageBytes #-} 228 peerStorageBytes :: BS.ByteString 229 peerStorageBytes = either (const BS.empty) id (encodePeerStorage peerStorageMsg) 230 231 {-# NOINLINE peerStorageRetrievalBytes #-} 232 peerStorageRetrievalBytes :: BS.ByteString 233 peerStorageRetrievalBytes = 234 either (const BS.empty) id (encodePeerStorageRetrieval peerStorageRetrievalMsg) 235 236 -- Envelope fixtures 237 238 {-# NOINLINE initMessage #-} 239 initMessage :: Message 240 initMessage = MsgInitVal minimalInit 241 242 {-# NOINLINE pingMessage #-} 243 pingMessage :: Message 244 pingMessage = MsgPingVal pingMinimal 245 246 {-# NOINLINE envelopeBytes #-} 247 envelopeBytes :: BS.ByteString 248 envelopeBytes = either (const BS.empty) id (encodeEnvelope initMessage Nothing) 249 250 -- Main ------------------------------------------------------------------------ 251 252 main :: IO () 253 main = mainWith $ do 254 setColumns [Case, Allocated, GCs, Max] 255 256 -- Primitive encoders -------------------------------------------------------- 257 258 wgroup "Primitive Encoders" $ do 259 func "encodeU16" encodeU16 w16Val 260 func "encodeU32" encodeU32 w32Val 261 func "encodeU64" encodeU64 w64Val 262 func "encodeS8" encodeS8 s8Val 263 func "encodeS16" encodeS16 s16Val 264 func "encodeS32" encodeS32 s32Val 265 func "encodeS64" encodeS64 s64Val 266 267 wgroup "Truncated Unsigned Encoders" $ do 268 func "encodeTu16/small" encodeTu16 tu16Small 269 func "encodeTu16/full" encodeTu16 tu16Full 270 func "encodeTu32/small" encodeTu32 tu32Small 271 func "encodeTu32/full" encodeTu32 tu32Full 272 func "encodeTu64/small" encodeTu64 tu64Small 273 func "encodeTu64/full" encodeTu64 tu64Full 274 275 wgroup "Minimal Signed Encoder" $ do 276 func "encodeMinSigned/1-byte" encodeMinSigned (0 :: Int64) 277 func "encodeMinSigned/2-byte" encodeMinSigned (1000 :: Int64) 278 func "encodeMinSigned/4-byte" encodeMinSigned (100000 :: Int64) 279 func "encodeMinSigned/8-byte" encodeMinSigned s64Val 280 281 wgroup "BigSize Encoder" $ do 282 func "encodeBigSize/1-byte" encodeBigSize bigSizeSmall 283 func "encodeBigSize/3-byte" encodeBigSize bigSizeMedium 284 func "encodeBigSize/9-byte" encodeBigSize bigSizeLarge 285 286 -- Primitive decoders -------------------------------------------------------- 287 288 wgroup "Primitive Decoders" $ do 289 func "decodeU16" decodeU16 u16Bytes 290 func "decodeU32" decodeU32 u32Bytes 291 func "decodeU64" decodeU64 u64Bytes 292 func "decodeS8" decodeS8 s8Bytes 293 func "decodeS16" decodeS16 s16Bytes 294 func "decodeS32" decodeS32 s32Bytes 295 func "decodeS64" decodeS64 s64Bytes 296 func "decodeBigSize" decodeBigSize bigSizeBytes 297 298 -- TLV operations ------------------------------------------------------------ 299 300 wgroup "TLV Encoding" $ do 301 func "encodeTlvRecord" encodeTlvRecord tlvRecord1 302 func "encodeTlvStream/1-record" encodeTlvStream tlvStream1 303 func "encodeTlvStream/5-records" encodeTlvStream tlvStream5 304 func "encodeTlvStream/20-records" encodeTlvStream tlvStream20 305 306 wgroup "TLV Decoding" $ do 307 func "decodeTlvStreamRaw/1-record" decodeTlvStreamRaw tlvStreamBytes1 308 func "decodeTlvStreamRaw/5-records" decodeTlvStreamRaw tlvStreamBytes5 309 func "decodeTlvStreamRaw/20-records" decodeTlvStreamRaw tlvStreamBytes20 310 func "decodeTlvStream/1-record" decodeTlvStream tlvStreamBytes1 311 func "decodeTlvStream/5-records" decodeTlvStream tlvStreamBytes5 312 313 -- Message encoders ---------------------------------------------------------- 314 315 wgroup "Message Encoders" $ do 316 func "encodeInit/minimal" encodeInit minimalInit 317 func "encodeInit/with-features" encodeInit initWithFeatures 318 func "encodeInit/with-tlvs" encodeInit initWithTlvs 319 func "encodeError" encodeError errorMsg 320 func "encodeWarning" encodeWarning warningMsg 321 func "encodePing/minimal" encodePing pingMinimal 322 func "encodePing/with-padding" encodePing pingWithPadding 323 func "encodePong" encodePong pongMsg 324 func "encodePeerStorage" encodePeerStorage peerStorageMsg 325 func "encodePeerStorageRetrieval" encodePeerStorageRetrieval 326 peerStorageRetrievalMsg 327 328 -- Message decoders ---------------------------------------------------------- 329 330 wgroup "Message Decoders" $ do 331 func "decodeInit/minimal" decodeInit initMinimalBytes 332 func "decodeInit/with-tlvs" decodeInit initWithTlvsBytes 333 func "decodeError" decodeError errorBytes 334 func "decodeWarning" decodeWarning warningBytes 335 func "decodePing/minimal" decodePing pingMinimalBytes 336 func "decodePing/with-padding" decodePing pingWithPaddingBytes 337 func "decodePong" decodePong pongBytes 338 func "decodePeerStorage" decodePeerStorage peerStorageBytes 339 func "decodePeerStorageRetrieval" decodePeerStorageRetrieval 340 peerStorageRetrievalBytes 341 342 -- Envelope operations ------------------------------------------------------- 343 344 wgroup "Envelope Operations" $ do 345 func "encodeEnvelope/init" (flip encodeEnvelope Nothing) initMessage 346 func "encodeEnvelope/ping" (flip encodeEnvelope Nothing) pingMessage 347 func "decodeEnvelope" decodeEnvelope envelopeBytes