module LibP2P.Noise.Handshake
(
HandshakeResult (..)
, NoisePayload (..)
, HandshakeState (..)
, encodeNoisePayload
, decodeNoisePayload
, buildHandshakePayload
, signStaticKey
, verifyStaticKey
, initHandshakeInitiator
, initHandshakeResponder
, writeHandshakeMsg
, readHandshakeMsg
, sessionComplete
, getRemoteNoiseStaticKey
, performFullHandshake
, performFullHandshakeWithSessions
, decodePublicKey
) where
import Crypto.Noise
( HandshakeRole (..)
, NoiseResult (..)
, NoiseState
, convert
, defaultHandshakeOpts
, handshakeComplete
, noiseState
, readMessage
, remoteStaticKey
, setLocalEphemeral
, setLocalStatic
, writeMessage
)
import Crypto.Noise.Cipher.ChaChaPoly1305 (ChaChaPoly1305)
import Crypto.Noise.DH (dhGenKey, dhPubToBytes)
import qualified Crypto.Noise.DH as DH
import Crypto.Noise.DH.Curve25519 (Curve25519)
import Crypto.Noise.HandshakePatterns (noiseXX)
import Crypto.Noise.Hash.SHA256 (SHA256)
import Data.Bits (shiftR, (.&.))
import Data.ByteArray (ScrubbedBytes)
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.Word (Word64)
import LibP2P.Core.Varint (decodeUvarint, encodeUvarint)
import LibP2P.Crypto.Key
( KeyPair (..)
, PrivateKey (..)
, PublicKey (..)
, verify
)
import qualified LibP2P.Crypto.Key as Key
import LibP2P.Crypto.PeerId (PeerId, fromPublicKey)
import LibP2P.Crypto.Protobuf (decodePublicKey, encodePublicKey)
import LibP2P.Noise.Session (NoiseSession, mkNoiseSession)
type CacophonyState = NoiseState ChaChaPoly1305 Curve25519 SHA256
newtype HandshakeState = HandshakeState
{ HandshakeState -> CacophonyState
hsNoiseState :: CacophonyState
}
data HandshakeResult = HandshakeResult
{ HandshakeResult -> PeerId
hrRemotePeerId :: !PeerId
, HandshakeResult -> PublicKey
hrRemotePublicKey :: !PublicKey
}
deriving (Int -> HandshakeResult -> ShowS
[HandshakeResult] -> ShowS
HandshakeResult -> String
(Int -> HandshakeResult -> ShowS)
-> (HandshakeResult -> String)
-> ([HandshakeResult] -> ShowS)
-> Show HandshakeResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HandshakeResult -> ShowS
showsPrec :: Int -> HandshakeResult -> ShowS
$cshow :: HandshakeResult -> String
show :: HandshakeResult -> String
$cshowList :: [HandshakeResult] -> ShowS
showList :: [HandshakeResult] -> ShowS
Show, HandshakeResult -> HandshakeResult -> Bool
(HandshakeResult -> HandshakeResult -> Bool)
-> (HandshakeResult -> HandshakeResult -> Bool)
-> Eq HandshakeResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HandshakeResult -> HandshakeResult -> Bool
== :: HandshakeResult -> HandshakeResult -> Bool
$c/= :: HandshakeResult -> HandshakeResult -> Bool
/= :: HandshakeResult -> HandshakeResult -> Bool
Eq)
data NoisePayload = NoisePayload
{ NoisePayload -> ByteString
npIdentityKey :: !ByteString
, NoisePayload -> ByteString
npIdentitySig :: !ByteString
}
deriving (Int -> NoisePayload -> ShowS
[NoisePayload] -> ShowS
NoisePayload -> String
(Int -> NoisePayload -> ShowS)
-> (NoisePayload -> String)
-> ([NoisePayload] -> ShowS)
-> Show NoisePayload
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NoisePayload -> ShowS
showsPrec :: Int -> NoisePayload -> ShowS
$cshow :: NoisePayload -> String
show :: NoisePayload -> String
$cshowList :: [NoisePayload] -> ShowS
showList :: [NoisePayload] -> ShowS
Show, NoisePayload -> NoisePayload -> Bool
(NoisePayload -> NoisePayload -> Bool)
-> (NoisePayload -> NoisePayload -> Bool) -> Eq NoisePayload
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NoisePayload -> NoisePayload -> Bool
== :: NoisePayload -> NoisePayload -> Bool
$c/= :: NoisePayload -> NoisePayload -> Bool
/= :: NoisePayload -> NoisePayload -> Bool
Eq)
noiseStaticKeyPrefix :: ByteString
noiseStaticKeyPrefix :: ByteString
noiseStaticKeyPrefix = ByteString
"noise-libp2p-static-key:"
signStaticKey :: PrivateKey -> ByteString -> Either String ByteString
signStaticKey :: PrivateKey -> ByteString -> Either String ByteString
signStaticKey PrivateKey
sk ByteString
noiseStaticPubKey =
let payload :: ByteString
payload = ByteString
noiseStaticKeyPrefix ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
noiseStaticPubKey
in PrivateKey -> ByteString -> Either String ByteString
Key.sign PrivateKey
sk ByteString
payload
verifyStaticKey :: PublicKey -> ByteString -> ByteString -> Bool
verifyStaticKey :: PublicKey -> ByteString -> ByteString -> Bool
verifyStaticKey PublicKey
pk ByteString
noiseStaticPubKey ByteString
sig =
let payload :: ByteString
payload = ByteString
noiseStaticKeyPrefix ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
noiseStaticPubKey
in PublicKey -> ByteString -> ByteString -> Bool
verify PublicKey
pk ByteString
payload ByteString
sig
buildHandshakePayload :: Key.KeyPair -> ByteString -> Either String NoisePayload
buildHandshakePayload :: KeyPair -> ByteString -> Either String NoisePayload
buildHandshakePayload KeyPair
identityKP ByteString
noiseStaticPub = do
identSig <-
(String -> Either String ByteString)
-> (ByteString -> Either String ByteString)
-> Either String ByteString
-> Either String ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Either String ByteString
forall a b. a -> Either a b
Left (String -> Either String ByteString)
-> ShowS -> String -> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"buildHandshakePayload: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>)) ByteString -> Either String ByteString
forall a b. b -> Either a b
Right (Either String ByteString -> Either String ByteString)
-> Either String ByteString -> Either String ByteString
forall a b. (a -> b) -> a -> b
$
PrivateKey -> ByteString -> Either String ByteString
signStaticKey (KeyPair -> PrivateKey
kpPrivate KeyPair
identityKP) ByteString
noiseStaticPub
Right (NoisePayload (encodePublicKey (kpPublic identityKP)) identSig)
encodeNoisePayload :: NoisePayload -> ByteString
encodeNoisePayload :: NoisePayload -> ByteString
encodeNoisePayload (NoisePayload ByteString
identKey ByteString
identSig) =
Word8 -> ByteString
BS.singleton Word8
0x0a
ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Word64 -> ByteString
encodeUvarint (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
identKey))
ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
identKey
ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Word8 -> ByteString
BS.singleton Word8
0x12
ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Word64 -> ByteString
encodeUvarint (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
identSig))
ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
identSig
decodeNoisePayload :: ByteString -> Either String NoisePayload
decodeNoisePayload :: ByteString -> Either String NoisePayload
decodeNoisePayload ByteString
bs0 = do
(mKey, mSig) <- (Maybe ByteString, Maybe ByteString)
-> ByteString -> Either String (Maybe ByteString, Maybe ByteString)
go (Maybe ByteString
forall a. Maybe a
Nothing, Maybe ByteString
forall a. Maybe a
Nothing) ByteString
bs0
identKey <- maybe (Left "decodeNoisePayload: missing identity_key (field 1)") Right mKey
identSig <- maybe (Left "decodeNoisePayload: missing identity_sig (field 2)") Right mSig
Right (NoisePayload identKey identSig)
where
go
:: (Maybe ByteString, Maybe ByteString)
-> ByteString
-> Either String (Maybe ByteString, Maybe ByteString)
go :: (Maybe ByteString, Maybe ByteString)
-> ByteString -> Either String (Maybe ByteString, Maybe ByteString)
go acc :: (Maybe ByteString, Maybe ByteString)
acc@(Maybe ByteString
mKey, Maybe ByteString
mSig) ByteString
input
| ByteString -> Bool
BS.null ByteString
input = (Maybe ByteString, Maybe ByteString)
-> Either String (Maybe ByteString, Maybe ByteString)
forall a b. b -> Either a b
Right (Maybe ByteString, Maybe ByteString)
acc
| Bool
otherwise = do
(tag, rest) <- ByteString -> Either String (Word64, ByteString)
decodeUvarint ByteString
input
let fieldNum = Word64
tag Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
3
wireType = Word64
tag Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0x7
case (fieldNum, wireType) of
(Word64
1, Word64
2) -> do
(v, rest') <- ByteString -> Either String (ByteString, ByteString)
lengthDelimited ByteString
rest
go (Just v, mSig) rest'
(Word64
2, Word64
2) -> do
(v, rest') <- ByteString -> Either String (ByteString, ByteString)
lengthDelimited ByteString
rest
go (mKey, Just v) rest'
(Word64
_, Word64
wt) -> do
rest' <- Word64 -> ByteString -> Either String ByteString
skipField Word64
wt ByteString
rest
go acc rest'
lengthDelimited :: ByteString -> Either String (ByteString, ByteString)
lengthDelimited :: ByteString -> Either String (ByteString, ByteString)
lengthDelimited ByteString
input = do
(len, rest) <- ByteString -> Either String (Word64, ByteString)
decodeUvarint ByteString
input
let fieldLen = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
len :: Int
if BS.length rest < fieldLen
then Left "decodeNoisePayload: not enough bytes for field"
else Right (BS.take fieldLen rest, BS.drop fieldLen rest)
skipField :: Word64 -> ByteString -> Either String ByteString
skipField :: Word64 -> ByteString -> Either String ByteString
skipField Word64
0 ByteString
input = (Word64, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((Word64, ByteString) -> ByteString)
-> Either String (Word64, ByteString) -> Either String ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either String (Word64, ByteString)
decodeUvarint ByteString
input
skipField Word64
1 ByteString
input = Int -> ByteString -> Either String ByteString
skipFixed Int
8 ByteString
input
skipField Word64
2 ByteString
input = (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((ByteString, ByteString) -> ByteString)
-> Either String (ByteString, ByteString)
-> Either String ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either String (ByteString, ByteString)
lengthDelimited ByteString
input
skipField Word64
5 ByteString
input = Int -> ByteString -> Either String ByteString
skipFixed Int
4 ByteString
input
skipField Word64
wt ByteString
_ = String -> Either String ByteString
forall a b. a -> Either a b
Left (String -> Either String ByteString)
-> String -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ String
"decodeNoisePayload: unsupported wire type " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word64 -> String
forall a. Show a => a -> String
show Word64
wt
skipFixed :: Int -> ByteString -> Either String ByteString
skipFixed :: Int -> ByteString -> Either String ByteString
skipFixed Int
n ByteString
input
| ByteString -> Int
BS.length ByteString
input Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n = String -> Either String ByteString
forall a b. a -> Either a b
Left String
"decodeNoisePayload: not enough bytes for field"
| Bool
otherwise = ByteString -> Either String ByteString
forall a b. b -> Either a b
Right (Int -> ByteString -> ByteString
BS.drop Int
n ByteString
input)
initHandshakeInitiator :: Key.KeyPair -> IO (HandshakeState, ByteString)
initHandshakeInitiator :: KeyPair -> IO (HandshakeState, ByteString)
initHandshakeInitiator KeyPair
_identityKP = do
noiseStaticKP <- IO (KeyPair Curve25519)
forall d. DH d => IO (KeyPair d)
dhGenKey :: IO (DH.KeyPair Curve25519)
noiseEphemeralKP <- dhGenKey :: IO (DH.KeyPair Curve25519)
let noiseStaticPub = ScrubbedBytes -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (PublicKey Curve25519 -> ScrubbedBytes
forall d. DH d => PublicKey d -> ScrubbedBytes
dhPubToBytes (KeyPair Curve25519 -> PublicKey Curve25519
forall a b. (a, b) -> b
snd KeyPair Curve25519
noiseStaticKP)) :: ByteString
let opts = Maybe (KeyPair Curve25519)
-> HandshakeOpts Curve25519 -> HandshakeOpts Curve25519
forall d. Maybe (KeyPair d) -> HandshakeOpts d -> HandshakeOpts d
setLocalStatic (KeyPair Curve25519 -> Maybe (KeyPair Curve25519)
forall a. a -> Maybe a
Just KeyPair Curve25519
noiseStaticKP)
(HandshakeOpts Curve25519 -> HandshakeOpts Curve25519)
-> (HandshakeOpts Curve25519 -> HandshakeOpts Curve25519)
-> HandshakeOpts Curve25519
-> HandshakeOpts Curve25519
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (KeyPair Curve25519)
-> HandshakeOpts Curve25519 -> HandshakeOpts Curve25519
forall d. Maybe (KeyPair d) -> HandshakeOpts d -> HandshakeOpts d
setLocalEphemeral (KeyPair Curve25519 -> Maybe (KeyPair Curve25519)
forall a. a -> Maybe a
Just KeyPair Curve25519
noiseEphemeralKP)
(HandshakeOpts Curve25519 -> HandshakeOpts Curve25519)
-> HandshakeOpts Curve25519 -> HandshakeOpts Curve25519
forall a b. (a -> b) -> a -> b
$ HandshakeRole -> ScrubbedBytes -> HandshakeOpts Curve25519
forall d. HandshakeRole -> ScrubbedBytes -> HandshakeOpts d
defaultHandshakeOpts HandshakeRole
InitiatorRole ScrubbedBytes
""
let ns = HandshakeOpts Curve25519 -> HandshakePattern -> CacophonyState
forall c d h.
(Cipher c, DH d, Hash h) =>
HandshakeOpts d -> HandshakePattern -> NoiseState c d h
noiseState HandshakeOpts Curve25519
opts HandshakePattern
noiseXX :: CacophonyState
pure (HandshakeState ns, noiseStaticPub)
initHandshakeResponder :: Key.KeyPair -> IO (HandshakeState, ByteString)
initHandshakeResponder :: KeyPair -> IO (HandshakeState, ByteString)
initHandshakeResponder KeyPair
_identityKP = do
noiseStaticKP <- IO (KeyPair Curve25519)
forall d. DH d => IO (KeyPair d)
dhGenKey :: IO (DH.KeyPair Curve25519)
noiseEphemeralKP <- dhGenKey :: IO (DH.KeyPair Curve25519)
let noiseStaticPub = ScrubbedBytes -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (PublicKey Curve25519 -> ScrubbedBytes
forall d. DH d => PublicKey d -> ScrubbedBytes
dhPubToBytes (KeyPair Curve25519 -> PublicKey Curve25519
forall a b. (a, b) -> b
snd KeyPair Curve25519
noiseStaticKP)) :: ByteString
let opts = Maybe (KeyPair Curve25519)
-> HandshakeOpts Curve25519 -> HandshakeOpts Curve25519
forall d. Maybe (KeyPair d) -> HandshakeOpts d -> HandshakeOpts d
setLocalStatic (KeyPair Curve25519 -> Maybe (KeyPair Curve25519)
forall a. a -> Maybe a
Just KeyPair Curve25519
noiseStaticKP)
(HandshakeOpts Curve25519 -> HandshakeOpts Curve25519)
-> (HandshakeOpts Curve25519 -> HandshakeOpts Curve25519)
-> HandshakeOpts Curve25519
-> HandshakeOpts Curve25519
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (KeyPair Curve25519)
-> HandshakeOpts Curve25519 -> HandshakeOpts Curve25519
forall d. Maybe (KeyPair d) -> HandshakeOpts d -> HandshakeOpts d
setLocalEphemeral (KeyPair Curve25519 -> Maybe (KeyPair Curve25519)
forall a. a -> Maybe a
Just KeyPair Curve25519
noiseEphemeralKP)
(HandshakeOpts Curve25519 -> HandshakeOpts Curve25519)
-> HandshakeOpts Curve25519 -> HandshakeOpts Curve25519
forall a b. (a -> b) -> a -> b
$ HandshakeRole -> ScrubbedBytes -> HandshakeOpts Curve25519
forall d. HandshakeRole -> ScrubbedBytes -> HandshakeOpts d
defaultHandshakeOpts HandshakeRole
ResponderRole ScrubbedBytes
""
let ns = HandshakeOpts Curve25519 -> HandshakePattern -> CacophonyState
forall c d h.
(Cipher c, DH d, Hash h) =>
HandshakeOpts d -> HandshakePattern -> NoiseState c d h
noiseState HandshakeOpts Curve25519
opts HandshakePattern
noiseXX :: CacophonyState
pure (HandshakeState ns, noiseStaticPub)
writeHandshakeMsg :: HandshakeState -> ByteString -> Either String (ByteString, HandshakeState)
writeHandshakeMsg :: HandshakeState
-> ByteString -> Either String (ByteString, HandshakeState)
writeHandshakeMsg HandshakeState
hs ByteString
payload =
let sb :: ScrubbedBytes
sb = ByteString -> ScrubbedBytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert ByteString
payload :: ScrubbedBytes
in case ScrubbedBytes
-> CacophonyState -> NoiseResult ChaChaPoly1305 Curve25519 SHA256
forall c d h.
(Cipher c, DH d, Hash h) =>
ScrubbedBytes -> NoiseState c d h -> NoiseResult c d h
writeMessage ScrubbedBytes
sb (HandshakeState -> CacophonyState
hsNoiseState HandshakeState
hs) of
NoiseResultMessage ScrubbedBytes
ct CacophonyState
ns' ->
(ByteString, HandshakeState)
-> Either String (ByteString, HandshakeState)
forall a b. b -> Either a b
Right (ScrubbedBytes -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert ScrubbedBytes
ct, CacophonyState -> HandshakeState
HandshakeState CacophonyState
ns')
NoiseResultException SomeException
ex ->
String -> Either String (ByteString, HandshakeState)
forall a b. a -> Either a b
Left (String -> Either String (ByteString, HandshakeState))
-> String -> Either String (ByteString, HandshakeState)
forall a b. (a -> b) -> a -> b
$ String
"writeHandshakeMsg: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> SomeException -> String
forall a. Show a => a -> String
show SomeException
ex
NoiseResultNeedPSK CacophonyState
_ ->
String -> Either String (ByteString, HandshakeState)
forall a b. a -> Either a b
Left String
"writeHandshakeMsg: unexpected PSK request"
readHandshakeMsg :: HandshakeState -> ByteString -> Either String (ByteString, HandshakeState)
readHandshakeMsg :: HandshakeState
-> ByteString -> Either String (ByteString, HandshakeState)
readHandshakeMsg HandshakeState
hs ByteString
ciphertext =
let sb :: ScrubbedBytes
sb = ByteString -> ScrubbedBytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert ByteString
ciphertext :: ScrubbedBytes
in case ScrubbedBytes
-> CacophonyState -> NoiseResult ChaChaPoly1305 Curve25519 SHA256
forall c d h.
(Cipher c, DH d, Hash h) =>
ScrubbedBytes -> NoiseState c d h -> NoiseResult c d h
readMessage ScrubbedBytes
sb (HandshakeState -> CacophonyState
hsNoiseState HandshakeState
hs) of
NoiseResultMessage ScrubbedBytes
pt CacophonyState
ns' ->
(ByteString, HandshakeState)
-> Either String (ByteString, HandshakeState)
forall a b. b -> Either a b
Right (ScrubbedBytes -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert ScrubbedBytes
pt, CacophonyState -> HandshakeState
HandshakeState CacophonyState
ns')
NoiseResultException SomeException
ex ->
String -> Either String (ByteString, HandshakeState)
forall a b. a -> Either a b
Left (String -> Either String (ByteString, HandshakeState))
-> String -> Either String (ByteString, HandshakeState)
forall a b. (a -> b) -> a -> b
$ String
"readHandshakeMsg: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> SomeException -> String
forall a. Show a => a -> String
show SomeException
ex
NoiseResultNeedPSK CacophonyState
_ ->
String -> Either String (ByteString, HandshakeState)
forall a b. a -> Either a b
Left String
"readHandshakeMsg: unexpected PSK request"
getRemoteNoiseStaticKey :: HandshakeState -> Maybe ByteString
getRemoteNoiseStaticKey :: HandshakeState -> Maybe ByteString
getRemoteNoiseStaticKey HandshakeState
hs =
ScrubbedBytes -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (ScrubbedBytes -> ByteString)
-> (PublicKey Curve25519 -> ScrubbedBytes)
-> PublicKey Curve25519
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey Curve25519 -> ScrubbedBytes
forall d. DH d => PublicKey d -> ScrubbedBytes
dhPubToBytes (PublicKey Curve25519 -> ByteString)
-> Maybe (PublicKey Curve25519) -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CacophonyState -> Maybe (PublicKey Curve25519)
forall c d h. NoiseState c d h -> Maybe (PublicKey d)
remoteStaticKey (HandshakeState -> CacophonyState
hsNoiseState HandshakeState
hs)
sessionComplete :: HandshakeState -> Bool
sessionComplete :: HandshakeState -> Bool
sessionComplete = CacophonyState -> Bool
forall c d h. NoiseState c d h -> Bool
handshakeComplete (CacophonyState -> Bool)
-> (HandshakeState -> CacophonyState) -> HandshakeState -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HandshakeState -> CacophonyState
hsNoiseState
performFullHandshake :: Key.KeyPair -> Key.KeyPair -> IO (Either String (PeerId, PeerId))
performFullHandshake :: KeyPair -> KeyPair -> IO (Either String (PeerId, PeerId))
performFullHandshake KeyPair
aliceIdentity KeyPair
bobIdentity = do
(aliceInit, aliceNoiseStaticPub) <- KeyPair -> IO (HandshakeState, ByteString)
initHandshakeInitiator KeyPair
aliceIdentity
(bobInit, bobNoiseStaticPub) <- initHandshakeResponder bobIdentity
pure $ do
(msg1, aliceState1) <- writeHandshakeMsg aliceInit BS.empty
(_payload1, bobState1) <- readHandshakeMsg bobInit msg1
bobPayload <- encodeNoisePayload <$> buildHandshakePayload bobIdentity bobNoiseStaticPub
(msg2, bobState2) <- writeHandshakeMsg bobState1 bobPayload
(payload2, aliceState2) <- readHandshakeMsg aliceState1 msg2
bobNP <- decodeNoisePayload payload2
bobPubKey <- decodePublicKey (npIdentityKey bobNP)
let bobRemotePeerId = PublicKey -> PeerId
fromPublicKey PublicKey
bobPubKey
case getRemoteNoiseStaticKey aliceState2 of
Maybe ByteString
Nothing -> String -> Either String ()
forall a b. a -> Either a b
Left String
"performFullHandshake: remote Noise static key unavailable after msg2"
Just ByteString
remoteNoisePub ->
if Bool -> Bool
not (PublicKey -> ByteString -> ByteString -> Bool
verifyStaticKey PublicKey
bobPubKey ByteString
remoteNoisePub (NoisePayload -> ByteString
npIdentitySig NoisePayload
bobNP))
then String -> Either String ()
forall a b. a -> Either a b
Left String
"performFullHandshake: Bob's identity signature verification failed"
else () -> Either String ()
forall a b. b -> Either a b
Right ()
alicePayload <- encodeNoisePayload <$> buildHandshakePayload aliceIdentity aliceNoiseStaticPub
(msg3, _aliceFinal) <- writeHandshakeMsg aliceState2 alicePayload
(payload3, bobFinal) <- readHandshakeMsg bobState2 msg3
aliceNP <- decodeNoisePayload payload3
alicePubKey <- decodePublicKey (npIdentityKey aliceNP)
let aliceRemotePeerId = PublicKey -> PeerId
fromPublicKey PublicKey
alicePubKey
case getRemoteNoiseStaticKey bobFinal of
Maybe ByteString
Nothing -> String -> Either String ()
forall a b. a -> Either a b
Left String
"performFullHandshake: remote Noise static key unavailable after msg3"
Just ByteString
remoteNoisePub ->
if Bool -> Bool
not (PublicKey -> ByteString -> ByteString -> Bool
verifyStaticKey PublicKey
alicePubKey ByteString
remoteNoisePub (NoisePayload -> ByteString
npIdentitySig NoisePayload
aliceNP))
then String -> Either String ()
forall a b. a -> Either a b
Left String
"performFullHandshake: Alice's identity signature verification failed"
else () -> Either String ()
forall a b. b -> Either a b
Right ()
Right (bobRemotePeerId, aliceRemotePeerId)
performFullHandshakeWithSessions :: Key.KeyPair -> Key.KeyPair -> IO (Either String (NoiseSession, NoiseSession))
performFullHandshakeWithSessions :: KeyPair
-> KeyPair -> IO (Either String (NoiseSession, NoiseSession))
performFullHandshakeWithSessions KeyPair
aliceIdentity KeyPair
bobIdentity = do
(aliceInit, aliceNoiseStaticPub) <- KeyPair -> IO (HandshakeState, ByteString)
initHandshakeInitiator KeyPair
aliceIdentity
(bobInit, bobNoiseStaticPub) <- initHandshakeResponder bobIdentity
pure $ do
(msg1, aliceState1) <- writeHandshakeMsg aliceInit BS.empty
(_payload1, bobState1) <- readHandshakeMsg bobInit msg1
bobPayload <- encodeNoisePayload <$> buildHandshakePayload bobIdentity bobNoiseStaticPub
(msg2, bobState2) <- writeHandshakeMsg bobState1 bobPayload
(payload2, aliceState2) <- readHandshakeMsg aliceState1 msg2
bobNP <- decodeNoisePayload payload2
bobPubKey <- decodePublicKey (npIdentityKey bobNP)
case getRemoteNoiseStaticKey aliceState2 of
Maybe ByteString
Nothing -> String -> Either String ()
forall a b. a -> Either a b
Left String
"performFullHandshakeWithSessions: remote Noise static key unavailable after msg2"
Just ByteString
remoteNoisePub ->
if Bool -> Bool
not (PublicKey -> ByteString -> ByteString -> Bool
verifyStaticKey PublicKey
bobPubKey ByteString
remoteNoisePub (NoisePayload -> ByteString
npIdentitySig NoisePayload
bobNP))
then String -> Either String ()
forall a b. a -> Either a b
Left String
"performFullHandshakeWithSessions: Bob's identity signature verification failed"
else () -> Either String ()
forall a b. b -> Either a b
Right ()
alicePayload <- encodeNoisePayload <$> buildHandshakePayload aliceIdentity aliceNoiseStaticPub
(msg3, aliceFinal) <- writeHandshakeMsg aliceState2 alicePayload
(payload3, bobFinal) <- readHandshakeMsg bobState2 msg3
aliceNP <- decodeNoisePayload payload3
alicePubKey <- decodePublicKey (npIdentityKey aliceNP)
case getRemoteNoiseStaticKey bobFinal of
Maybe ByteString
Nothing -> String -> Either String ()
forall a b. a -> Either a b
Left String
"performFullHandshakeWithSessions: remote Noise static key unavailable after msg3"
Just ByteString
remoteNoisePub ->
if Bool -> Bool
not (PublicKey -> ByteString -> ByteString -> Bool
verifyStaticKey PublicKey
alicePubKey ByteString
remoteNoisePub (NoisePayload -> ByteString
npIdentitySig NoisePayload
aliceNP))
then String -> Either String ()
forall a b. a -> Either a b
Left String
"performFullHandshakeWithSessions: Alice's identity signature verification failed"
else () -> Either String ()
forall a b. b -> Either a b
Right ()
Right (mkNoiseSession (hsNoiseState aliceFinal), mkNoiseSession (hsNoiseState bobFinal))