module Crypto.Noise
(
HandshakeRole(..)
, HandshakeOpts
, NoiseException(..)
, NoiseState
, defaultHandshakeOpts
, noiseState
, writeMessage
, readMessage
, remoteStaticKey
, handshakeComplete
, handshakeHash
, hoPattern
, hoRole
, hoPrologue
, hoPreSharedKey
, hoLocalStatic
, hoLocalSemiEphemeral
, hoLocalEphemeral
, hoRemoteStatic
, hoRemoteSemiEphemeral
, hoRemoteEphemeral
) where
import Control.Arrow
import Control.Exception.Safe
import Control.Lens
import Data.ByteArray (ScrubbedBytes, convert)
import Data.ByteString (ByteString)
import Data.Maybe (isJust)
import Prelude hiding (length)
import Crypto.Noise.Cipher
import Crypto.Noise.DH
import Crypto.Noise.Hash
import Crypto.Noise.Internal.CipherState
import Crypto.Noise.Internal.Handshake
import Crypto.Noise.Internal.NoiseState
import Crypto.Noise.Internal.SymmetricState
import Crypto.Noise.Internal.Types
writeMessage :: (MonadThrow m, Cipher c, Hash h)
=> NoiseState c d h
-> ScrubbedBytes
-> m (ByteString, NoiseState c d h)
writeMessage ns msg = maybe
(first convertArr <$> runHandshake msg ns)
(\cs -> (ctToBytes *** updateState) <$> encryptAndIncrement "" msg cs)
(ns ^. nsSendingCipherState)
where
convertArr = arr convert
ctToBytes = convertArr . arr cipherTextToBytes
updateState = arr $ \cs -> ns & nsSendingCipherState .~ Just cs
readMessage :: (MonadThrow m, Cipher c, Hash h)
=> NoiseState c d h
-> ByteString
-> m (ScrubbedBytes, NoiseState c d h)
readMessage ns ct = maybe
(runHandshake (convert ct) ns)
(\cs -> second updateState <$> decryptAndIncrement "" ct' cs)
(ns ^. nsReceivingCipherState)
where
ct' = cipherBytesToText . convert $ ct
updateState = arr $ \cs -> ns & nsReceivingCipherState .~ Just cs
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