{-# LANGUAGE TemplateHaskell #-}
-----------------------------------------------------------
-- |
-- Module      : Crypto.Noise.Internal.Handshake.Validation
-- Maintainer  : John Galt <jgalt@centromere.net>
-- Stability   : experimental
-- Portability : POSIX
module Crypto.Noise.Internal.Handshake.Validation where

import Control.Applicative.Free
import Control.Lens
import Control.Monad (when)
import Control.Monad.State

import Crypto.Noise.Internal.Handshake.Pattern

-- | @(message number, token number)@
--
--   Represents the location within the pattern at which an error resides,
--   starting with zero.
type ErrorPosition = (Int, Int)

-- | Represents a single error associated with a pattern.
--
--   * 'InitMultipleETokens', 'InitMultipleSTokens', 'RespMultipleETokens',
--     'RespMultipleSTokens' -- multiple @e@/@s@ tokens were encountered for a
--     message originating with the initiator/responder.
--
--   * 'InitSecretNotRandom', 'RespSecretNotRandom' -- From the protocol:
--
--     > After performing a DH between a remote public key and any local private
--     > key that is not an ephemeral private key, the local party must not send
--     > any encrypted data (i.e. must not call ENCRYPT()) unless it has also
--     > performed a DH between an ephemeral private key and the remote public
--     > key.
--
--   * 'DHInPreMsg' -- A DH token (such as @ee@ or @es@) was found in the
--     pre-message portion of the handshake.
--
--   * 'PSKInPreMsg' -- A @psk@ token was found in the pre-message portion of the
--     handshake.
--
--   * 'PSKWithoutEToken' -- A @psk@ token was used before an @e@ token was
--     encountered.
data InspectionError
  = InitMultipleETokens ErrorPosition
  | InitMultipleSTokens ErrorPosition
  | RespMultipleETokens ErrorPosition
  | RespMultipleSTokens ErrorPosition
  | InitSecretNotRandom ErrorPosition
  | RespSecretNotRandom ErrorPosition
  | DHInPreMsg          ErrorPosition
  | PSKInPreMsg         ErrorPosition
  | PSKWithoutEToken    ErrorPosition
  deriving Int -> InspectionError -> ShowS
[InspectionError] -> ShowS
InspectionError -> String
(Int -> InspectionError -> ShowS)
-> (InspectionError -> String)
-> ([InspectionError] -> ShowS)
-> Show InspectionError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InspectionError -> ShowS
showsPrec :: Int -> InspectionError -> ShowS
$cshow :: InspectionError -> String
show :: InspectionError -> String
$cshowList :: [InspectionError] -> ShowS
showList :: [InspectionError] -> ShowS
Show

data Inspection = Inspection
  { Inspection -> Bool
_iInitESent    :: Bool
  , Inspection -> Bool
_iInitSSent    :: Bool
  , Inspection -> Bool
_iInitPSKSent  :: Bool
  , Inspection -> Bool
_iRespESent    :: Bool
  , Inspection -> Bool
_iRespSSent    :: Bool
  , Inspection -> Bool
_iRespPSKSent  :: Bool
  , Inspection -> Bool
_iInitRandReq  :: Bool
  , Inspection -> Bool
_iInitRandDone :: Bool
  , Inspection -> Bool
_iRespRandReq  :: Bool
  , Inspection -> Bool
_iRespRandDone :: Bool
  , Inspection -> Int
_iCurTokenPos  :: Int
  , Inspection -> Int
_iCurMsgPos    :: Int
  , Inspection -> [InspectionError]
_iErrors       :: [InspectionError]
  } deriving Int -> Inspection -> ShowS
[Inspection] -> ShowS
Inspection -> String
(Int -> Inspection -> ShowS)
-> (Inspection -> String)
-> ([Inspection] -> ShowS)
-> Show Inspection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Inspection -> ShowS
showsPrec :: Int -> Inspection -> ShowS
$cshow :: Inspection -> String
show :: Inspection -> String
$cshowList :: [Inspection] -> ShowS
showList :: [Inspection] -> ShowS
Show

$(makeLenses ''Inspection)

inspection :: Inspection
inspection :: Inspection
inspection = Inspection
  { _iInitESent :: Bool
_iInitESent    = Bool
False
  , _iInitSSent :: Bool
_iInitSSent    = Bool
False
  , _iInitPSKSent :: Bool
_iInitPSKSent  = Bool
False
  , _iRespESent :: Bool
_iRespESent    = Bool
False
  , _iRespSSent :: Bool
_iRespSSent    = Bool
False
  , _iRespPSKSent :: Bool
_iRespPSKSent  = Bool
False
  , _iInitRandReq :: Bool
_iInitRandReq  = Bool
False
  , _iInitRandDone :: Bool
_iInitRandDone = Bool
False
  , _iRespRandReq :: Bool
_iRespRandReq  = Bool
False
  , _iRespRandDone :: Bool
_iRespRandDone = Bool
False
  , _iCurTokenPos :: Int
_iCurTokenPos  = Int
0
  , _iCurMsgPos :: Int
_iCurMsgPos    = Int
0
  , _iErrors :: [InspectionError]
_iErrors       = []
  }

verifyNotInPreMsg :: Message a -> State Inspection ()
verifyNotInPreMsg :: forall a. Message a -> State Inspection ()
verifyNotInPreMsg (PreInitiator MessagePattern ()
_ a
_) = (ErrorPosition -> InspectionError) -> State Inspection ()
addError ErrorPosition -> InspectionError
DHInPreMsg
verifyNotInPreMsg (PreResponder MessagePattern ()
_ a
_) = (ErrorPosition -> InspectionError) -> State Inspection ()
addError ErrorPosition -> InspectionError
DHInPreMsg
verifyNotInPreMsg (Initiator    MessagePattern ()
_ a
_) = () -> State Inspection ()
forall a. a -> StateT Inspection Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
verifyNotInPreMsg (Responder    MessagePattern ()
_ a
_) = () -> State Inspection ()
forall a. a -> StateT Inspection Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

verifyRandDoneIfReq :: Message a -> State Inspection ()
verifyRandDoneIfReq :: forall a. Message a -> State Inspection ()
verifyRandDoneIfReq (Initiator MessagePattern ()
_ a
_) = do
  Bool
initRandReq  <- Getting Bool Inspection Bool -> StateT Inspection Identity Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Bool Inspection Bool
Lens' Inspection Bool
iInitRandReq
  Bool
initRandDone <- Getting Bool Inspection Bool -> StateT Inspection Identity Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Bool Inspection Bool
Lens' Inspection Bool
iInitRandDone

  Bool -> State Inspection () -> State Inspection ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
initRandReq Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
initRandDone) (State Inspection () -> State Inspection ())
-> State Inspection () -> State Inspection ()
forall a b. (a -> b) -> a -> b
$ (ErrorPosition -> InspectionError) -> State Inspection ()
addError ErrorPosition -> InspectionError
InitSecretNotRandom

