Main.hs (30587B)
1 {-# LANGUAGE OverloadedStrings #-} 2 3 module Main where 4 5 import qualified Crypto.AEAD.ChaCha20Poly1305 as AEAD 6 import qualified Crypto.Hash.SHA256 as SHA256 7 import qualified Crypto.KDF.HMAC as HKDF 8 import Data.Bits (shiftR, xor) 9 import qualified Data.ByteString as BS 10 import qualified Data.ByteString.Base16 as B16 11 import Data.Maybe (isJust, isNothing) 12 import Data.Word (Word64) 13 import qualified Lightning.Protocol.BOLT8 as BOLT8 14 import Test.Tasty 15 import Test.Tasty.HUnit 16 import qualified Test.Tasty.QuickCheck as Q 17 18 main :: IO () 19 main = defaultMain $ testGroup "ppad-bolt8" [ 20 key_tests 21 , handshake_tests 22 , handshake_failure_tests 23 , message_tests 24 , transport_tests 25 , transport_failure_tests 26 , property_tests 27 ] 28 29 -- helpers -------------------------------------------------------------------- 30 31 expect_just :: String -> Maybe a -> IO a 32 expect_just msg = maybe (assertFailure msg) pure 33 34 expect_right :: Show e => String -> Either e a -> IO a 35 expect_right msg = either (\e -> assertFailure (msg <> ": " <> show e)) pure 36 37 -- assert failure with a specific error 38 expect_error :: String -> BOLT8.Error -> Either BOLT8.Error a -> Assertion 39 expect_error msg want r = case r of 40 Left got -> assertEqual msg want got 41 Right _ -> assertFailure (msg <> ": expected " <> show want) 42 43 -- decode a hex literal, failing the test if it is malformed 44 unhex :: BS.ByteString -> IO BS.ByteString 45 unhex h = expect_just ("invalid hex: " <> show h) (B16.decode h) 46 47 -- total lookup 48 at :: Int -> [a] -> Maybe a 49 at i xs = case drop i xs of 50 (x : _) | i >= 0 -> Just x 51 _ -> Nothing 52 53 -- flip all bits of the byte at the given index 54 flip_byte :: Int -> BS.ByteString -> IO BS.ByteString 55 flip_byte i bs 56 | i < 0 || i >= BS.length bs = 57 assertFailure ("flip_byte: index out of bounds: " <> show i) 58 | otherwise = 59 let (pre, post) = BS.splitAt i bs 60 in pure (pre <> BS.map (xor 0xff) (BS.take 1 post) <> BS.drop 1 post) 61 62 -- payload for the m'th message of a test stream 63 payload :: Int -> BS.ByteString 64 payload m = BS.replicate (m `mod` 7) (fromIntegral m) 65 66 -- Appendix A key material ---------------------------------------------------- 67 68 ls_i_sec, e_i_sec, ls_r_sec, e_r_sec :: BS.ByteString 69 ls_i_sec = BS.replicate 32 0x11 70 e_i_sec = BS.replicate 32 0x12 71 ls_r_sec = BS.replicate 32 0x21 72 e_r_sec = BS.replicate 32 0x22 73 74 ls_i_pub, ls_r_pub, e_i_pub, e_r_pub :: BS.ByteString 75 ls_i_pub = 76 "034f355bdcb7cc0af728ef3cceb9615d90684bb5b2ca5f859ab0f0b704075871aa" 77 ls_r_pub = 78 "028d7500dd4c12685d1f568b4c2b5048e8534b873319f3a8daa612b469132ec7f7" 79 e_i_pub = 80 "036360e856310ce5d294e8be33fc807077dc56ac80d95d9cd4ddbd21325eff73f7" 81 e_r_pub = 82 "02466d7fcae563e5cb09a0d1870bb580344804617879a14949cf22285f1bae3f27" 83 84 act1_msg, act2_msg, act3_msg :: BS.ByteString 85 act1_msg = 86 "00036360e856310ce5d294e8be33fc807077dc56ac80d95d9cd4ddbd21325eff73f7\ 87 \0df6086551151f58b8afe6c195782c6a" 88 act2_msg = 89 "0002466d7fcae563e5cb09a0d1870bb580344804617879a14949cf22285f1bae3f27\ 90 \6e2470b93aac583c9ef6eafca3f730ae" 91 act3_msg = 92 "00b9e3a702e93e3a9948c2ed6e5fd7590a6e1c3a0344cfc9d5b57357049aa22355\ 93 \361aa02e55a8fc28fef5bd6d71ad0c38228dc68b1c466263b47fdf31e560e139ba" 94 95 -- final chaining key, and the initiator's sending and receiving keys 96 -- (the responder's are swapped) 97 final_ck, final_sk, final_rk :: BS.ByteString 98 final_ck = 99 "919219dbb2920afa8db80f9a51787a840bcf111ed8d588caf9ab4be716e42b01" 100 final_sk = 101 "969ab31b4d288cedf6218839b27a3e2140827047f2c0f01bf5c04435d43511a9" 102 final_rk = 103 "bb9020b8965f4df047e07f955f3c4b88418984aadc5cdb35096b9ea8fa5c3442" 104 105 spec_keypairs :: IO (BOLT8.Keypair, BOLT8.Keypair) 106 spec_keypairs = do 107 i <- expect_just "initiator keypair" (BOLT8.keypair ls_i_sec) 108 r <- expect_just "responder keypair" (BOLT8.keypair ls_r_sec) 109 pure (i, r) 110 111 -- the Appendix A handshake, as (initiator, responder) results 112 spec_handshake :: Either BOLT8.Error (BOLT8.Handshake, BOLT8.Handshake) 113 spec_handshake = do 114 i <- maybe (Left BOLT8.InvalidEntropy) Right (BOLT8.keypair ls_i_sec) 115 r <- maybe (Left BOLT8.InvalidEntropy) Right (BOLT8.keypair ls_r_sec) 116 handshake i r e_i_sec e_r_sec 117 118 spec_results :: IO (BOLT8.Handshake, BOLT8.Handshake) 119 spec_results = expect_right "spec handshake" spec_handshake 120 121 handshake 122 :: BOLT8.Keypair 123 -> BOLT8.Keypair 124 -> BS.ByteString 125 -> BS.ByteString 126 -> Either BOLT8.Error (BOLT8.Handshake, BOLT8.Handshake) 127 handshake i r i_e r_e = do 128 (msg1, i_hs) <- BOLT8.act1 i (BOLT8.keypair_pub r) i_e 129 (msg2, r_hs) <- BOLT8.act2 r r_e msg1 130 (msg3, i_res) <- BOLT8.act3 i_hs msg2 131 r_res <- BOLT8.finalize r_hs msg3 132 pure (i_res, r_res) 133 134 -- reference transport -------------------------------------------------------- 135 136 -- BOLT #8 framing and rotation built directly on ppad-aead and 137 -- ppad-hkdf, as an independent check of the library's key schedule. 138 139 ref_nonce :: Word64 -> BS.ByteString 140 ref_nonce n = BS.replicate 4 0 <> 141 BS.pack [fromIntegral (n `shiftR` (8 * j)) | j <- [0 .. 7]] 142 143 ref_frame :: BS.ByteString -> Word64 -> BS.ByteString -> IO BS.ByteString 144 ref_frame k n m = do 145 let len = BS.length m 146 l = BS.pack [fromIntegral (len `shiftR` 8), fromIntegral len] 147 (lc, lt) <- expect_right "aead" (AEAD.encrypt mempty k (ref_nonce n) l) 148 (c, t) <- expect_right "aead" (AEAD.encrypt mempty k (ref_nonce (n + 1)) m) 149 pure (lc <> lt <> c <> t) 150 151 -- (ck', k') = HKDF(ck, k) 152 ref_rotate 153 :: BS.ByteString -> BS.ByteString -> IO (BS.ByteString, BS.ByteString) 154 ref_rotate ck k = do 155 out <- expect_just "hkdf" (HKDF.derive hmac ck mempty 64 k) 156 pure (BS.splitAt 32 out) 157 where 158 hmac a b = case SHA256.hmac a b of SHA256.MAC mac -> mac 159 160 -- frames carrying 'payload' 0 .. count - 1, sent under key k and 161 -- chaining key ck 162 ref_stream :: BS.ByteString -> BS.ByteString -> Int -> IO [BS.ByteString] 163 ref_stream = go 0 0 164 where 165 go m n ck k count 166 | m == count = pure [] 167 | n >= 1000 = do 168 (ck', k') <- ref_rotate ck k 169 go m 0 ck' k' count 170 | otherwise = do 171 f <- ref_frame k n (payload m) 172 fs <- go (m + 1) (n + 2) ck k count 173 pure (f : fs) 174 175 -- assert that a Sender encrypts under key k with chaining key ck, 176 -- across two rotations 177 check_sender :: BS.ByteString -> BS.ByteString -> BOLT8.Sender -> Assertion 178 check_sender ck k s0 = do 179 ref <- ref_stream ck k 1002 180 let go _ _ [] = pure () 181 go m s (f : fs) = do 182 (ct, s') <- expect_right "encrypt" (BOLT8.encrypt s (payload m)) 183 assertEqual ("frame " <> show m) f ct 184 go (m + 1) s' fs 185 go (0 :: Int) s0 ref 186 187 -- assert that a Receiver decrypts under key k with chaining key ck, 188 -- across two rotations 189 check_receiver 190 :: BS.ByteString -> BS.ByteString -> BOLT8.Receiver -> Assertion 191 check_receiver ck k r0 = do 192 ref <- ref_stream ck k 1002 193 let go _ _ [] = pure () 194 go m r (f : fs) = do 195 (pt, r') <- expect_right ("decrypt " <> show m) (BOLT8.decrypt r f) 196 assertEqual ("message " <> show m) (payload m) pt 197 go (m + 1) r' fs 198 go (0 :: Int) r0 ref 199 200 -- send 'payload' 0 .. count - 1 from a Sender to a Receiver 201 round_trip :: Int -> BOLT8.Sender -> BOLT8.Receiver -> Assertion 202 round_trip count = go 0 203 where 204 go m s r 205 | m == count = pure () 206 | otherwise = do 207 (ct, s') <- expect_right "encrypt" (BOLT8.encrypt s (payload m)) 208 (pt, r') <- expect_right ("decrypt " <> show m) (BOLT8.decrypt r ct) 209 assertEqual ("message " <> show m) (payload m) pt 210 go (m + 1) s' r' 211 212 -- keys ----------------------------------------------------------------------- 213 214 -- 32-byte strings (and one short one) that are not valid secret keys 215 invalid_secrets :: IO [(String, BS.ByteString)] 216 invalid_secrets = do 217 n <- unhex 218 "fffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364141" 219 pure [ 220 ("zero", BS.replicate 32 0) 221 , ("order", n) 222 , ("2^256 - 1", BS.replicate 32 0xff) 223 , ("31 bytes", BS.replicate 31 0x12) 224 ] 225 226 -- 33-byte compressed encodings that are not curve points 227 invalid_points :: IO [(String, BS.ByteString)] 228 invalid_points = do 229 -- x = p + 1 is congruent to 1, which is on the curve, but not < p 230 p_1 <- unhex 231 "fffffffffffffffffffffffffffffffffffffffffffffffffffffffefffffc30" 232 pure [ 233 ("x = 0, no square root", BS.cons 0x02 (BS.replicate 32 0)) 234 , ("x = 5, no square root", BS.cons 0x03 (BS.replicate 31 0 <> "\x05")) 235 , ("x = p + 1", BS.cons 0x02 p_1) 236 ] 237 238 -- replace the 33-byte key in a 50-byte act one or act two message 239 with_key :: BS.ByteString -> BS.ByteString -> BS.ByteString 240 with_key pt msg = BS.take 1 msg <> pt <> BS.drop 34 msg 241 242 key_tests :: TestTree 243 key_tests = testGroup "keys" [ 244 testCase "keypair derives the spec static keys" $ do 245 (i, r) <- spec_keypairs 246 want_i <- unhex ls_i_pub 247 want_r <- unhex ls_r_pub 248 BOLT8.serialize_pub (BOLT8.keypair_pub i) @?= want_i 249 BOLT8.serialize_pub (BOLT8.keypair_pub r) @?= want_r 250 , testCase "keypair rejects invalid secrets" $ do 251 n <- unhex 252 "fffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364141" 253 n_1 <- unhex 254 "fffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364140" 255 assertBool "31 bytes" (isNothing (BOLT8.keypair (BS.replicate 31 1))) 256 assertBool "33 bytes" (isNothing (BOLT8.keypair (BS.replicate 33 1))) 257 assertBool "zero" (isNothing (BOLT8.keypair (BS.replicate 32 0))) 258 assertBool "order" (isNothing (BOLT8.keypair n)) 259 assertBool "2^256 - 1" (isNothing (BOLT8.keypair (BS.replicate 32 0xff))) 260 assertBool "order - 1" (isJust (BOLT8.keypair n_1)) 261 , testCase "parse_pub round-trips compressed keys" $ do 262 bs <- unhex ls_r_pub 263 pub <- expect_just "parse_pub" (BOLT8.parse_pub bs) 264 BOLT8.serialize_pub pub @?= bs 265 , testCase "parse_pub rejects points off the curve" $ do 266 bad <- invalid_points 267 mapM_ (\(name, pt) -> 268 assertBool name (isNothing (BOLT8.parse_pub pt))) bad 269 , testCase "parse_pub rejects other encodings" $ do 270 -- the generator, uncompressed and x-only 271 g_full <- unhex 272 "0479be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798\ 273 \483ada7726a3c4655da4fbfc0e1108a8fd17b448a68554199c47d08ffb10d4b8" 274 g_x <- unhex 275 "79be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798" 276 bs <- unhex ls_r_pub 277 assertBool "uncompressed" (isNothing (BOLT8.parse_pub g_full)) 278 assertBool "x-only" (isNothing (BOLT8.parse_pub g_x)) 279 assertBool "0x04 prefix" 280 (isNothing (BOLT8.parse_pub (BS.cons 0x04 (BS.drop 1 bs)))) 281 assertBool "34 bytes" (isNothing (BOLT8.parse_pub (bs <> "\x00"))) 282 ] 283 284 -- handshake ------------------------------------------------------------------ 285 286 handshake_tests :: TestTree 287 handshake_tests = testGroup "handshake" [ 288 testCase "act one matches spec" $ do 289 (i, _) <- spec_keypairs 290 rs <- unhex ls_r_pub >>= expect_just "rs" . BOLT8.parse_pub 291 (msg1, _) <- expect_right "act1" (BOLT8.act1 i rs e_i_sec) 292 want <- unhex act1_msg 293 e <- unhex e_i_pub 294 msg1 @?= want 295 BS.take 33 (BS.drop 1 msg1) @?= e 296 , testCase "act two matches spec" $ do 297 (_, r) <- spec_keypairs 298 msg1 <- unhex act1_msg 299 (msg2, _) <- expect_right "act2" (BOLT8.act2 r e_r_sec msg1) 300 want <- unhex act2_msg 301 e <- unhex e_r_pub 302 msg2 @?= want 303 BS.take 33 (BS.drop 1 msg2) @?= e 304 , testCase "act three matches spec" $ do 305 (i, r) <- spec_keypairs 306 (_, i_hs) <- expect_right "act1" 307 (BOLT8.act1 i (BOLT8.keypair_pub r) e_i_sec) 308 msg2 <- unhex act2_msg 309 (msg3, _) <- expect_right "act3" (BOLT8.act3 i_hs msg2) 310 want <- unhex act3_msg 311 msg3 @?= want 312 , testCase "finalize accepts spec act three" $ do 313 (_, r) <- spec_keypairs 314 msg1 <- unhex act1_msg 315 msg3 <- unhex act3_msg 316 (_, r_hs) <- expect_right "act2" (BOLT8.act2 r e_r_sec msg1) 317 r_res <- expect_right "finalize" (BOLT8.finalize r_hs msg3) 318 want <- unhex ls_i_pub 319 BOLT8.serialize_pub (BOLT8.handshake_remote_static r_res) @?= want 320 , testCase "act1 rejects invalid entropy" $ do 321 (i, r) <- spec_keypairs 322 let rs = BOLT8.keypair_pub r 323 bad <- invalid_secrets 324 mapM_ (\(name, e) -> expect_error name BOLT8.InvalidEntropy 325 (BOLT8.act1 i rs e)) bad 326 , testCase "act2 rejects invalid entropy" $ do 327 (_, r) <- spec_keypairs 328 msg1 <- unhex act1_msg 329 bad <- invalid_secrets 330 mapM_ (\(name, e) -> expect_error name BOLT8.InvalidEntropy 331 (BOLT8.act2 r e msg1)) bad 332 , testCase "act2 rejects an ephemeral key off the curve" $ do 333 (_, r) <- spec_keypairs 334 msg1 <- unhex act1_msg 335 bad <- invalid_points 336 mapM_ (\(name, pt) -> expect_error name BOLT8.InvalidPub 337 (BOLT8.act2 r e_r_sec (with_key pt msg1))) bad 338 , testCase "act3 rejects an ephemeral key off the curve" $ do 339 (i, r) <- spec_keypairs 340 (_, i_hs) <- expect_right "act1" 341 (BOLT8.act1 i (BOLT8.keypair_pub r) e_i_sec) 342 msg2 <- unhex act2_msg 343 bad <- invalid_points 344 mapM_ (\(name, pt) -> expect_error name BOLT8.InvalidPub 345 (BOLT8.act3 i_hs (with_key pt msg2))) bad 346 , testCase "acts reject oversized input" $ do 347 (i, r) <- spec_keypairs 348 msg1 <- unhex act1_msg 349 msg2 <- unhex act2_msg 350 msg3 <- unhex act3_msg 351 (_, i_hs) <- expect_right "act1" 352 (BOLT8.act1 i (BOLT8.keypair_pub r) e_i_sec) 353 (_, r_hs) <- expect_right "act2" (BOLT8.act2 r e_r_sec msg1) 354 expect_error "act2" BOLT8.InvalidLength 355 (BOLT8.act2 r e_r_sec (msg1 <> "\x00")) 356 expect_error "act3" BOLT8.InvalidLength 357 (BOLT8.act3 i_hs (msg2 <> "\x00")) 358 expect_error "finalize" BOLT8.InvalidLength 359 (BOLT8.finalize r_hs (msg3 <> "\x00")) 360 ] 361 362 -- Appendix A failure vectors ------------------------------------------------- 363 364 data Failure = Failure String BS.ByteString BOLT8.Error 365 366 handshake_failure_tests :: TestTree 367 handshake_failure_tests = testGroup "Appendix A failure vectors" [ 368 testGroup "initiator, act two" (fmap initiator_failure act2_failures) 369 , testGroup "responder, act one" (fmap act1_failure act1_failures) 370 , testGroup "responder, act three" (fmap act3_failure act3_failures) 371 ] 372 373 initiator_failure :: Failure -> TestTree 374 initiator_failure (Failure name input want) = testCase name $ do 375 (i, _) <- spec_keypairs 376 rs <- unhex ls_r_pub >>= expect_just "rs" . BOLT8.parse_pub 377 (msg1, i_hs) <- expect_right "act1" (BOLT8.act1 i rs e_i_sec) 378 unhex act1_msg >>= (msg1 @?=) 379 msg2 <- unhex input 380 expect_error name want (BOLT8.act3 i_hs msg2) 381 382 act1_failure :: Failure -> TestTree 383 act1_failure (Failure name input want) = testCase name $ do 384 (_, r) <- spec_keypairs 385 msg1 <- unhex input 386 expect_error name want (BOLT8.act2 r e_r_sec msg1) 387 388 act3_failure :: Failure -> TestTree 389 act3_failure (Failure name input want) = testCase name $ do 390 (_, r) <- spec_keypairs 391 msg1 <- unhex act1_msg 392 (msg2, r_hs) <- expect_right "act2" (BOLT8.act2 r e_r_sec msg1) 393 unhex act2_msg >>= (msg2 @?=) 394 msg3 <- unhex input 395 expect_error name want (BOLT8.finalize r_hs msg3) 396 397 act2_failures :: [Failure] 398 act2_failures = [ 399 Failure "short read" 400 "0002466d7fcae563e5cb09a0d1870bb580344804617879a14949cf22285f1bae3f27\ 401 \6e2470b93aac583c9ef6eafca3f730" 402 BOLT8.InvalidLength 403 , Failure "bad version" 404 "0102466d7fcae563e5cb09a0d1870bb580344804617879a14949cf22285f1bae3f27\ 405 \6e2470b93aac583c9ef6eafca3f730ae" 406 BOLT8.InvalidVersion 407 , Failure "bad key serialization" 408 "0004466d7fcae563e5cb09a0d1870bb580344804617879a14949cf22285f1bae3f27\ 409 \6e2470b93aac583c9ef6eafca3f730ae" 410 BOLT8.InvalidPub 411 , Failure "bad MAC" 412 "0002466d7fcae563e5cb09a0d1870bb580344804617879a14949cf22285f1bae3f27\ 413 \6e2470b93aac583c9ef6eafca3f730af" 414 BOLT8.InvalidMAC 415 ] 416 417 act1_failures :: [Failure] 418 act1_failures = [ 419 Failure "short read" 420 "00036360e856310ce5d294e8be33fc807077dc56ac80d95d9cd4ddbd21325eff73f7\ 421 \0df6086551151f58b8afe6c195782c" 422 BOLT8.InvalidLength 423 , Failure "bad version" 424 "01036360e856310ce5d294e8be33fc807077dc56ac80d95d9cd4ddbd21325eff73f7\ 425 \0df6086551151f58b8afe6c195782c6a" 426 BOLT8.InvalidVersion 427 , Failure "bad key serialization" 428 "00046360e856310ce5d294e8be33fc807077dc56ac80d95d9cd4ddbd21325eff73f7\ 429 \0df6086551151f58b8afe6c195782c6a" 430 BOLT8.InvalidPub 431 , Failure "bad MAC" 432 "00036360e856310ce5d294e8be33fc807077dc56ac80d95d9cd4ddbd21325eff73f7\ 433 \0df6086551151f58b8afe6c195782c6b" 434 BOLT8.InvalidMAC 435 ] 436 437 act3_failures :: [Failure] 438 act3_failures = [ 439 Failure "bad version" 440 "01b9e3a702e93e3a9948c2ed6e5fd7590a6e1c3a0344cfc9d5b57357049aa22355\ 441 \361aa02e55a8fc28fef5bd6d71ad0c38228dc68b1c466263b47fdf31e560e139ba" 442 BOLT8.InvalidVersion 443 , Failure "short read" 444 "00b9e3a702e93e3a9948c2ed6e5fd7590a6e1c3a0344cfc9d5b57357049aa22355\ 445 \361aa02e55a8fc28fef5bd6d71ad0c38228dc68b1c466263b47fdf31e560e139" 446 BOLT8.InvalidLength 447 , Failure "bad MAC for ciphertext" 448 "00c9e3a702e93e3a9948c2ed6e5fd7590a6e1c3a0344cfc9d5b57357049aa22355\ 449 \361aa02e55a8fc28fef5bd6d71ad0c38228dc68b1c466263b47fdf31e560e139ba" 450 BOLT8.InvalidMAC 451 , Failure "bad rs" 452 "00bfe3a702e93e3a9948c2ed6e5fd7590a6e1c3a0344cfc9d5b57357049aa22355\ 453 \36ad09a8ee351870c2bb7f78b754a26c6cef79a98d25139c856d7efd252c2ae73c" 454 BOLT8.InvalidPub 455 , Failure "bad MAC" 456 "00b9e3a702e93e3a9948c2ed6e5fd7590a6e1c3a0344cfc9d5b57357049aa22355\ 457 \361aa02e55a8fc28fef5bd6d71ad0c38228dc68b1c466263b47fdf31e560e139bb" 458 BOLT8.InvalidMAC 459 ] 460 461 -- message encryption --------------------------------------------------------- 462 463 -- Appendix A message test: "hello" sent 1001 times by the initiator 464 spec_messages :: [(Int, BS.ByteString)] 465 spec_messages = [ 466 (0, "cf2b30ddf0cf3f80e7c35a6e6730b59fe802473180f396d88a8fb0db8cbc\ 467 \f25d2f214cf9ea1d95") 468 , (1, "72887022101f0b6753e0c7de21657d35a4cb2a1f5cde2650528bbc8f837d\ 469 \0f0d7ad833b1a256a1") 470 , (500, "178cb9d7387190fa34db9c2d50027d21793c9bc2d40b1e14dcf30ebeeeb2\ 471 \20f48364f7a4c68bf8") 472 , (501, "1b186c57d44eb6de4c057c49940d79bb838a145cb528d6e8fd26dbe50a60\ 473 \ca2c104b56b60e45bd") 474 , (1000, "4a2f3cc3b5e78ddb83dcb426d9863d9d9a723b0337c89dd0b005d89f8d3c\ 475 \05c52b76b29b740f09") 476 , (1001, "2ecd8c8a5629d0d02ab457a0fdd0f7b90a192cd46be5ecb6ca570bfc5e26\ 477 \8338b1a16cf4ef2d36") 478 ] 479 480 -- the initiator's first n frames, each carrying "hello" 481 hello_stream :: Int -> IO [BS.ByteString] 482 hello_stream count = do 483 (i_res, _) <- spec_results 484 let go m s 485 | m == count = pure [] 486 | otherwise = do 487 (ct, s') <- expect_right "encrypt" (BOLT8.encrypt s "hello") 488 (ct :) <$> go (m + 1) s' 489 go (0 :: Int) (BOLT8.handshake_sender i_res) 490 491 message_tests :: TestTree 492 message_tests = testGroup "messages" [ 493 testGroup "spec vectors" (fmap spec_message spec_messages) 494 , testCase "responder decrypts the spec stream" $ do 495 (_, r_res) <- spec_results 496 frames <- hello_stream 1002 497 let go _ _ [] = pure () 498 go m r (f : fs) = do 499 (pt, r') <- expect_right ("decrypt " <> show m) (BOLT8.decrypt r f) 500 assertEqual ("message " <> show m) "hello" pt 501 go (m + 1) r' fs 502 go (0 :: Int) (BOLT8.handshake_receiver r_res) frames 503 , testCase "reference key rotation matches spec" $ do 504 ck <- unhex final_ck 505 sk <- unhex final_sk 506 ck1 <- unhex 507 "cc2c6e467efc8067720c2d09c139d1f77731893aad1defa14f9bf3c48d3f1d31" 508 k1 <- unhex 509 "3fbdc101abd1132ca3a0ae34a669d8d9ba69a587e0bb4ddd59524541cf4813d8" 510 ck2 <- unhex 511 "728366ed68565dc17cf6dd97330a859a6a56e87e2beef3bd828a4c4a54d8df06" 512 k2 <- unhex 513 "9e0477f9850dca41e42db0e4d154e3a098e5a000d995e421849fcd5df27882bd" 514 ref_rotate ck sk >>= (@?= (ck1, k1)) 515 ref_rotate ck1 k1 >>= (@?= (ck2, k2)) 516 , testCase "initiator sends under sk and ck" $ do 517 (i_res, _) <- spec_results 518 ck <- unhex final_ck 519 sk <- unhex final_sk 520 check_sender ck sk (BOLT8.handshake_sender i_res) 521 , testCase "initiator receives under rk and ck" $ do 522 (i_res, _) <- spec_results 523 ck <- unhex final_ck 524 rk <- unhex final_rk 525 check_receiver ck rk (BOLT8.handshake_receiver i_res) 526 , testCase "responder sends under rk and ck" $ do 527 (_, r_res) <- spec_results 528 ck <- unhex final_ck 529 rk <- unhex final_rk 530 check_sender ck rk (BOLT8.handshake_sender r_res) 531 , testCase "responder receives under sk and ck" $ do 532 (_, r_res) <- spec_results 533 ck <- unhex final_ck 534 sk <- unhex final_sk 535 check_receiver ck sk (BOLT8.handshake_receiver r_res) 536 , testCase "initiator to responder across rotations" $ do 537 (i_res, r_res) <- spec_results 538 round_trip 1600 539 (BOLT8.handshake_sender i_res) (BOLT8.handshake_receiver r_res) 540 , testCase "responder to initiator across rotations" $ do 541 (i_res, r_res) <- spec_results 542 round_trip 1600 543 (BOLT8.handshake_sender r_res) (BOLT8.handshake_receiver i_res) 544 ] 545 546 spec_message :: (Int, BS.ByteString) -> TestTree 547 spec_message (m, h) = testCase ("message " <> show m) $ do 548 frames <- hello_stream 1002 549 got <- expect_just "frame" (at m frames) 550 want <- unhex h 551 got @?= want 552 553 -- transport ------------------------------------------------------------------ 554 555 -- the spec handshake's transport states and the initiator's first two 556 -- frames, carrying "hello" and "world!" 557 transport_fixture 558 :: IO (BOLT8.Sender, BOLT8.Receiver, BOLT8.Receiver, BS.ByteString, 559 BS.ByteString) 560 transport_fixture = do 561 (i_res, r_res) <- spec_results 562 let i_snd = BOLT8.handshake_sender i_res 563 (f0, i_snd') <- expect_right "encrypt" (BOLT8.encrypt i_snd "hello") 564 (f1, _) <- expect_right "encrypt" (BOLT8.encrypt i_snd' "world!") 565 pure ( i_snd, BOLT8.handshake_receiver i_res 566 , BOLT8.handshake_receiver r_res, f0, f1 ) 567 568 -- consume a buffer of frames via decrypt_header and decrypt_body 569 consume 570 :: BOLT8.Receiver 571 -> BS.ByteString 572 -> Either BOLT8.Error [BS.ByteString] 573 consume r buf 574 | BS.null buf = Right [] 575 | otherwise = do 576 let (hdr, rest) = BS.splitAt 18 buf 577 (n, p) <- BOLT8.decrypt_header r hdr 578 let (body, rest') = BS.splitAt n rest 579 (m, r') <- BOLT8.decrypt_body p body 580 (m :) <$> consume r' rest' 581 582 transport_tests :: TestTree 583 transport_tests = testGroup "transport" [ 584 testCase "frame is message length plus 34 bytes" $ do 585 (_, _, _, f0, f1) <- transport_fixture 586 BS.length f0 @?= 5 + 34 587 BS.length f1 @?= 6 + 34 588 , testCase "decrypt_header reports the remaining length" $ do 589 (_, _, r, f0, _) <- transport_fixture 590 (n, _) <- expect_right "header" (BOLT8.decrypt_header r (BS.take 18 f0)) 591 n @?= 5 + 16 592 , testCase "header and body decrypt consecutive frames" $ do 593 (_, _, r, f0, f1) <- transport_fixture 594 ms <- expect_right "consume" (consume r (f0 <> f1)) 595 ms @?= ["hello", "world!"] 596 , testCase "decrypt agrees with header and body" $ do 597 (_, _, r, f0, f1) <- transport_fixture 598 (m0, r') <- expect_right "decrypt 0" (BOLT8.decrypt r f0) 599 (m1, _) <- expect_right "decrypt 1" (BOLT8.decrypt r' f1) 600 [m0, m1] @?= ["hello", "world!"] 601 , testCase "empty message round-trips" $ do 602 (s, _, r, _, _) <- transport_fixture 603 (f, _) <- expect_right "encrypt" (BOLT8.encrypt s mempty) 604 BS.length f @?= 34 605 (m, _) <- expect_right "decrypt" (BOLT8.decrypt r f) 606 m @?= mempty 607 , testCase "65535-byte message round-trips" $ do 608 (s, _, r, _, _) <- transport_fixture 609 let big = BS.replicate 65535 0xab 610 (f, _) <- expect_right "encrypt" (BOLT8.encrypt s big) 611 BS.length f @?= 65569 612 (n, _) <- expect_right "header" (BOLT8.decrypt_header r (BS.take 18 f)) 613 n @?= 65551 614 (m, _) <- expect_right "decrypt" (BOLT8.decrypt r f) 615 m @?= big 616 , testCase "encrypt rejects a 65536-byte message" $ do 617 (s, _, _, _, _) <- transport_fixture 618 expect_error "encrypt" BOLT8.InvalidLength 619 (BOLT8.encrypt s (BS.replicate 65536 0)) 620 ] 621 622 transport_failure_tests :: TestTree 623 transport_failure_tests = testGroup "transport failures" [ 624 testCase "bad length MAC" $ do 625 (_, _, r, f0, _) <- transport_fixture 626 for_bytes [2, 17] f0 $ \bad -> do 627 expect_error "decrypt" BOLT8.InvalidMAC (BOLT8.decrypt r bad) 628 expect_error "decrypt_header" BOLT8.InvalidMAC 629 (BOLT8.decrypt_header r (BS.take 18 bad)) 630 , testCase "tampered length" $ do 631 (_, _, r, f0, _) <- transport_fixture 632 for_bytes [0, 1] f0 $ \bad -> do 633 expect_error "decrypt" BOLT8.InvalidMAC (BOLT8.decrypt r bad) 634 expect_error "decrypt_header" BOLT8.InvalidMAC 635 (BOLT8.decrypt_header r (BS.take 18 bad)) 636 , testCase "bad body MAC" $ do 637 (_, _, r, f0, _) <- transport_fixture 638 for_bytes [18, 23, BS.length f0 - 1] f0 $ \bad -> do 639 expect_error "decrypt" BOLT8.InvalidMAC (BOLT8.decrypt r bad) 640 (n, p) <- expect_right "header" 641 (BOLT8.decrypt_header r (BS.take 18 bad)) 642 expect_error "decrypt_body" BOLT8.InvalidMAC 643 (BOLT8.decrypt_body p (BS.take n (BS.drop 18 bad))) 644 , testCase "truncated frame" $ do 645 (_, _, r, f0, _) <- transport_fixture 646 let short = BS.take (BS.length f0 - 1) f0 647 expect_error "decrypt" BOLT8.InvalidLength (BOLT8.decrypt r short) 648 expect_error "decrypt, header only" BOLT8.InvalidLength 649 (BOLT8.decrypt r (BS.take 18 f0)) 650 expect_error "decrypt, partial header" BOLT8.InvalidLength 651 (BOLT8.decrypt r (BS.take 17 f0)) 652 expect_error "decrypt, empty" BOLT8.InvalidLength 653 (BOLT8.decrypt r mempty) 654 expect_error "decrypt_header" BOLT8.InvalidLength 655 (BOLT8.decrypt_header r (BS.take 17 f0)) 656 (_, p) <- expect_right "header" (BOLT8.decrypt_header r (BS.take 18 f0)) 657 expect_error "decrypt_body" BOLT8.InvalidLength 658 (BOLT8.decrypt_body p (BS.drop 18 short)) 659 , testCase "trailing bytes" $ do 660 (_, _, r, f0, _) <- transport_fixture 661 let long = f0 <> "\x00" 662 expect_error "decrypt" BOLT8.InvalidLength (BOLT8.decrypt r long) 663 expect_error "decrypt_header" BOLT8.InvalidLength 664 (BOLT8.decrypt_header r (BS.take 19 f0)) 665 (_, p) <- expect_right "header" (BOLT8.decrypt_header r (BS.take 18 f0)) 666 expect_error "decrypt_body" BOLT8.InvalidLength 667 (BOLT8.decrypt_body p (BS.drop 18 long)) 668 , testCase "replayed frame" $ do 669 (_, _, r, f0, _) <- transport_fixture 670 (_, r') <- expect_right "decrypt" (BOLT8.decrypt r f0) 671 expect_error "replay" BOLT8.InvalidMAC (BOLT8.decrypt r' f0) 672 , testCase "reordered frame" $ do 673 (_, _, r, _, f1) <- transport_fixture 674 expect_error "decrypt" BOLT8.InvalidMAC (BOLT8.decrypt r f1) 675 , testCase "reflected frame" $ do 676 (_, i_rcv, _, f0, _) <- transport_fixture 677 expect_error "decrypt" BOLT8.InvalidMAC (BOLT8.decrypt i_rcv f0) 678 ] 679 where 680 for_bytes is f act = mapM_ (\i -> flip_byte i f >>= act) is 681 682 -- properties ----------------------------------------------------------------- 683 684 property_tests :: TestTree 685 property_tests = testGroup "properties" [ 686 Q.testProperty "handshake agrees on keys and statics" prop_handshake 687 , Q.testProperty "messages up to 65535 bytes round-trip" prop_size 688 , Q.testProperty "header and body recover a stream" prop_stream 689 , Q.testProperty "parse_pub inverts serialize_pub" prop_pub 690 ] 691 692 -- 32 bytes that form a valid secret key 693 gen_secret :: Q.Gen BS.ByteString 694 gen_secret = (BS.pack <$> Q.vectorOf 32 Q.arbitrary) 695 `Q.suchThat` (isJust . BOLT8.keypair) 696 697 gen_bytes :: Int -> Q.Gen BS.ByteString 698 gen_bytes n = do 699 len <- Q.choose (0, n) 700 BS.pack <$> Q.vectorOf len Q.arbitrary 701 702 prop_handshake :: Q.Property 703 prop_handshake = 704 Q.forAll gen_secret $ \i_s -> 705 Q.forAll gen_secret $ \r_s -> 706 Q.forAll gen_secret $ \i_e -> 707 Q.forAll gen_secret $ \r_e -> 708 Q.forAll (gen_bytes 256) $ \m -> 709 case (BOLT8.keypair i_s, BOLT8.keypair r_s) of 710 (Just i, Just r) -> check i r (handshake i r i_e r_e) m 711 _ -> Q.counterexample "keypair" False 712 where 713 check _ _ (Left e) _ = Q.counterexample (show e) False 714 check i r (Right (i_res, r_res)) m = 715 let there = send (BOLT8.handshake_sender i_res) 716 (BOLT8.handshake_receiver r_res) m 717 back = send (BOLT8.handshake_sender r_res) 718 (BOLT8.handshake_receiver i_res) m 719 in BOLT8.handshake_remote_static i_res 720 Q.=== BOLT8.keypair_pub r 721 Q..&&. BOLT8.handshake_remote_static r_res 722 Q.=== BOLT8.keypair_pub i 723 Q..&&. there Q.=== Right m 724 Q..&&. back Q.=== Right m 725 send s r m = do 726 (ct, _) <- BOLT8.encrypt s m 727 fst <$> BOLT8.decrypt r ct 728 729 prop_size :: Q.Property 730 prop_size = 731 Q.forAll gen_len $ \len -> 732 Q.forAll Q.arbitrary $ \b -> 733 let m = BS.replicate len b 734 in case spec_handshake of 735 Left e -> Q.counterexample (show e) False 736 Right (i_res, r_res) -> 737 case BOLT8.encrypt (BOLT8.handshake_sender i_res) m of 738 Left e -> Q.counterexample (show e) False 739 Right (f, _) -> 740 let r = BOLT8.handshake_receiver r_res 741 in BS.length f Q.=== len + 34 742 Q..&&. fmap fst (BOLT8.decrypt_header r (BS.take 18 f)) 743 Q.=== Right (len + 16) 744 Q..&&. fmap fst (BOLT8.decrypt r f) Q.=== Right m 745 where 746 gen_len = Q.frequency [ 747 (1, pure 0) 748 , (1, pure 65535) 749 , (8, Q.choose (0, 65535)) 750 ] 751 752 prop_stream :: Q.Property 753 prop_stream = 754 Q.forAll (Q.listOf (gen_bytes 512)) $ \ms -> 755 case spec_handshake of 756 Left e -> Q.counterexample (show e) False 757 Right (i_res, r_res) -> 758 let enc _ [] = Right [] 759 enc s (m : rest) = do 760 (f, s') <- BOLT8.encrypt s m 761 (f :) <$> enc s' rest 762 in case enc (BOLT8.handshake_sender i_res) ms of 763 Left e -> Q.counterexample (show e) False 764 Right fs -> 765 consume (BOLT8.handshake_receiver r_res) (BS.concat fs) 766 Q.=== Right ms 767 768 prop_pub :: Q.Property 769 prop_pub = Q.forAll gen_secret $ \sec -> 770 case BOLT8.keypair sec of 771 Nothing -> Q.counterexample "keypair" False 772 Just kp -> 773 let pub = BOLT8.keypair_pub kp 774 in BOLT8.parse_pub (BOLT8.serialize_pub pub) Q.=== Just pub