Main.hs (15541B)
1 {-# LANGUAGE BangPatterns #-} 2 {-# LANGUAGE OverloadedStrings #-} 3 4 module Main where 5 6 import Criterion.Main 7 import qualified Data.ByteString as BS 8 import Data.Word (Word16, Word32, Word64) 9 import Data.Int (Int8, Int16, Int32, Int64) 10 import Lightning.Protocol.BOLT1 11 import Lightning.Protocol.BOLT1.Codec 12 import Lightning.Protocol.BOLT1.TLV (encodeInitTlvs, encodeTlvRecord, parseInitTlvs) 13 14 -- Fixtures -------------------------------------------------------------------- 15 16 -- Prevent constant folding by marking fixtures as NOINLINE. 17 18 {-# NOINLINE u16Val #-} 19 u16Val :: Word16 20 u16Val = 0x1234 21 22 {-# NOINLINE u32Val #-} 23 u32Val :: Word32 24 u32Val = 0x12345678 25 26 {-# NOINLINE u64Val #-} 27 u64Val :: Word64 28 u64Val = 0x123456789ABCDEF0 29 30 {-# NOINLINE s8Val #-} 31 s8Val :: Int8 32 s8Val = -42 33 34 {-# NOINLINE s16Val #-} 35 s16Val :: Int16 36 s16Val = -1234 37 38 {-# NOINLINE s32Val #-} 39 s32Val :: Int32 40 s32Val = -12345678 41 42 {-# NOINLINE s64Val #-} 43 s64Val :: Int64 44 s64Val = -123456789012345 45 46 -- Truncated values 47 48 {-# NOINLINE tu16Zero #-} 49 tu16Zero :: Word16 50 tu16Zero = 0 51 52 {-# NOINLINE tu16Small #-} 53 tu16Small :: Word16 54 tu16Small = 0x42 55 56 {-# NOINLINE tu16Max #-} 57 tu16Max :: Word16 58 tu16Max = 0xFFFF 59 60 {-# NOINLINE tu32Zero #-} 61 tu32Zero :: Word32 62 tu32Zero = 0 63 64 {-# NOINLINE tu32Small #-} 65 tu32Small :: Word32 66 tu32Small = 0x42 67 68 {-# NOINLINE tu32Max #-} 69 tu32Max :: Word32 70 tu32Max = 0xFFFFFFFF 71 72 {-# NOINLINE tu64Zero #-} 73 tu64Zero :: Word64 74 tu64Zero = 0 75 76 {-# NOINLINE tu64Small #-} 77 tu64Small :: Word64 78 tu64Small = 0x42 79 80 {-# NOINLINE tu64Max #-} 81 tu64Max :: Word64 82 tu64Max = 0xFFFFFFFFFFFFFFFF 83 84 -- MinSigned values 85 86 {-# NOINLINE ms0 #-} 87 ms0 :: Int64 88 ms0 = 0 89 90 {-# NOINLINE ms127 #-} 91 ms127 :: Int64 92 ms127 = 127 93 94 {-# NOINLINE ms128 #-} 95 ms128 :: Int64 96 ms128 = 128 97 98 {-# NOINLINE msNeg128 #-} 99 msNeg128 :: Int64 100 msNeg128 = -128 101 102 {-# NOINLINE msNeg129 #-} 103 msNeg129 :: Int64 104 msNeg129 = -129 105 106 -- BigSize values 107 108 {-# NOINLINE bs0 #-} 109 bs0 :: Word64 110 bs0 = 0 111 112 {-# NOINLINE bs252 #-} 113 bs252 :: Word64 114 bs252 = 252 115 116 {-# NOINLINE bs253 #-} 117 bs253 :: Word64 118 bs253 = 253 119 120 {-# NOINLINE bs65535 #-} 121 bs65535 :: Word64 122 bs65535 = 65535 123 124 {-# NOINLINE bs65536 #-} 125 bs65536 :: Word64 126 bs65536 = 65536 127 128 {-# NOINLINE bsLarge #-} 129 bsLarge :: Word64 130 bsLarge = 0x100000000 131 132 -- Encoded bytes for decode benchmarks 133 134 {-# NOINLINE encodedU16 #-} 135 encodedU16 :: BS.ByteString 136 encodedU16 = encodeU16 u16Val 137 138 {-# NOINLINE encodedU32 #-} 139 encodedU32 :: BS.ByteString 140 encodedU32 = encodeU32 u32Val 141 142 {-# NOINLINE encodedU64 #-} 143 encodedU64 :: BS.ByteString 144 encodedU64 = encodeU64 u64Val 145 146 {-# NOINLINE encodedS8 #-} 147 encodedS8 :: BS.ByteString 148 encodedS8 = encodeS8 s8Val 149 150 {-# NOINLINE encodedS16 #-} 151 encodedS16 :: BS.ByteString 152 encodedS16 = encodeS16 s16Val 153 154 {-# NOINLINE encodedS32 #-} 155 encodedS32 :: BS.ByteString 156 encodedS32 = encodeS32 s32Val 157 158 {-# NOINLINE encodedS64 #-} 159 encodedS64 :: BS.ByteString 160 encodedS64 = encodeS64 s64Val 161 162 {-# NOINLINE encodedTu16Small #-} 163 encodedTu16Small :: BS.ByteString 164 encodedTu16Small = encodeTu16 tu16Small 165 166 {-# NOINLINE encodedTu32Small #-} 167 encodedTu32Small :: BS.ByteString 168 encodedTu32Small = encodeTu32 tu32Small 169 170 {-# NOINLINE encodedTu64Small #-} 171 encodedTu64Small :: BS.ByteString 172 encodedTu64Small = encodeTu64 tu64Small 173 174 {-# NOINLINE encodedMs127 #-} 175 encodedMs127 :: BS.ByteString 176 encodedMs127 = encodeMinSigned ms127 177 178 {-# NOINLINE encodedMsNeg129 #-} 179 encodedMsNeg129 :: BS.ByteString 180 encodedMsNeg129 = encodeMinSigned msNeg129 181 182 {-# NOINLINE encodedBs0 #-} 183 encodedBs0 :: BS.ByteString 184 encodedBs0 = encodeBigSize bs0 185 186 {-# NOINLINE encodedBs253 #-} 187 encodedBs253 :: BS.ByteString 188 encodedBs253 = encodeBigSize bs253 189 190 {-# NOINLINE encodedBs65536 #-} 191 encodedBs65536 :: BS.ByteString 192 encodedBs65536 = encodeBigSize bs65536 193 194 {-# NOINLINE encodedBsLarge #-} 195 encodedBsLarge :: BS.ByteString 196 encodedBsLarge = encodeBigSize bsLarge 197 198 -- TLV fixtures 199 200 {-# NOINLINE tlvRec1 #-} 201 tlvRec1 :: TlvRecord 202 tlvRec1 = TlvRecord 1 "test" 203 204 {-# NOINLINE tlvRec3 #-} 205 tlvRec3 :: TlvRecord 206 tlvRec3 = TlvRecord 3 "addr" 207 208 {-# NOINLINE tlvRec5 #-} 209 tlvRec5 :: TlvRecord 210 tlvRec5 = TlvRecord 5 "value" 211 212 {-# NOINLINE tlvStream1 #-} 213 tlvStream1 :: TlvStream 214 tlvStream1 = unsafeTlvStream [tlvRec1] 215 216 {-# NOINLINE tlvStream5 #-} 217 tlvStream5 :: TlvStream 218 tlvStream5 = unsafeTlvStream 219 [ TlvRecord 1 "one" 220 , TlvRecord 3 "three" 221 , TlvRecord 5 "five" 222 , TlvRecord 7 "seven" 223 , TlvRecord 9 "nine" 224 ] 225 226 {-# NOINLINE tlvStream20 #-} 227 tlvStream20 :: TlvStream 228 tlvStream20 = unsafeTlvStream 229 [ TlvRecord (2*i + 1) (BS.replicate 10 (fromIntegral i)) 230 | i <- [0..19] 231 ] 232 233 {-# NOINLINE encodedTlvStream1 #-} 234 encodedTlvStream1 :: BS.ByteString 235 encodedTlvStream1 = encodeTlvStream tlvStream1 236 237 {-# NOINLINE encodedTlvStream5 #-} 238 encodedTlvStream5 :: BS.ByteString 239 encodedTlvStream5 = encodeTlvStream tlvStream5 240 241 {-# NOINLINE encodedTlvStream20 #-} 242 encodedTlvStream20 :: BS.ByteString 243 encodedTlvStream20 = encodeTlvStream tlvStream20 244 245 -- Init TLV fixtures 246 247 {-# NOINLINE chainHash1 #-} 248 chainHash1 :: ChainHash 249 chainHash1 = case chainHash (BS.replicate 32 0x01) of 250 Just ch -> ch 251 Nothing -> error "impossible" 252 253 {-# NOINLINE initTlvNetworks #-} 254 initTlvNetworks :: [InitTlv] 255 initTlvNetworks = [InitNetworks [chainHash1]] 256 257 {-# NOINLINE initTlvRemoteAddr #-} 258 initTlvRemoteAddr :: [InitTlv] 259 initTlvRemoteAddr = [InitRemoteAddr "127.0.0.1"] 260 261 {-# NOINLINE encodedInitTlvs #-} 262 encodedInitTlvs :: BS.ByteString 263 encodedInitTlvs = encodeTlvStream (encodeInitTlvs initTlvNetworks) 264 265 -- Message fixtures 266 267 {-# NOINLINE initMinimal #-} 268 initMinimal :: Init 269 initMinimal = Init BS.empty BS.empty [] 270 271 {-# NOINLINE initWithTlvs #-} 272 initWithTlvs :: Init 273 initWithTlvs = Init (BS.pack [0x00, 0x01]) (BS.pack [0x02, 0x03]) initTlvNetworks 274 275 {-# NOINLINE errorMinimal #-} 276 errorMinimal :: Error 277 errorMinimal = Error allChannels BS.empty 278 279 {-# NOINLINE errorWithData #-} 280 errorWithData :: Error 281 errorWithData = Error allChannels "Connection reset by peer" 282 283 {-# NOINLINE warningMsg #-} 284 warningMsg :: Warning 285 warningMsg = Warning allChannels "Low disk space" 286 287 {-# NOINLINE pingMinimal #-} 288 pingMinimal :: Ping 289 pingMinimal = Ping 64 BS.empty 290 291 {-# NOINLINE pingWithPadding #-} 292 pingWithPadding :: Ping 293 pingWithPadding = Ping 64 (BS.replicate 64 0x00) 294 295 {-# NOINLINE pongMsg #-} 296 pongMsg :: Pong 297 pongMsg = Pong (BS.replicate 64 0x00) 298 299 {-# NOINLINE peerStorageMsg #-} 300 peerStorageMsg :: PeerStorage 301 peerStorageMsg = PeerStorage (BS.replicate 100 0xAB) 302 303 {-# NOINLINE peerStorageRetMsg #-} 304 peerStorageRetMsg :: PeerStorageRetrieval 305 peerStorageRetMsg = PeerStorageRetrieval (BS.replicate 100 0xCD) 306 307 -- Encoded messages for decode benchmarks 308 309 {-# NOINLINE encodedInitMinimal #-} 310 encodedInitMinimal :: BS.ByteString 311 encodedInitMinimal = case encodeInit initMinimal of 312 Right bs -> bs 313 Left _ -> error "impossible" 314 315 {-# NOINLINE encodedInitWithTlvs #-} 316 encodedInitWithTlvs :: BS.ByteString 317 encodedInitWithTlvs = case encodeInit initWithTlvs of 318 Right bs -> bs 319 Left _ -> error "impossible" 320 321 {-# NOINLINE encodedErrorMinimal #-} 322 encodedErrorMinimal :: BS.ByteString 323 encodedErrorMinimal = case encodeError errorMinimal of 324 Right bs -> bs 325 Left _ -> error "impossible" 326 327 {-# NOINLINE encodedErrorWithData #-} 328 encodedErrorWithData :: BS.ByteString 329 encodedErrorWithData = case encodeError errorWithData of 330 Right bs -> bs 331 Left _ -> error "impossible" 332 333 {-# NOINLINE encodedWarning #-} 334 encodedWarning :: BS.ByteString 335 encodedWarning = case encodeWarning warningMsg of 336 Right bs -> bs 337 Left _ -> error "impossible" 338 339 {-# NOINLINE encodedPingMinimal #-} 340 encodedPingMinimal :: BS.ByteString 341 encodedPingMinimal = case encodePing pingMinimal of 342 Right bs -> bs 343 Left _ -> error "impossible" 344 345 {-# NOINLINE encodedPingWithPadding #-} 346 encodedPingWithPadding :: BS.ByteString 347 encodedPingWithPadding = case encodePing pingWithPadding of 348 Right bs -> bs 349 Left _ -> error "impossible" 350 351 {-# NOINLINE encodedPong #-} 352 encodedPong :: BS.ByteString 353 encodedPong = case encodePong pongMsg of 354 Right bs -> bs 355 Left _ -> error "impossible" 356 357 {-# NOINLINE encodedPeerStorage #-} 358 encodedPeerStorage :: BS.ByteString 359 encodedPeerStorage = case encodePeerStorage peerStorageMsg of 360 Right bs -> bs 361 Left _ -> error "impossible" 362 363 {-# NOINLINE encodedPeerStorageRet #-} 364 encodedPeerStorageRet :: BS.ByteString 365 encodedPeerStorageRet = case encodePeerStorageRetrieval peerStorageRetMsg of 366 Right bs -> bs 367 Left _ -> error "impossible" 368 369 -- Envelope fixtures 370 371 {-# NOINLINE msgInit #-} 372 msgInit :: Message 373 msgInit = MsgInitVal initMinimal 374 375 {-# NOINLINE msgPing #-} 376 msgPing :: Message 377 msgPing = MsgPingVal pingMinimal 378 379 {-# NOINLINE encodedEnvelopeNoExt #-} 380 encodedEnvelopeNoExt :: BS.ByteString 381 encodedEnvelopeNoExt = case encodeEnvelope msgPing Nothing of 382 Right bs -> bs 383 Left _ -> error "impossible" 384 385 {-# NOINLINE encodedEnvelopeWithExt #-} 386 encodedEnvelopeWithExt :: BS.ByteString 387 encodedEnvelopeWithExt = case encodeEnvelope msgPing (Just tlvStream5) of 388 Right bs -> bs 389 Left _ -> error "impossible" 390 391 -- Main ------------------------------------------------------------------------ 392 393 main :: IO () 394 main = defaultMain 395 [ bgroup "prim/encode" 396 [ bench "encodeU16" $ whnf encodeU16 u16Val 397 , bench "encodeU32" $ whnf encodeU32 u32Val 398 , bench "encodeU64" $ whnf encodeU64 u64Val 399 , bench "encodeS8" $ whnf encodeS8 s8Val 400 , bench "encodeS16" $ whnf encodeS16 s16Val 401 , bench "encodeS32" $ whnf encodeS32 s32Val 402 , bench "encodeS64" $ whnf encodeS64 s64Val 403 , bench "encodeTu16/0" $ whnf encodeTu16 tu16Zero 404 , bench "encodeTu16/small" $ whnf encodeTu16 tu16Small 405 , bench "encodeTu16/max" $ whnf encodeTu16 tu16Max 406 , bench "encodeTu32/0" $ whnf encodeTu32 tu32Zero 407 , bench "encodeTu32/small" $ whnf encodeTu32 tu32Small 408 , bench "encodeTu32/max" $ whnf encodeTu32 tu32Max 409 , bench "encodeTu64/0" $ whnf encodeTu64 tu64Zero 410 , bench "encodeTu64/small" $ whnf encodeTu64 tu64Small 411 , bench "encodeTu64/max" $ whnf encodeTu64 tu64Max 412 , bench "encodeMinSigned/0" $ whnf encodeMinSigned ms0 413 , bench "encodeMinSigned/127" $ whnf encodeMinSigned ms127 414 , bench "encodeMinSigned/128" $ whnf encodeMinSigned ms128 415 , bench "encodeMinSigned/-128" $ whnf encodeMinSigned msNeg128 416 , bench "encodeMinSigned/-129" $ whnf encodeMinSigned msNeg129 417 , bench "encodeBigSize/0" $ whnf encodeBigSize bs0 418 , bench "encodeBigSize/252" $ whnf encodeBigSize bs252 419 , bench "encodeBigSize/253" $ whnf encodeBigSize bs253 420 , bench "encodeBigSize/65535" $ whnf encodeBigSize bs65535 421 , bench "encodeBigSize/65536" $ whnf encodeBigSize bs65536 422 , bench "encodeBigSize/large" $ whnf encodeBigSize bsLarge 423 ] 424 425 , bgroup "prim/decode" 426 [ bench "decodeU16" $ nf decodeU16 encodedU16 427 , bench "decodeU32" $ nf decodeU32 encodedU32 428 , bench "decodeU64" $ nf decodeU64 encodedU64 429 , bench "decodeS8" $ nf decodeS8 encodedS8 430 , bench "decodeS16" $ nf decodeS16 encodedS16 431 , bench "decodeS32" $ nf decodeS32 encodedS32 432 , bench "decodeS64" $ nf decodeS64 encodedS64 433 , bench "decodeTu16" $ nf (decodeTu16 1) encodedTu16Small 434 , bench "decodeTu32" $ nf (decodeTu32 1) encodedTu32Small 435 , bench "decodeTu64" $ nf (decodeTu64 1) encodedTu64Small 436 , bench "decodeMinSigned/1" $ nf (decodeMinSigned 1) encodedMs127 437 , bench "decodeMinSigned/2" $ nf (decodeMinSigned 2) encodedMsNeg129 438 , bench "decodeBigSize/0" $ nf decodeBigSize encodedBs0 439 , bench "decodeBigSize/253" $ nf decodeBigSize encodedBs253 440 , bench "decodeBigSize/65536" $ nf decodeBigSize encodedBs65536 441 , bench "decodeBigSize/large" $ nf decodeBigSize encodedBsLarge 442 ] 443 444 , bgroup "tlv/encode" 445 [ bench "encodeTlvRecord" $ whnf encodeTlvRecord tlvRec1 446 , bench "encodeTlvStream/1" $ whnf encodeTlvStream tlvStream1 447 , bench "encodeTlvStream/5" $ whnf encodeTlvStream tlvStream5 448 , bench "encodeTlvStream/20" $ whnf encodeTlvStream tlvStream20 449 , bench "encodeInitTlvs" $ nf encodeInitTlvs initTlvNetworks 450 ] 451 452 , bgroup "tlv/decode" 453 [ bench "decodeTlvStreamRaw/1" $ nf decodeTlvStreamRaw encodedTlvStream1 454 , bench "decodeTlvStreamRaw/5" $ nf decodeTlvStreamRaw encodedTlvStream5 455 , bench "decodeTlvStreamRaw/20" $ nf decodeTlvStreamRaw encodedTlvStream20 456 , bench "decodeTlvStream" $ nf decodeTlvStream encodedInitTlvs 457 , bench "decodeTlvStreamWith" $ 458 nf (decodeTlvStreamWith (const True)) encodedTlvStream5 459 , bench "parseInitTlvs" $ 460 nf parseInitTlvs (encodeInitTlvs initTlvNetworks) 461 ] 462 463 , bgroup "message/encode" 464 [ bench "encodeInit/minimal" $ nf encodeInit initMinimal 465 , bench "encodeInit/with-tlvs" $ nf encodeInit initWithTlvs 466 , bench "encodeError/minimal" $ nf encodeError errorMinimal 467 , bench "encodeError/with-data" $ nf encodeError errorWithData 468 , bench "encodeWarning" $ nf encodeWarning warningMsg 469 , bench "encodePing/minimal" $ nf encodePing pingMinimal 470 , bench "encodePing/with-padding" $ nf encodePing pingWithPadding 471 , bench "encodePong" $ nf encodePong pongMsg 472 , bench "encodePeerStorage" $ nf encodePeerStorage peerStorageMsg 473 , bench "encodePeerStorageRetrieval" $ 474 nf encodePeerStorageRetrieval peerStorageRetMsg 475 ] 476 477 , bgroup "message/decode" 478 [ bench "decodeInit/minimal" $ nf decodeInit encodedInitMinimal 479 , bench "decodeInit/with-tlvs" $ nf decodeInit encodedInitWithTlvs 480 , bench "decodeError/minimal" $ nf decodeError encodedErrorMinimal 481 , bench "decodeError/with-data" $ nf decodeError encodedErrorWithData 482 , bench "decodeWarning" $ nf decodeWarning encodedWarning 483 , bench "decodePing/minimal" $ nf decodePing encodedPingMinimal 484 , bench "decodePing/with-padding" $ nf decodePing encodedPingWithPadding 485 , bench "decodePong" $ nf decodePong encodedPong 486 , bench "decodePeerStorage" $ nf decodePeerStorage encodedPeerStorage 487 , bench "decodePeerStorageRetrieval" $ 488 nf decodePeerStorageRetrieval encodedPeerStorageRet 489 ] 490 491 , bgroup "envelope" 492 [ bench "encodeEnvelope/no-ext" $ nf (encodeEnvelope msgPing) Nothing 493 , bench "encodeEnvelope/with-ext" $ 494 nf (encodeEnvelope msgPing) (Just tlvStream5) 495 , bench "decodeEnvelope/no-ext" $ nf decodeEnvelope encodedEnvelopeNoExt 496 , bench "decodeEnvelope/with-ext" $ 497 nf decodeEnvelope encodedEnvelopeWithExt 498 , bench "decodeEnvelopeWith" $ 499 nf (decodeEnvelopeWith (const True)) encodedEnvelopeWithExt 500 ] 501 502 , bgroup "roundtrip" 503 [ bench "init/minimal" $ nf (decodeInit . forceRight . encodeInit) 504 initMinimal 505 , bench "init/with-tlvs" $ nf (decodeInit . forceRight . encodeInit) 506 initWithTlvs 507 , bench "error" $ nf (decodeError . forceRight . encodeError) errorWithData 508 , bench "warning" $ nf (decodeWarning . forceRight . encodeWarning) 509 warningMsg 510 , bench "ping" $ nf (decodePing . forceRight . encodePing) pingWithPadding 511 , bench "pong" $ nf (decodePong . forceRight . encodePong) pongMsg 512 , bench "peer-storage" $ 513 nf (decodePeerStorage . forceRight . encodePeerStorage) peerStorageMsg 514 , bench "peer-storage-retrieval" $ 515 nf (decodePeerStorageRetrieval . forceRight . encodePeerStorageRetrieval) 516 peerStorageRetMsg 517 , bench "envelope" $ nf 518 (decodeEnvelope . forceRight . encodeEnvelope msgPing) (Just tlvStream5) 519 ] 520 ] 521 522 -- Helper for roundtrip benchmarks 523 forceRight :: Either a b -> b 524 forceRight (Right b) = b 525 forceRight (Left _) = error "forceRight: Left" 526 {-# INLINE forceRight #-}