------------------------------------------------- -- | -- Module : Crypto.Noise -- Maintainer : John Galt -- Stability : experimental -- Portability : POSIX -- -- Please see the README for usage information. module Crypto.Noise ( -- * Types NoiseState , NoiseResult(..) , HandshakePattern , HandshakeRole(..) , HandshakeOpts -- * Functions , defaultHandshakeOpts , noiseState , writeMessage , readMessage , processPSKs , remoteStaticKey , handshakeComplete , handshakeHash , rekeySending , rekeyReceiving , handshakePattern -- * HandshakeOpts Setters , setLocalEphemeral , setLocalStatic , setRemoteEphemeral , setRemoteStatic -- * Classes , Cipher , DH , Hash -- * Re-exports , 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 -- | This type is used to indicate to the user the result of either writing or -- reading a message. In the simplest case, when processing a handshake or -- transport message, the (en|de)crypted message and mutated state will be -- available in 'NoiseResultMessage'. -- -- If during the course of the handshake a pre-shared key is needed, a -- 'NoiseResultNeedPSK' value will be returned along with the mutated state. -- To continue, the user must re-issue the 'writeMessage' or 'readMessage' -- call, passing in the PSK as the payload. If no further PSKs are required, -- the result will be 'NoiseResultMessage'. -- -- If an exception is encountered at any point while processing a handshake or -- transport message, 'NoiseResultException' will be returned. data NoiseResult c d h = NoiseResultMessage ScrubbedBytes (NoiseState c d h) | NoiseResultNeedPSK (NoiseState c d h) | NoiseResultException SomeException -- | Creates a handshake or transport message with the provided payload. Note -- that the payload may not be authenticated or encrypted at all points during -- the handshake. Please see section 7.4 of the protocol document for details. -- -- If a previous call to this function indicated that a pre-shared key is -- needed, it shall be provided as the payload. See the documentation of -- 'NoiseResult' for details. -- -- To prevent catastrophic key re-use, this function may only be used to -- secure 2^64 - 1 post-handshake messages. 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 ?~ cs encryptMsg cs = (ctToMsg *** updateState) <$> encryptWithAd mempty msg cs -- | Reads a handshake or transport message and returns the embedded payload. If -- the handshake fails, a 'HandshakeError' will be returned. After the -- handshake is complete, if decryption fails a 'DecryptionError' is returned. -- -- If a previous call to this function indicated that a pre-shared key is -- needed, it shall be provided as the payload. See the documentation of -- 'NoiseResult' for details. -- -- To prevent catastrophic key re-use, this function may only be used to -- receive 2^64 - 1 post-handshake messages. 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 ?~ cs decryptMsg cs = second updateState <$> decryptWithAd mempty ct' cs -- | Given an operation ('writeMessage' or 'readMessage'), a list of PSKs, and -- a 'NoiseResult', this function will repeatedly apply PSKs to the NoiseState -- until no more are requested or the list of PSKs becomes empty. This is -- useful for patterns which require two or more PSKs, and you know exactly -- what they all should be ahead of time. 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) -- | For handshake patterns where the remote party's static key is -- transmitted, this function can be used to retrieve it. This allows -- for the creation of public key-based access-control lists. remoteStaticKey :: NoiseState c d h -> Maybe (PublicKey d) remoteStaticKey ns = ns ^. nsHandshakeState . hsOpts . hoRemoteStatic -- | Returns @True@ if the handshake is complete. handshakeComplete :: NoiseState c d h -> Bool handshakeComplete ns = isJust (ns ^. nsSendingCipherState) && isJust (ns ^. nsReceivingCipherState) -- | Retrieves the @h@ value associated with the conversation's -- @SymmetricState@. This value is intended to be used for channel -- binding. For example, the initiator might cryptographically sign this -- value as part of some higher-level authentication scheme. -- -- The value returned by this function is only meaningful after the -- handshake is complete. -- -- See section 11.2 of the protocol for details. handshakeHash :: Hash h => NoiseState c d h -> ScrubbedBytes handshakeHash ns = either id hashToBytes $ ns ^. nsHandshakeState . hsSymmetricState . ssh -- | Rekeys the sending @CipherState@ according to section 11.3 of the protocol. rekeySending :: (Cipher c, DH d, Hash h) => NoiseState c d h -> NoiseState c d h rekeySending ns = ns & nsSendingCipherState %~ (<*>) (pure rekey) -- | Rekeys the receiving @CipherState@ according to section 11.3 of the -- protocol. 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)