verifyRandDoneIfReq (Responder MessagePattern ()
_ a
_) = do
  Bool
respRandReq  <- Getting Bool Inspection Bool -> StateT Inspection Identity Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Bool Inspection Bool
Lens' Inspection Bool
iRespRandReq
  Bool
respRandDone <- Getting Bool Inspection Bool -> StateT Inspection Identity Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Bool Inspection Bool
Lens' Inspection Bool
iRespRandDone

  Bool -> State Inspection () -> State Inspection ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
respRandReq Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
respRandDone) (State Inspection () -> State Inspection ())
-> State Inspection () -> State Inspection ()
forall a b. (a -> b) -> a -> b
$ (ErrorPosition -> InspectionError) -> State Inspection ()
addError ErrorPosition -> InspectionError
RespSecretNotRandom

verifyRandDoneIfReq Message a
_ = () -> State Inspection ()
forall a. a -> StateT Inspection Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

verifyESentIfPSK :: Message a -> State Inspection ()
verifyESentIfPSK :: forall a. Message a -> State Inspection ()
verifyESentIfPSK (Initiator MessagePattern ()
_ a
_) = do
  Bool
initESent   <- Getting Bool Inspection Bool -> StateT Inspection Identity Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Bool Inspection Bool
Lens' Inspection Bool
iInitESent
  Bool
