{-# LANGUAGE TemplateHaskell #-}
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
type ErrorPosition = (Int, Int)
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
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