module Crypto.Noise
(
NoiseState
, NoiseResult(..)
, HandshakePattern
, HandshakeRole(..)
, HandshakeOpts
, defaultHandshakeOpts
, noiseState
, writeMessage
, readMessage
, processPSKs
, remoteStaticKey
, handshakeComplete
, handshakeHash
, rekeySending
, rekeyReceiving
, handshakePattern
, setLocalEphemeral
, setLocalStatic
, setRemoteEphemeral
, setRemoteStatic
, Cipher
, DH
, Hash
, ScrubbedBytes
, convert
) where
import Control.Arrow (arr, second, (***))
import Control.Exception.Safe
import Control.Lens
import Data.ByteArray (ScrubbedBytes, convert)
import Data.Maybe (isJust)
import Crypto.Noise.Cipher
import Crypto.Noise.DH
import Crypto.Noise.Hash
import Crypto.Noise.Internal.CipherState
import Crypto.Noise.Internal.Handshake.Pattern hiding (psk)
import Crypto.Noise.Internal.Handshake.State
import Crypto.Noise.Internal.NoiseState
import Crypto.Noise.Internal.SymmetricState
data NoiseResult c d h
= NoiseResultMessage ScrubbedBytes (NoiseState c d h)
| NoiseResultNeedPSK (NoiseState c d h)
| NoiseResultException SomeException
writeMessage :: (Cipher c, DH d, Hash h)
=> ScrubbedBytes
-> NoiseState c d h
-> NoiseResult c d h
writeMessage msg ns = maybe
(convertHandshakeResult $ resumeHandshake msg ns)
(convertTransportResult . encryptMsg)
(ns ^. nsSendingCipherState)
where
ctToMsg = arr cipherTextToBytes
updateState = arr $ \cs -> ns & nsSendingCipherState .~ Just cs
encryptMsg cs = (ctToMsg *** updateState) <$> encryptWithAd mempty msg cs
readMessage :: (Cipher c, DH d, Hash h)
=> ScrubbedBytes
-> NoiseState c d h
-> NoiseResult c d h
readMessage ct ns = maybe
(convertHandshakeResult $ resumeHandshake ct ns)
(convertTransportResult . decryptMsg)
(ns ^. nsReceivingCipherState)
where
ct' = cipherBytesToText ct
updateState = arr $ \cs -> ns & nsReceivingCipherState .~ Just cs
decryptMsg cs = second updateState <$> decryptWithAd mempty ct' cs
processPSKs :: (Cipher c, DH d, Hash h)
=> (ScrubbedBytes -> NoiseState c d h -> NoiseResult c d h)
-> [ScrubbedBytes]
-> NoiseResult c d h
-> ([ScrubbedBytes], NoiseResult c d h)
processPSKs _ [] result = ([], result)
processPSKs f psks@(psk : rest) result = case result of
NoiseResultNeedPSK state' -> processPSKs f rest (f psk state')
r -> (psks, r)
remoteStaticKey :: NoiseState c d h
-> Maybe (PublicKey d)
remoteStaticKey ns = ns ^. nsHandshakeState . hsOpts . hoRemoteStatic
handshakeComplete :: NoiseState c d h
-> Bool
handshakeComplete ns = isJust (ns ^. nsSendingCipherState) &&
isJust (ns ^. nsReceivingCipherState)
handshakeHash :: Hash h
=> NoiseState c d h
-> ScrubbedBytes
handshakeHash ns = either id hashToBytes
$ ns ^. nsHandshakeState . hsSymmetricState . ssh
rekeySending :: (Cipher c, DH d, Hash h)
=> NoiseState c d h
-> NoiseState c d h
rekeySending ns = ns & nsSendingCipherState %~ (<*>) (pure rekey)
rekeyReceiving :: (Cipher c, DH d, Hash h)
=> NoiseState c d h
-> NoiseState c d h
rekeyReceiving ns = ns & nsReceivingCipherState %~ (<*>) (pure rekey)
convertHandshakeResult :: (Cipher c, DH d, Hash h)
=> Either SomeException (HandshakeResult, NoiseState c d h)
-> NoiseResult c d h
convertHandshakeResult hsr = case hsr of
Left ex -> NoiseResultException ex
Right (HandshakeResultMessage m, ns) -> NoiseResultMessage m ns
Right (HandshakeResultNeedPSK , ns) -> NoiseResultNeedPSK ns
convertTransportResult :: (Cipher c, DH d, Hash h)
=> Either SomeException (ScrubbedBytes, NoiseState c d h)
-> NoiseResult c d h
convertTransportResult = either NoiseResultException (uncurry NoiseResultMessage)