initPSKSent <- Getting Bool Inspection Bool -> StateT Inspection Identity Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Bool Inspection Bool
Lens' Inspection Bool
iInitPSKSent

  Bool -> State Inspection () -> State Inspection ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
initPSKSent Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
initESent) (State Inspection () -> State Inspection ())
-> State Inspection () -> State Inspection ()
forall a b. (a -> b) -> a -> b
$ (ErrorPosition -> InspectionError) -> State Inspection ()
addError ErrorPosition -> InspectionError
PSKWithoutEToken

verifyESentIfPSK (Responder MessagePattern ()
_ a
_) = do
  Bool
respESent   <- Getting Bool Inspection Bool -> StateT Inspection Identity Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Bool Inspection Bool
Lens' Inspection Bool
iRespESent
  Bool
respPSKSent <- Getting Bool Inspection Bool -> StateT Inspection Identity Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Bool Inspection Bool
Lens' Inspection Bool
iRespPSKSent

  Bool -> State Inspection () -> State Inspection ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
respPSKSent Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
respESent) (State Inspection () -> State Inspection ())
-> State Inspection () -> State Inspection ()
forall a b. (a -> b) -> a -> b
$ (ErrorPosition -> InspectionError) -> State Inspection ()
addError ErrorPosition -> InspectionError
PSKWithoutEToken

verifyESentIfPSK Message a
_ = () -> State Inspection ()
forall a. a -> StateT Inspection Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

continueToken :: a -> State Inspection a
continueToken :: forall a. a -> StateT Inspection Identity a
continueToken a
next = (Int -> Identity Int) -> Inspection -> Identity Inspection
Lens' Inspection Int
iCurTokenPos ((Int -> Identity Int) -> Inspection -> Identity Inspection)
-> (Int -> Int) -> State Inspection ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) State Inspection ()
-> StateT Inspection Identity a -> StateT Inspection Identity a
forall a b.
StateT Inspection Identity a
-> StateT Inspection Identity b -> StateT Inspection Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> StateT Inspection Identity a
forall a. a -> StateT Inspection Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return a
next

continueMsg :: a -> State Inspection a
continueMsg :: forall a. a -> StateT Inspection Identity a
continueMsg a
next = (Int -> Identity Int) -> Inspection -> Identity Inspection
Lens' Inspection Int
iCurTokenPos ((Int -> Identity Int) -> Inspection -> Identity Inspection)
-> Int -> State Inspection ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int
0 State Inspection () -> State Inspection () -> State Inspection ()
forall a b.
StateT Inspection Identity a
-> StateT Inspection Identity b -> StateT Inspection Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Int -> Identity Int) -> Inspection -> Identity Inspection
Lens' Inspection Int
iCurMsgPos ((Int -> Identity Int) -> Inspection -> Identity Inspection)
-> (Int -> Int) -> State Inspection ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) State Inspection ()
-> StateT Inspection Identity a -> StateT Inspection Identity a
forall a b.
StateT Inspection Identity a
-> StateT Inspection Identity b -> StateT Inspection Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> StateT Inspection Identity a
forall a. a -> StateT Inspection Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return a
next

addError :: (ErrorPosition -> InspectionError) -> State Inspection ()
addError :: (ErrorPosition -> InspectionError) -> State Inspection ()
addError ErrorPosition -> InspectionError
err = do
  Int
msgPos   <- Getting Int Inspection Int -> StateT Inspection Identity Int
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Int Inspection Int
Lens' Inspection Int
iCurMsgPos
  Int
tokenPos <- Getting Int Inspection Int -> StateT Inspection Identity Int
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Int Inspection Int
Lens' Inspection Int
iCurTokenPos
  ([InspectionError] -> Identity [InspectionError])
-> Inspection -> Identity Inspection
Lens' Inspection [InspectionError]
iErrors (([InspectionError] -> Identity [InspectionError])
 -> Inspection -> Identity Inspection)
-> [InspectionError] -> State Inspection ()
forall s (m :: * -> *) a.
(MonadState s m, Semigroup a) =>
ASetter' s a -> a -> m ()
<>= [ErrorPosition -> InspectionError
err (Int
msgPos, Int
tokenPos)]

