{-# LANGUAGE OverloadedStrings, RankNTypes, ScopedTypeVariables #-} module Handshakes where import Data.Proxy import Crypto.Noise.Cipher import Crypto.Noise.Cipher.AESGCM import Crypto.Noise.Cipher.ChaChaPoly1305 import Crypto.Noise.Curve import Crypto.Noise.Curve.Curve25519 import Crypto.Noise.Handshake import Crypto.Noise.Hash import Crypto.Noise.Hash.BLAKE2s import Crypto.Noise.Hash.BLAKE2b import Crypto.Noise.Hash.SHA256 import Crypto.Noise.Hash.SHA512 import Crypto.Noise.Types import Imports import Instances() import HandshakeStates data HandshakeType c d h = NoiseNN | NoiseKN | NoiseNK | NoiseKK | NoiseNE | NoiseKE | NoiseNX | NoiseKX | NoiseXN | NoiseIN | NoiseXK | NoiseIK | NoiseXE | NoiseIE | NoiseXX | NoiseIX | NoiseN | NoiseK | NoiseX is25519 :: KeyPair Curve25519 is25519 = curveBytesToPair . bsToSB' $ "I\f\232\218A\210\230\147\FS\222\167\v}l\243!\168.\ESC\t\SYN\"\169\179A`\DC28\211\169tC" rs25519 :: KeyPair Curve25519 rs25519 = curveBytesToPair . bsToSB' $ "\ETB\157\&7\DC2\252\NUL\148\172\148\133\218\207\&8\221y\144\209\168FX\224Ser_\178|\153.\FSg&" re25519 :: KeyPair Curve25519 re25519 = curveBytesToPair . bsToSB' $ "<\231\151\151\180\217\146\DLEI}\160N\163iKc\162\210Y\168R\213\206&gm\169r\SUB[\\'" sampleHSPT :: Plaintext sampleHSPT = Plaintext . bsToSB' $ "cacophony" mkHandshakeProps :: forall c d h proxy. (Cipher c, Curve d, Hash h) => HandshakeKeys d -> proxy (c, h) -> [TestTree] mkHandshakeProps hks _ = let nni, nnr, kni, knr, nki, nkr, kki, kkr, nei, ner, kei, ker, nxi, nxr, kxi, kxr, xni, xnr, ini, inr, xki, xkr, iki, ikr, xei, xer, iei, ier, xxi, xxr, ixi, ixr, ni, nr, ki, kr, xi, xr :: HandshakeState c d h nni = noiseNNIHS hks nnr = noiseNNRHS hks kni = noiseKNIHS hks knr = noiseKNRHS hks nki = noiseNKIHS hks nkr = noiseNKRHS hks kki = noiseKKIHS hks kkr = noiseKKRHS hks nei = noiseNEIHS hks ner = noiseNERHS hks kei = noiseKEIHS hks ker = noiseKERHS hks nxi = noiseNXIHS hks nxr = noiseNXRHS hks kxi = noiseKXIHS hks kxr = noiseKXRHS hks xni = noiseXNIHS hks xnr = noiseXNRHS hks ini = noiseINIHS hks inr = noiseINRHS hks xki = noiseXKIHS hks xkr = noiseXKRHS hks iki = noiseIKIHS hks ikr = noiseIKRHS hks xei = noiseXEIHS hks xer = noiseXERHS hks iei = noiseIEIHS hks ier = noiseIERHS hks xxi = noiseXXIHS hks xxr = noiseXXRHS hks ixi = noiseIXIHS hks ixr = noiseIXRHS hks ni = noiseNIHS hks nr = noiseNRHS hks ki = noiseKIHS hks kr = noiseKRHS hks xi = noiseXIHS hks xr = noiseXRHS hks in [ testProperty "Noise_NN" (property (twoMessage nni nnr)) , testProperty "Noise_KN" (property (twoMessage kni knr)) , testProperty "Noise_NK" (property (twoMessage nki nkr)) , testProperty "Noise_KK" (property (twoMessage kki kkr)) , testProperty "Noise_NE" (property (twoMessage nei ner)) , testProperty "Noise_KE" (property (twoMessage kei ker)) , testProperty "Noise_NX" (property (twoMessage nxi nxr)) , testProperty "Noise_KX" (property (twoMessage kxi kxr)) , testProperty "Noise_XN" (property (threeMessage xni xnr)) , testProperty "Noise_IN" (property (twoMessage ini inr)) , testProperty "Noise_XK" (property (threeMessage xki xkr)) , testProperty "Noise_IK" (property (twoMessage iki ikr)) , testProperty "Noise_XE" (property (threeMessage xei xer)) , testProperty "Noise_IE" (property (twoMessage iei ier)) , testProperty "Noise_XX" (property (threeMessage xxi xxr)) , testProperty "Noise_IX" (property (twoMessage ixi ixr)) , testProperty "Noise_N" (property (oneMessage ni nr )) , testProperty "Noise_K" (property (oneMessage ki kr )) , testProperty "Noise_X" (property (oneMessage xi xr )) ] oneMessage :: (Cipher c, Curve d, Hash h) => HandshakeState c d h -> HandshakeState c d h -> Plaintext -> Property oneMessage ihs rhs pt = ioProperty $ do (aliceToBob1, csAlice1, _) <- writeMessageFinal ihs sampleHSPT let (hsptFromBob1, csBob1, _) = readMessageFinal rhs aliceToBob1 return $ conjoin [ (decrypt csBob1 . encrypt csAlice1) pt === pt , (decrypt csAlice1 . encrypt csBob1) pt === pt , hsptFromBob1 === sampleHSPT ] where encrypt cs p = fst $ encryptPayload p cs decrypt cs ct = fst $ decryptPayload ct cs twoMessage :: (Cipher c, Curve d, Hash h) => HandshakeState c d h -> HandshakeState c d h -> Plaintext -> Property twoMessage ihs rhs pt = ioProperty $ do (aliceToBob1, ihs') <- writeMessage ihs sampleHSPT let (hsptFromAlice1, rhs') = readMessage rhs aliceToBob1 (bobToAlice1, csBob1, csBob2) <- writeMessageFinal rhs' sampleHSPT let (hsptFromBob1, csAlice1, csAlice2) = readMessageFinal ihs' bobToAlice1 return $ conjoin [ (decrypt csBob1 . encrypt csAlice1) pt === pt , (decrypt csBob2 . encrypt csAlice2) pt === pt , (decrypt csAlice1 . encrypt csBob1) pt === pt , (decrypt csAlice2 . encrypt csBob2) pt === pt , hsptFromAlice1 === sampleHSPT , hsptFromBob1 === sampleHSPT ] where encrypt cs p = fst $ encryptPayload p cs decrypt cs ct = fst $ decryptPayload ct cs threeMessage :: (Cipher c, Curve d, Hash h) => HandshakeState c d h -> HandshakeState c d h -> Plaintext -> Property threeMessage ihs rhs pt = ioProperty $ do (aliceToBob1, ihs') <- writeMessage ihs sampleHSPT let (hsptFromAlice1, rhs') = readMessage rhs aliceToBob1 (bobToAlice1, rhs'') <- writeMessage rhs' sampleHSPT let (hsptFromBob1, ihs'') = readMessage ihs' bobToAlice1 (aliceToBob2, csAlice1, csAlice2) <- writeMessageFinal ihs'' sampleHSPT let (hsptFromBob2, csBob1, csBob2) = readMessageFinal rhs'' aliceToBob2 return $ conjoin [ (decrypt csBob1 . encrypt csAlice1) pt === pt , (decrypt csBob2 . encrypt csAlice2) pt === pt , (decrypt csAlice1 . encrypt csBob1) pt === pt , (decrypt csAlice2 . encrypt csBob2) pt === pt , hsptFromAlice1 === sampleHSPT , hsptFromBob1 === sampleHSPT , hsptFromBob2 === sampleHSPT ] where encrypt cs p = fst $ encryptPayload p cs decrypt cs ct = fst $ decryptPayload ct cs tests :: TestTree tests = let p = Just "cacophony" hks = HandshakeKeys Nothing is25519 rs25519 re25519 hks' = HandshakeKeys p is25519 rs25519 re25519 in testGroup "Handshakes" [ testGroup "Curve25519-ChaChaPoly1305-SHA256" [ testGroup "without PSK" (mkHandshakeProps hks (Proxy :: Proxy (ChaChaPoly1305, SHA256))) , testGroup "with PSK" (mkHandshakeProps hks' (Proxy :: Proxy (ChaChaPoly1305, SHA256))) ] , testGroup "Curve25519-ChaChaPoly1305-SHA512" [ testGroup "without PSK" (mkHandshakeProps hks (Proxy :: Proxy (ChaChaPoly1305, SHA512))) , testGroup "with PSK" (mkHandshakeProps hks' (Proxy :: Proxy (ChaChaPoly1305, SHA512))) ] , testGroup "Curve25519-ChaChaPoly1305-BLAKE2s" [ testGroup "without PSK" (mkHandshakeProps hks (Proxy :: Proxy (ChaChaPoly1305, BLAKE2s))) , testGroup "with PSK" (mkHandshakeProps hks' (Proxy :: Proxy (ChaChaPoly1305, BLAKE2s))) ] , testGroup "Curve25519-ChaChaPoly1305-BLAKE2b" [ testGroup "without PSK" (mkHandshakeProps hks (Proxy :: Proxy (ChaChaPoly1305, BLAKE2b))) , testGroup "with PSK" (mkHandshakeProps hks' (Proxy :: Proxy (ChaChaPoly1305, BLAKE2b))) ] , testGroup "Curve25519-AESGCM-SHA256" [ testGroup "without PSK" (mkHandshakeProps hks (Proxy :: Proxy (AESGCM, SHA256))) , testGroup "with PSK" (mkHandshakeProps hks' (Proxy :: Proxy (AESGCM, SHA256))) ] , testGroup "Curve25519-AESGCM-SHA512" [ testGroup "without PSK" (mkHandshakeProps hks (Proxy :: Proxy (AESGCM, SHA512))) , testGroup "with PSK" (mkHandshakeProps hks' (Proxy :: Proxy (AESGCM, SHA512))) ] , testGroup "Curve25519-AESGCM-BLAKE2s" [ testGroup "without PSK" (mkHandshakeProps hks (Proxy :: Proxy (AESGCM, BLAKE2s))) , testGroup "with PSK" (mkHandshakeProps hks' (Proxy :: Proxy (AESGCM, BLAKE2s))) ] , testGroup "Curve25519-AESGCM-BLAKE2b" [ testGroup "without PSK" (mkHandshakeProps hks (Proxy :: Proxy (AESGCM, BLAKE2b))) , testGroup "with PSK" (mkHandshakeProps hks' (Proxy :: Proxy (AESGCM, BLAKE2b))) ] ]