module Network.PeyoTLS.Monad (
TlsM, evalTlsM, S.initState,
tGet, tPut, tClose, tDebug, thlError,
withRandom,
getRBuf, setRBuf, getWBuf, setWBuf,
getAdBuf, setAdBuf,
getRSn, getWSn, sccRSn, sccWSn, rstRSn, rstWSn,
getCipherSuite, setCipherSuite,
getNames, setNames,
setKeys, getKeys,
S.SettingsS, getSettingsS, setSettingsS,
S.Alert(..), S.AlertLevel(..), S.AlertDesc(..),
S.ContentType(..),
S.CipherSuite(..), S.KeyEx(..), S.BulkEnc(..),
S.PartnerId, S.newPartnerId, S.Keys(..), S.nullKeys,
getClFinished, setClFinished,
getSvFinished, setSvFinished,
S.CertSecretKey(..), S.isRsaKey, S.isEcdsaKey,
SettingsC, getSettingsC, setSettingsC,
RW(..),
flushCipherSuite,
) where
import Control.Arrow ((***))
import Control.Monad (liftM)
import "monads-tf" Control.Monad.Trans (lift)
import "monads-tf" Control.Monad.State (StateT, evalStateT, gets, modify)
import "monads-tf" Control.Monad.Error (ErrorT, runErrorT, throwError)
import Data.Word (Word64)
import Data.HandleLike (HandleLike(..))
import qualified Data.ByteString as BS
import qualified Data.X509 as X509
import qualified Data.X509.CertificateStore as X509
import qualified Network.PeyoTLS.State as S (
HandshakeState, initState, PartnerId, newPartnerId, Keys(..), nullKeys,
ContentType(..), Alert(..), AlertLevel(..), AlertDesc(..),
CipherSuite(..), KeyEx(..), BulkEnc(..),
randomGen, setRandomGen,
setBuf, getBuf, setWBuf, getWBuf,
setAdBuf, getAdBuf,
getReadSN, getWriteSN, succReadSN, succWriteSN, resetReadSN, resetWriteSN,
getCipherSuite, setCipherSuite,
setNames, getNames,
setKeys, getKeys,
getSettings, setSettings,
getInitSet, setInitSet,
getClientFinished, setClientFinished,
getServerFinished, setServerFinished,
flushCipherSuiteRead, flushCipherSuiteWrite,
SettingsS, Settings,
CertSecretKey(..), isRsaKey, isEcdsaKey,
)
type TlsM h g = ErrorT S.Alert (StateT (S.HandshakeState h g) (HandleMonad h))
evalTlsM :: HandleLike h =>
TlsM h g a -> S.HandshakeState h g -> HandleMonad h (Either S.Alert a)
evalTlsM = evalStateT . runErrorT
getRBuf, getWBuf :: HandleLike h =>
S.PartnerId -> TlsM h g (S.ContentType, BS.ByteString)
getRBuf = gets . S.getBuf; getWBuf = gets . S.getWBuf
getAdBuf :: HandleLike h => S.PartnerId -> TlsM h g BS.ByteString
getAdBuf = gets . S.getAdBuf
setAdBuf :: HandleLike h => S.PartnerId -> BS.ByteString -> TlsM h g ()
setAdBuf = (modify .) . S.setAdBuf
setRBuf, setWBuf :: HandleLike h =>
S.PartnerId -> (S.ContentType, BS.ByteString) -> TlsM h g ()
setRBuf = (modify .) . S.setBuf; setWBuf = (modify .) . S.setWBuf
getWSn, getRSn :: HandleLike h => S.PartnerId -> TlsM h g Word64
getWSn = gets . S.getWriteSN; getRSn = gets . S.getReadSN
sccWSn, sccRSn :: HandleLike h => S.PartnerId -> TlsM h g ()
sccWSn = modify . S.succWriteSN; sccRSn = modify . S.succReadSN
rstWSn, rstRSn :: HandleLike h => S.PartnerId -> TlsM h g ()
rstWSn = modify . S.resetWriteSN; rstRSn = modify . S.resetReadSN
getCipherSuite :: HandleLike h => S.PartnerId -> TlsM h g S.CipherSuite
getCipherSuite = gets . S.getCipherSuite
setCipherSuite :: HandleLike h => S.PartnerId -> S.CipherSuite -> TlsM h g ()
setCipherSuite = (modify .) . S.setCipherSuite
getNames :: HandleLike h => S.PartnerId -> TlsM h g [String]
getNames = gets . S.getNames
setNames :: HandleLike h => S.PartnerId -> [String] -> TlsM h g ()
setNames = (modify .) . S.setNames
setKeys :: HandleLike h => S.PartnerId -> S.Keys -> TlsM h g ()
setKeys = (modify .) . S.setKeys
getKeys :: HandleLike h => S.PartnerId -> TlsM h g S.Keys
getKeys = gets . S.getKeys
getSettingsS :: HandleLike h => S.PartnerId -> TlsM h g S.SettingsS
getSettingsS = gets . S.getInitSet
getSettings :: HandleLike h => S.PartnerId -> TlsM h g S.Settings
getSettings = gets . S.getSettings
setSettingsS :: HandleLike h => S.PartnerId -> S.SettingsS -> TlsM h g ()
setSettingsS = (modify .) . S.setInitSet
setSettings :: HandleLike h => S.PartnerId -> S.Settings -> TlsM h g ()
setSettings = (modify .) . S.setSettings
getClFinished, getSvFinished ::
HandleLike h => S.PartnerId -> TlsM h g BS.ByteString
getClFinished = gets . S.getClientFinished
getSvFinished = gets . S.getServerFinished
setClFinished, setSvFinished ::
HandleLike h => S.PartnerId -> BS.ByteString -> TlsM h g ()
setClFinished = (modify .) . S.setClientFinished
setSvFinished = (modify .) . S.setServerFinished
flushCipherSuite :: HandleLike h => RW -> S.PartnerId -> TlsM h g ()
flushCipherSuite rw = case rw of
Read -> flushCipherSuiteRead
Write -> flushCipherSuiteWrite
flushCipherSuiteRead, flushCipherSuiteWrite ::
HandleLike h => S.PartnerId -> TlsM h g ()
flushCipherSuiteRead = modify . S.flushCipherSuiteRead
flushCipherSuiteWrite = modify . S.flushCipherSuiteWrite
withRandom :: HandleLike h => (gen -> (a, gen)) -> TlsM h gen a
withRandom p = p `liftM` gets S.randomGen >>=
uncurry (flip (>>)) . (return *** modify . S.setRandomGen)
tGet :: HandleLike h => h -> Int -> TlsM h g BS.ByteString
tGet = ((lift . lift) .) . hlGet
tPut :: HandleLike h => h -> BS.ByteString -> TlsM h g ()
tPut = ((lift . lift) .) . hlPut
tClose :: HandleLike h => h -> TlsM h g ()
tClose = lift . lift . hlClose
tDebug :: HandleLike h =>
h -> DebugLevel h -> BS.ByteString -> TlsM h gen ()
tDebug = (((lift . lift) .) .) . hlDebug
thlError :: HandleLike h => h -> BS.ByteString -> TlsM h g a
thlError = ((lift . lift) .) . hlError
getSettingsC :: HandleLike h => S.PartnerId -> TlsM h g SettingsC
getSettingsC i = do
(css, crts, mcs) <- getSettings i
case mcs of
Just cs -> return (css, crts, cs)
_ -> throwError "Network.PeyoTLS.Base.getSettingsC"
setSettingsC :: HandleLike h => S.PartnerId -> SettingsC -> TlsM h g ()
setSettingsC i (css, crts, cs) = setSettings i (css, crts, Just cs)
type SettingsC = (
[S.CipherSuite],
[(S.CertSecretKey, X509.CertificateChain)],
X509.CertificateStore )
data RW = Read | Write deriving Show