inspectToken :: Message m -> Token a -> State Inspection a
inspectToken :: forall m a. Message m -> Token a -> State Inspection a
inspectToken Message m
m (E a
next) = do
  case Message m
m of
    PreInitiator MessagePattern ()
_ m
_ -> State Inspection ()
checkInit
    PreResponder MessagePattern ()
_ m
_ -> State Inspection ()
checkResp
    Initiator    MessagePattern ()
_ m
_ -> State Inspection ()
checkInit
    Responder    MessagePattern ()
_ m
_ -> State Inspection ()
checkResp

  a -> State Inspection a
forall a. a -> StateT Inspection Identity a
continueToken a
next

  where
    checkInit :: State Inspection ()
checkInit = do
      Bool
initESent <- Getting Bool Inspection Bool -> StateT Inspection Identity Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Bool Inspection Bool
Lens' Inspection Bool
iInitESent
      if Bool
initESent
        then (ErrorPosition -> InspectionError) -> State Inspection ()
addError ErrorPosition -> InspectionError
InitMultipleETokens
        else (Bool -> Identity Bool) -> Inspection -> Identity Inspection
Lens' Inspection Bool
iInitESent ((Bool -> Identity Bool) -> Inspection -> Identity Inspection)
-> Bool -> State Inspection ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True

    checkResp :: State Inspection ()
checkResp = do
      Bool
respESent <- Getting Bool Inspection Bool -> StateT Inspection Identity Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Bool Inspection Bool
Lens' Inspection Bool
iRespESent
      if Bool
respESent
        then (ErrorPosition -> InspectionError) -> State Inspection ()
addError ErrorPosition -> InspectionError
RespMultipleETokens
        else (Bool -> Identity Bool) -> Inspection -> Identity Inspection
Lens' Inspection Bool
iRespESent ((Bool -> Identity Bool) -> Inspection -> Identity Inspection)
-> Bool -> State Inspection ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True

inspectToken Message m
m (S a
next) = do
  case Message m
m of
    PreInitiator MessagePattern ()
_ m
_ -> State Inspection ()
checkInit
    PreResponder MessagePattern ()
_ m
_ -> State Inspection ()
checkResp
    Initiator    MessagePattern ()
_ m
_ -> State Inspection ()
checkInit
    Responder    MessagePattern ()
_ m
_ -> State Inspection ()
checkResp

  a -> State Inspection a
forall a. a -> StateT Inspection Identity a
continueToken a
next

  where
    checkInit :: State Inspection ()
checkInit = do
      Bool
initSSent <- Getting Bool Inspection Bool -> StateT Inspection Identity Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Bool Inspection Bool
Lens' Inspection Bool
iInitSSent
      if Bool
initSSent
        then (ErrorPosition -> InspectionError) -> State Inspection ()
addError ErrorPosition -> InspectionError
InitMultipleSTokens
        else (Bool -> Identity Bool) -> Inspection -> Identity Inspection
Lens' Inspection Bool
iInitSSent ((Bool -> Identity Bool) -> Inspection -> Identity Inspection)
-> Bool -> State Inspection ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True

    checkResp :: State Inspection ()
checkResp = do
      Bool
respSSent <- Getting Bool Inspection Bool -> StateT Inspection Identity Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Bool Inspection Bool
Lens' Inspection Bool
iRespSSent
      if Bool
respSSent
        then (ErrorPosition -> InspectionError) -> State Inspection ()
addError ErrorPosition -> InspectionError
RespMultipleSTokens
        else (Bool -> Identity Bool) -> Inspection -> Identity Inspection
Lens' Inspection Bool
iRespSSent ((Bool -> Identity Bool) -> Inspection -> Identity Inspection)
-> Bool -> State Inspection ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True

inspectToken Message m
m (Ee a
next) = do
  Message m -> State Inspection ()
forall a. Message a -> State Inspection ()
verifyNotInPreMsg Message m
m

  (Bool -> Identity Bool) -> Inspection -> Identity Inspection
Lens' Inspection Bool
iInitRandDone ((Bool -> Identity Bool) -> Inspection -> Identity Inspection)
-> Bool -> State Inspection ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
  (Bool -> Identity Bool) -> Inspection -> Identity Inspection
