yogsototh/hs-tls
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

separate handshake state from state.

Browse source
This commit is contained in:
Vincent Hanquez 2013-07-18 07:19:05 +01:00
parent 8f99c325fb
commit 8f83319fae
3 changed files with 83 additions and 39 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

78
core/Network/TLS/Handshake/State.hs Normal file
View file

@ -0,0 +1,78 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE CPP #-}
-- |
-- Module : Network.TLS.Handshake.State
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : unknown
--
module Network.TLS.Handshake.State
( HandshakeState(..)
, ClientCertRequestData
, HandshakeM
, newEmptyHandshake
) where
import Network.TLS.Util
import Network.TLS.Struct
import Network.TLS.Packet
import Network.TLS.Crypto
import qualified Data.ByteString as B
import Control.Applicative ((<$>))
import Control.Monad
import Control.Monad.State
import Control.Monad.Error
import Data.X509 (CertificateChain)
data HandshakeState = HandshakeState
{ hstClientVersion :: !(Version)
, hstClientRandom :: !ClientRandom
, hstServerRandom :: !(Maybe ServerRandom)
, hstMasterSecret :: !(Maybe Bytes)
, hstRSAPublicKey :: !(Maybe PubKey)
, hstRSAPrivateKey :: !(Maybe PrivKey)
, hstRSAClientPublicKey :: !(Maybe PubKey)
, hstRSAClientPrivateKey :: !(Maybe PrivKey)
, hstHandshakeDigest :: !HashCtx
, hstHandshakeMessages :: [Bytes]
, hstClientCertRequest :: !(Maybe ClientCertRequestData) -- ^ Set to Just-value when certificate request was received
, hstClientCertSent :: !Bool -- ^ Set to true when a client certificate chain was sent
, hstCertReqSent :: !Bool -- ^ Set to true when a certificate request was sent
, hstClientCertChain :: !(Maybe CertificateChain)
} deriving (Show)
type ClientCertRequestData = ([CertificateType],
Maybe [(HashAlgorithm, SignatureAlgorithm)],
[DistinguishedName])
newtype HandshakeM a = HandshakeM { runHandshakeM :: ErrorT TLSError (State HandshakeState) a }
deriving (Functor, Monad, MonadError TLSError)
instance MonadState HandshakeState HandshakeM where
put x = HandshakeM (lift $ put x)
get = HandshakeM (lift get)
#if MIN_VERSION_mtl(2,1,0)
state f = HandshakeM (lift $ state f)
#endif
-- create a new empty handshake state
newEmptyHandshake :: Version -> ClientRandom -> HashCtx -> HandshakeState
newEmptyHandshake ver crand digestInit = HandshakeState
{ hstClientVersion = ver
, hstClientRandom = crand
, hstServerRandom = Nothing
, hstMasterSecret = Nothing
, hstRSAPublicKey = Nothing
, hstRSAPrivateKey = Nothing
, hstRSAClientPublicKey = Nothing
, hstRSAClientPrivateKey = Nothing
, hstHandshakeDigest = digestInit
, hstHandshakeMessages = []
, hstClientCertRequest = Nothing
, hstClientCertSent = False
, hstCertReqSent = False
, hstClientCertChain = Nothing
}

43
core/Network/TLS/State.hs
View file

@ -16,7 +16,8 @@ module Network.TLS.State
, getRecordState
, runTLSState
, runRecordStateSt
, TLSHandshakeState(..)
, HandshakeState(..)
, TLSHandshakeState
, newTLSState
, withTLSRNG
, genRandom
@ -81,6 +82,7 @@ import Network.TLS.Packet
import Network.TLS.Crypto
import Network.TLS.Cipher
import Network.TLS.Record.State
import Network.TLS.Handshake.State
import Network.TLS.RNG
import qualified Data.ByteString as B
import Control.Applicative ((<$>))
@ -94,26 +96,7 @@ assert :: Monad m => String -> [(String,Bool)] -> m ()
assert fctname list = forM_ list $ \ (name, assumption) -> do
when assumption $ fail (fctname ++ ": assumption about " ++ name ++ " failed")
type ClientCertRequestData = ([CertificateType],
Maybe [(HashAlgorithm, SignatureAlgorithm)],
[DistinguishedName])
data TLSHandshakeState = TLSHandshakeState
{ hstClientVersion :: !(Version)
, hstClientRandom :: !ClientRandom
, hstServerRandom :: !(Maybe ServerRandom)
, hstMasterSecret :: !(Maybe Bytes)
, hstRSAPublicKey :: !(Maybe PubKey)
, hstRSAPrivateKey :: !(Maybe PrivKey)
, hstRSAClientPublicKey :: !(Maybe PubKey)
, hstRSAClientPrivateKey :: !(Maybe PrivKey)
, hstHandshakeDigest :: !HashCtx
, hstHandshakeMessages :: [Bytes]
, hstClientCertRequest :: !(Maybe ClientCertRequestData) -- ^ Set to Just-value when certificate request was received
, hstClientCertSent :: !Bool -- ^ Set to true when a client certificate chain was sent
, hstCertReqSent :: !Bool -- ^ Set to true when a certificate request was sent
, hstClientCertChain :: !(Maybe CertificateChain)
} deriving (Show)
type TLSHandshakeState = HandshakeState
data TLSState = TLSState
{ stHandshake :: !(Maybe TLSHandshakeState)
@ -398,24 +381,6 @@ getVerifiedData client = gets (if client then stClientVerifiedData else stServer
isClientContext :: MonadState TLSState m => m Bool
isClientContext = getRecordState stClientContext
-- create a new empty handshake state
newEmptyHandshake :: Version -> ClientRandom -> HashCtx -> TLSHandshakeState
newEmptyHandshake ver crand digestInit = TLSHandshakeState
{ hstClientVersion = ver
, hstClientRandom = crand
, hstServerRandom = Nothing
, hstMasterSecret = Nothing
, hstRSAPublicKey = Nothing
, hstRSAPrivateKey = Nothing
, hstRSAClientPublicKey = Nothing
, hstRSAClientPrivateKey = Nothing
, hstHandshakeDigest = digestInit
, hstHandshakeMessages = []
, hstClientCertRequest = Nothing
, hstClientCertSent = False
, hstCertReqSent = False
, hstClientCertChain = Nothing
}
startHandshakeClient :: MonadState TLSState m => Version -> ClientRandom -> m ()
startHandshakeClient ver crand = do

1
core/tls.cabal
View file

@ -58,6 +58,7 @@ Library
Network.TLS.Handshake.Client
Network.TLS.Handshake.Server
Network.TLS.Handshake.Signature
Network.TLS.Handshake.State
Network.TLS.IO
Network.TLS.MAC
Network.TLS.Measurement