Lens' Inspection Bool
iRespRandDone ((Bool -> Identity Bool) -> Inspection -> Identity Inspection)
-> Bool -> State Inspection ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True

  a -> State Inspection a
forall a. a -> StateT Inspection Identity a
continueToken a
next

inspectToken Message m
m (Es a
next) = do
  Message m -> State Inspection ()
forall a. Message a -> State Inspection ()
verifyNotInPreMsg Message m
m

  (Bool -> Identity Bool) -> Inspection -> Identity Inspection
Lens' Inspection Bool
iInitRandDone ((Bool -> Identity Bool) -> Inspection -> Identity Inspection)
-> Bool -> State Inspection ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
  (Bool -> Identity Bool) -> Inspection -> Identity Inspection
Lens' Inspection Bool
iRespRandReq  ((Bool -> Identity Bool) -> Inspection -> Identity Inspection)
-> Bool -> State Inspection ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True

  a -> State Inspection a
forall a. a -> StateT Inspection Identity a
continueToken a
next

inspectToken Message m
m (Se a
next) = do
  Message m -> State Inspection ()
forall a. Message a -> State Inspection ()
verifyNotInPreMsg Message m
m

  (Bool -> Identity Bool) -> Inspection -> Identity Inspection
Lens' Inspection Bool
iInitRandReq  ((Bool -> Identity Bool) -> Inspection -> Identity Inspection)
-> Bool -> State Inspection ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
  (Bool -> Identity Bool) -> Inspection -> Identity Inspection
Lens' Inspection Bool
iRespRandDone ((Bool -> Identity Bool) -> Inspection -> Identity Inspection)
-> Bool -> State Inspection ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True

  a -> State Inspection a
forall a. a -> StateT Inspection Identity a
continueToken a
next

inspectToken Message m
m (Ss a
next) = do
  Message m -> State Inspection ()
forall a. Message a -> State Inspection ()
verifyNotInPreMsg Message m
m

  (Bool -> Identity Bool) -> Inspection -> Identity Inspection
Lens' Inspection Bool
iInitRandReq ((Bool -> Identity Bool) -> Inspection -> Identity Inspection)
-> Bool -> State Inspection ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
  (Bool -> Identity Bool) -> Inspection -> Identity Inspection
Lens' Inspection Bool
iRespRandReq ((Bool -> Identity Bool) -> Inspection -> Identity Inspection)
-> Bool -> State Inspection ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True

  a -> State Inspection a
forall a. a -> StateT Inspection Identity a
continueToken a
next

inspectToken Message m
m (Psk a
next) = do
  case Message m
m of
    PreInitiator MessagePattern ()
_ m
_ -> (ErrorPosition -> InspectionError) -> State Inspection ()
addError ErrorPosition -> InspectionError
PSKInPreMsg
    PreResponder MessagePattern ()
_ m
_ -> (ErrorPosition -> InspectionError) -> State Inspection ()
addError ErrorPosition -> InspectionError
PSKInPreMsg
    Initiator    MessagePattern ()
_ m
_ -> (Bool -> Identity Bool) -> Inspection -> Identity Inspection
Lens' Inspection Bool
iInitPSKSent ((Bool -> Identity Bool) -> Inspection -> Identity Inspection)
-> Bool -> State Inspection ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
    Responder    MessagePattern ()
_ m
_ -> (Bool -> Identity Bool) -> Inspection -> Identity Inspection
Lens' Inspection Bool
iRespPSKSent ((Bool -> Identity Bool) -> Inspection -> Identity Inspection)
-> Bool -> State Inspection ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True

  a -> State Inspection a
forall a. a -> StateT Inspection Identity a
continueToken a
next

inspectMessage :: Message a -> State Inspection a
inspectMessage :: forall a. Message a -> State Inspection a
inspectMessage m :: Message a
m@(PreInitiator MessagePattern ()
mp a
next) = do
  (forall x. Token x -> StateT Inspection Identity x)
-> MessagePattern () -> State Inspection ()
forall (g :: * -> *) (f :: * -> *) a.
Applicative g =>
(forall x. f x -> g x) -> Ap f a -> g a
runAp (Message a -> Token x -> StateT Inspection Identity x
forall m a. Message m -> Token a -> State Inspection a
inspectToken Message a
m) MessagePattern ()
mp
  a -> State Inspection a
forall a. a -> StateT Inspection Identity a
continueMsg a
next

inspectMessage m :: Message a
m@(PreResponder MessagePattern ()
mp a
next) = do
  (forall x. Token x -> StateT Inspection Identity x)
-> MessagePattern () -> State Inspection ()
forall (g :: * -> *) (f :: * -> *) a.
Applicative g =>
(forall x. f x -> g x) -> Ap f a -> g a
runAp (Message a -> Token x -> StateT Inspection Identity x
forall m a. Message m -> Token a -> State Inspection a
inspectToken Message a
m) MessagePattern ()
mp
  a -> State Inspection a
forall a. a -> StateT Inspection Identity a
continueMsg a
next

inspectMessage m :: Message a
m@(Initiator MessagePattern ()
mp a
next) = do
  (forall x. Token x -> StateT Inspection Identity x)
-> MessagePattern () -> State Inspection ()
forall (g :: * -> *) (f :: * -> *) a.
Applicative g =>
(forall x. f x -> g x) -> Ap f a -> g a
runAp (Message a -> Token x -> StateT Inspection Identity x
forall m a. Message m -> Token a -> State Inspection a
inspectToken Message a
m) MessagePattern ()
mp
  Message a -> State Inspection ()
forall a. Message a -> State Inspection ()
verifyRandDoneIfReq Message a
m
  Message a -> State Inspection ()
forall a. Message a -> State Inspection ()
verifyESentIfPSK Message a
m
  a -> State Inspection a
forall a. a -> StateT Inspection Identity a
continueMsg a
next

inspectMessage m :: Message a
m@(Responder MessagePattern ()
mp a
next) = do
  (forall x. Token x -> StateT Inspection Identity x)
-> MessagePattern () -> State Inspection ()
forall (g :: * -> *) (f :: * -> *) a.
Applicative g =>
(forall x. f x -> g x) -> Ap f a -> g a
runAp (Message a -> Token x -> StateT Inspection Identity x
forall m a. Message m -> Token a -> State Inspection a
inspectToken Message a
m) MessagePattern ()
mp
  Message a -> State Inspection ()
forall a. Message a -> State Inspection ()
verifyRandDoneIfReq Message a
m
  Message a -> State Inspection ()
forall a. Message a -> State Inspection ()
verifyESentIfPSK Message a
m
  a -> State Inspection a
forall a. a -> StateT Inspection Identity a
continueMsg a
next

-- | Validates a 'HandshakePattern' according to the rules defined in section
--   7.1 and 9.3 of the protocol. If no violations are found, the result will be
--   an empty list.
validateHandshakePattern :: HandshakePattern -> [InspectionError]
validateHandshakePattern :: HandshakePattern -> [InspectionError]
validateHandshakePattern HandshakePattern
hp = State Inspection () -> Inspection -> Inspection
forall s a. State s a -> s -> s
execState ((forall a. Message a -> State Inspection a)
-> Ap Message () -> State Inspection ()
forall (g :: * -> *) (f :: * -> *) a.
Applicative g =>
(forall x. f x -> g x) -> Ap f a -> g a
runAp Message x -> State Inspection x
forall a. Message a -> State Inspection a
inspectMessage (Ap Message () -> State Inspection ())
-> Ap Message () -> State Inspection ()
forall a b. (a -> b) -> a -> b
$ HandshakePattern
hp HandshakePattern
-> Getting (Ap Message ()) HandshakePattern (Ap Message ())
-> Ap Message ()
forall s a. s -> Getting a s a -> a
^. Getting (Ap Message ()) HandshakePattern (Ap Message ())
Lens' HandshakePattern (Ap Message ())
hpMsgSeq) Inspection
inspection Inspection
-> Getting [InspectionError] Inspection [InspectionError]
-> [InspectionError]
forall s a. s -> Getting a s a -> a
^. Getting [InspectionError] Inspection [InspectionError]
Lens' Inspection [InspectionError]
iErrors