{-# LANGUAGE OverloadedStrings #-}
-- |
-- Module      : Network.TLS.Packet
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : unknown
--
-- the Packet module contains everything necessary to serialize and deserialize things
-- with only explicit parameters, no TLS state is involved here.
--
module Network.TLS.Packet
    (
    -- * params for encoding and decoding
      CurrentParams(..)
    -- * marshall functions for header messages
    , decodeHeader
    , decodeDeprecatedHeaderLength
    , decodeDeprecatedHeader
    , encodeHeader
    , encodeHeaderNoVer -- use for SSL3

    -- * marshall functions for alert messages
    , decodeAlert
    , decodeAlerts
    , encodeAlerts

    -- * marshall functions for handshake messages
    , decodeHandshakeRecord
    , decodeHandshake
    , decodeDeprecatedHandshake
    , encodeHandshake
    , encodeHandshakeHeader
    , encodeHandshakeContent

    -- * marshall functions for change cipher spec message
    , decodeChangeCipherSpec
    , encodeChangeCipherSpec

    , decodePreMasterSecret
    , encodePreMasterSecret
    , encodeSignedDHParams
    , encodeSignedECDHParams

    , decodeReallyServerKeyXchgAlgorithmData

    -- * generate things for packet content
    , generateMasterSecret
    , generateExtendedMasterSec
    , generateKeyBlock
    , generateClientFinished
    , generateServerFinished

    , generateCertificateVerify_SSL
    , generateCertificateVerify_SSL_DSS

    -- * for extensions parsing
    , getSignatureHashAlgorithm
    , putSignatureHashAlgorithm
    , getBinaryVersion
    , putBinaryVersion
    , getClientRandom32
    , putClientRandom32
    , getServerRandom32
    , putServerRandom32
    , getExtensions
    , putExtension
    , getSession
    , putSession
    , putDNames
    , getDNames
    ) where

import Network.TLS.Imports
import Network.TLS.Struct
import Network.TLS.Wire
import Network.TLS.Cap
import Data.X509 (CertificateChainRaw(..), encodeCertificateChain, decodeCertificateChain)
import Network.TLS.Crypto
import Network.TLS.MAC
import Network.TLS.Cipher (CipherKeyExchangeType(..), Cipher(..))
import Network.TLS.Util.ASN1
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC
import           Data.ByteArray (ByteArrayAccess)
import qualified Data.ByteArray as B (convert)

data CurrentParams = CurrentParams
    { CurrentParams -> Version
cParamsVersion     :: Version                     -- ^ current protocol version
    , CurrentParams -> Maybe CipherKeyExchangeType
cParamsKeyXchgType :: Maybe CipherKeyExchangeType -- ^ current key exchange type
    } deriving (Int -> CurrentParams -> ShowS
[CurrentParams] -> ShowS
CurrentParams -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [CurrentParams] -> ShowS
$cshowList :: [CurrentParams] -> ShowS
show :: CurrentParams -> [Char]
$cshow :: CurrentParams -> [Char]
showsPrec :: Int -> CurrentParams -> ShowS
$cshowsPrec :: Int -> CurrentParams -> ShowS
Show,CurrentParams -> CurrentParams -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CurrentParams -> CurrentParams -> Bool
$c/= :: CurrentParams -> CurrentParams -> Bool
== :: CurrentParams -> CurrentParams -> Bool
$c== :: CurrentParams -> CurrentParams -> Bool
Eq)

{- marshall helpers -}
getVersion :: Get Version
getVersion :: Get Version
getVersion = do
    Word8
major <- Get Word8
getWord8
    Word8
minor <- Get Word8
getWord8
    case (Word8, Word8) -> Maybe Version
verOfNum (Word8
major, Word8
minor) of
        Maybe Version
Nothing -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"invalid version : " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Word8
major forall a. [a] -> [a] -> [a]
++ [Char]
"," forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Word8
minor)
        Just Version
v  -> forall (m :: * -> *) a. Monad m => a -> m a
return Version
v

getBinaryVersion :: Get (Maybe Version)
getBinaryVersion :: Get (Maybe Version)
getBinaryVersion = do
    Word8
major <- Get Word8
getWord8
    Word8
minor <- Get Word8
getWord8
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (Word8, Word8) -> Maybe Version
verOfNum (Word8
major, Word8
minor)

putBinaryVersion :: Version -> Put
putBinaryVersion :: Version -> Put
putBinaryVersion Version
ver = Putter Word8
putWord8 Word8
major forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Word8
putWord8 Word8
minor
  where (Word8
major, Word8
minor) = Version -> (Word8, Word8)
numericalVer Version
ver

getHeaderType :: Get ProtocolType
getHeaderType :: Get ProtocolType
getHeaderType = do
    Word8
ty <- Get Word8
getWord8
    case forall a. TypeValuable a => Word8 -> Maybe a
valToType Word8
ty of
        Maybe ProtocolType
Nothing -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"invalid header type: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Word8
ty)
        Just ProtocolType
t  -> forall (m :: * -> *) a. Monad m => a -> m a
return ProtocolType
t

putHeaderType :: ProtocolType -> Put
putHeaderType :: ProtocolType -> Put
putHeaderType = Putter Word8
putWord8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TypeValuable a => a -> Word8
valOfType

getHandshakeType :: Get HandshakeType
getHandshakeType :: Get HandshakeType
getHandshakeType = do
    Word8
ty <- Get Word8
getWord8
    case forall a. TypeValuable a => Word8 -> Maybe a
valToType Word8
ty of
        Maybe HandshakeType
Nothing -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"invalid handshake type: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Word8
ty)
        Just HandshakeType
t  -> forall (m :: * -> *) a. Monad m => a -> m a
return HandshakeType
t

{-
 - decode and encode headers
 -}
decodeHeader :: ByteString -> Either TLSError Header
decodeHeader :: ByteString -> Either TLSError Header
decodeHeader = forall a. [Char] -> Get a -> ByteString -> Either TLSError a
runGetErr [Char]
"header" forall a b. (a -> b) -> a -> b
$ ProtocolType -> Version -> Word16 -> Header
Header forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ProtocolType
getHeaderType forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Version
getVersion forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
getWord16

decodeDeprecatedHeaderLength :: ByteString -> Either TLSError Word16
decodeDeprecatedHeaderLength :: ByteString -> Either TLSError Word16
decodeDeprecatedHeaderLength = forall a. [Char] -> Get a -> ByteString -> Either TLSError a
runGetErr [Char]
"deprecatedheaderlength" forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a -> a
subtract Word16
0x8000 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16

decodeDeprecatedHeader :: Word16 -> ByteString -> Either TLSError Header
decodeDeprecatedHeader :: Word16 -> ByteString -> Either TLSError Header
decodeDeprecatedHeader Word16
size =
    forall a. [Char] -> Get a -> ByteString -> Either TLSError a
runGetErr [Char]
"deprecatedheader" forall a b. (a -> b) -> a -> b
$ do
        Word8
1 <- Get Word8
getWord8
        Version
version <- Get Version
getVersion
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ProtocolType -> Version -> Word16 -> Header
Header ProtocolType
ProtocolType_DeprecatedHandshake Version
version Word16
size

encodeHeader :: Header -> ByteString
encodeHeader :: Header -> ByteString
encodeHeader (Header ProtocolType
pt Version
ver Word16
len) = Put -> ByteString
runPut (ProtocolType -> Put
putHeaderType ProtocolType
pt forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Version -> Put
putBinaryVersion Version
ver forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word16 -> Put
putWord16 Word16
len)
        {- FIXME check len <= 2^14 -}

encodeHeaderNoVer :: Header -> ByteString
encodeHeaderNoVer :: Header -> ByteString
encodeHeaderNoVer (Header ProtocolType
pt Version
_ Word16
len) = Put -> ByteString
runPut (ProtocolType -> Put
putHeaderType ProtocolType
pt forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word16 -> Put
putWord16 Word16
len)
        {- FIXME check len <= 2^14 -}

{-
 - decode and encode ALERT
 -}
decodeAlert :: Get (AlertLevel, AlertDescription)
decodeAlert :: Get (AlertLevel, AlertDescription)
decodeAlert = do
    Word8
al <- Get Word8
getWord8
    Word8
ad <- Get Word8
getWord8
    case (forall a. TypeValuable a => Word8 -> Maybe a
valToType Word8
al, forall a. TypeValuable a => Word8 -> Maybe a
valToType Word8
ad) of
        (Just AlertLevel
a, Just AlertDescription
d) -> forall (m :: * -> *) a. Monad m => a -> m a
return (AlertLevel
a, AlertDescription
d)
        (Maybe AlertLevel
Nothing, Maybe AlertDescription
_)     -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"cannot decode alert level"
        (Maybe AlertLevel
_, Maybe AlertDescription
Nothing)     -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"cannot decode alert description"

decodeAlerts :: ByteString -> Either TLSError [(AlertLevel, AlertDescription)]
decodeAlerts :: ByteString -> Either TLSError [(AlertLevel, AlertDescription)]
decodeAlerts = forall a. [Char] -> Get a -> ByteString -> Either TLSError a
runGetErr [Char]
"alerts" Get [(AlertLevel, AlertDescription)]
loop
  where loop :: Get [(AlertLevel, AlertDescription)]
loop = do
            Int
r <- Get Int
remaining
            if Int
r forall a. Eq a => a -> a -> Bool
== Int
0
                then forall (m :: * -> *) a. Monad m => a -> m a
return []
                else (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (AlertLevel, AlertDescription)
decodeAlert forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get [(AlertLevel, AlertDescription)]
loop

encodeAlerts :: [(AlertLevel, AlertDescription)] -> ByteString
encodeAlerts :: [(AlertLevel, AlertDescription)] -> ByteString
encodeAlerts [(AlertLevel, AlertDescription)]
l = Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall {a} {a}. (TypeValuable a, TypeValuable a) => (a, a) -> Put
encodeAlert [(AlertLevel, AlertDescription)]
l
  where encodeAlert :: (a, a) -> Put
encodeAlert (a
al, a
ad) = Putter Word8
putWord8 (forall a. TypeValuable a => a -> Word8
valOfType a
al) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Word8
putWord8 (forall a. TypeValuable a => a -> Word8
valOfType a
ad)

{- decode and encode HANDSHAKE -}
decodeHandshakeRecord :: ByteString -> GetResult (HandshakeType, ByteString)
decodeHandshakeRecord :: ByteString -> GetResult (HandshakeType, ByteString)
decodeHandshakeRecord = forall a. [Char] -> Get a -> ByteString -> GetResult a
runGet [Char]
"handshake-record" forall a b. (a -> b) -> a -> b
$ do
    HandshakeType
ty      <- Get HandshakeType
getHandshakeType
    ByteString
content <- Get ByteString
getOpaque24
    forall (m :: * -> *) a. Monad m => a -> m a
return (HandshakeType
ty, ByteString
content)

decodeHandshake :: CurrentParams -> HandshakeType -> ByteString -> Either TLSError Handshake
decodeHandshake :: CurrentParams
-> HandshakeType -> ByteString -> Either TLSError Handshake
decodeHandshake CurrentParams
cp HandshakeType
ty = forall a. [Char] -> Get a -> ByteString -> Either TLSError a
runGetErr ([Char]
"handshake[" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show HandshakeType
ty forall a. [a] -> [a] -> [a]
++ [Char]
"]") forall a b. (a -> b) -> a -> b
$ case HandshakeType
ty of
    HandshakeType
HandshakeType_HelloRequest    -> Get Handshake
decodeHelloRequest
    HandshakeType
HandshakeType_ClientHello     -> Get Handshake
decodeClientHello
    HandshakeType
HandshakeType_ServerHello     -> Get Handshake
decodeServerHello
    HandshakeType
HandshakeType_Certificate     -> Get Handshake
decodeCertificates
    HandshakeType
HandshakeType_ServerKeyXchg   -> CurrentParams -> Get Handshake
decodeServerKeyXchg CurrentParams
cp
    HandshakeType
HandshakeType_CertRequest     -> CurrentParams -> Get Handshake
decodeCertRequest CurrentParams
cp
    HandshakeType
HandshakeType_ServerHelloDone -> Get Handshake
decodeServerHelloDone
    HandshakeType
HandshakeType_CertVerify      -> CurrentParams -> Get Handshake
decodeCertVerify CurrentParams
cp
    HandshakeType
HandshakeType_ClientKeyXchg   -> CurrentParams -> Get Handshake
decodeClientKeyXchg CurrentParams
cp
    HandshakeType
HandshakeType_Finished        -> Get Handshake
decodeFinished

decodeDeprecatedHandshake :: ByteString -> Either TLSError Handshake
decodeDeprecatedHandshake :: ByteString -> Either TLSError Handshake
decodeDeprecatedHandshake ByteString
b = forall a. [Char] -> Get a -> ByteString -> Either TLSError a
runGetErr [Char]
"deprecatedhandshake" Get Handshake
getDeprecated ByteString
b
  where getDeprecated :: Get Handshake
getDeprecated = do
            Word8
1 <- Get Word8
getWord8
            Version
ver <- Get Version
getVersion
            Int
cipherSpecLen <- forall a. Enum a => a -> Int
fromEnum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16
            Int
sessionIdLen <- forall a. Enum a => a -> Int
fromEnum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16
            Int
challengeLen <- forall a. Enum a => a -> Int
fromEnum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16
            [Word16]
ciphers <- forall {t} {a}. (Ord t, Num t, Enum a) => t -> Get [a]
getCipherSpec Int
cipherSpecLen
            Session
session <- Int -> Get Session
getSessionId Int
sessionIdLen
            ClientRandom
random <- Int -> Get ClientRandom
getChallenge Int
challengeLen
            let compressions :: [Word8]
compressions = [Word8
0]
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Version
-> ClientRandom
-> Session
-> [Word16]
-> [Word8]
-> [ExtensionRaw]
-> Maybe ByteString
-> Handshake
ClientHello Version
ver ClientRandom
random Session
session [Word16]
ciphers [Word8]
compressions [] (forall a. a -> Maybe a
Just ByteString
b)
        getCipherSpec :: t -> Get [a]
getCipherSpec t
len | t
len forall a. Ord a => a -> a -> Bool
< t
3 = forall (m :: * -> *) a. Monad m => a -> m a
return []
        getCipherSpec t
len = do
            [Int
c0,Int
c1,Int
c2] <- forall a b. (a -> b) -> [a] -> [b]
map forall a. Enum a => a -> Int
fromEnum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
3 Get Word8
getWord8
            ([ forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ Int
c1 forall a. Num a => a -> a -> a
* Int
0x100 forall a. Num a => a -> a -> a
+ Int
c2 | Int
c0 forall a. Eq a => a -> a -> Bool
== Int
0 ] forall a. [a] -> [a] -> [a]
++) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t -> Get [a]
getCipherSpec (t
len forall a. Num a => a -> a -> a
- t
3)
        getSessionId :: Int -> Get Session
getSessionId Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe ByteString -> Session
Session forall a. Maybe a
Nothing
        getSessionId Int
len = Maybe ByteString -> Session
Session forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getBytes Int
len
        getChallenge :: Int -> Get ClientRandom
getChallenge Int
len | Int
32 forall a. Ord a => a -> a -> Bool
< Int
len = Int -> Get ByteString
getBytes (Int
len forall a. Num a => a -> a -> a
- Int
32) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Get ClientRandom
getChallenge Int
32
        getChallenge Int
len = ByteString -> ClientRandom
ClientRandom forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> ByteString
B.append (Int -> Word8 -> ByteString
B.replicate (Int
32 forall a. Num a => a -> a -> a
- Int
len) Word8
0) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getBytes Int
len

decodeHelloRequest :: Get Handshake
decodeHelloRequest :: Get Handshake
decodeHelloRequest = forall (m :: * -> *) a. Monad m => a -> m a
return Handshake
HelloRequest

decodeClientHello :: Get Handshake
decodeClientHello :: Get Handshake
decodeClientHello = do
    Version
ver          <- Get Version
getVersion
    ClientRandom
random       <- Get ClientRandom
getClientRandom32
    Session
session      <- Get Session
getSession
    [Word16]
ciphers      <- Get [Word16]
getWords16
    [Word8]
compressions <- Get [Word8]
getWords8
    Int
r            <- Get Int
remaining
    [ExtensionRaw]
exts <- if Version -> Bool
hasHelloExtensions Version
ver Bool -> Bool -> Bool
&& Int
r forall a. Ord a => a -> a -> Bool
> Int
0
            then forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get [ExtensionRaw]
getExtensions
            else do
               Int
rest <- Get Int
remaining
               ByteString
_ <- Int -> Get ByteString
getBytes Int
rest
               forall (m :: * -> *) a. Monad m => a -> m a
return []
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Version
-> ClientRandom
-> Session
-> [Word16]
-> [Word8]
-> [ExtensionRaw]
-> Maybe ByteString
-> Handshake
ClientHello Version
ver ClientRandom
random Session
session [Word16]
ciphers [Word8]
compressions [ExtensionRaw]
exts forall a. Maybe a
Nothing

decodeServerHello :: Get Handshake
decodeServerHello :: Get Handshake
decodeServerHello = do
    Version
ver           <- Get Version
getVersion
    ServerRandom
random        <- Get ServerRandom
getServerRandom32
    Session
session       <- Get Session
getSession
    Word16
cipherid      <- Get Word16
getWord16
    Word8
compressionid <- Get Word8
getWord8
    Int
r             <- Get Int
remaining
    [ExtensionRaw]
exts <- if Version -> Bool
hasHelloExtensions Version
ver Bool -> Bool -> Bool
&& Int
r forall a. Ord a => a -> a -> Bool
> Int
0
            then forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get [ExtensionRaw]
getExtensions
            else forall (m :: * -> *) a. Monad m => a -> m a
return []
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Version
-> ServerRandom
-> Session
-> Word16
-> Word8
-> [ExtensionRaw]
-> Handshake
ServerHello Version
ver ServerRandom
random Session
session Word16
cipherid Word8
compressionid [ExtensionRaw]
exts

decodeServerHelloDone :: Get Handshake
decodeServerHelloDone :: Get Handshake
decodeServerHelloDone = forall (m :: * -> *) a. Monad m => a -> m a
return Handshake
ServerHelloDone

decodeCertificates :: Get Handshake
decodeCertificates :: Get Handshake
decodeCertificates = do
    CertificateChainRaw
certsRaw <- [ByteString] -> CertificateChainRaw
CertificateChainRaw forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get Int
getWord24 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
len -> forall a. Int -> Get (Int, a) -> Get [a]
getList (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) Get (Int, ByteString)
getCertRaw)
    case CertificateChainRaw -> Either (Int, [Char]) CertificateChain
decodeCertificateChain CertificateChainRaw
certsRaw of
        Left (Int
i, [Char]
s) -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"error certificate parsing " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
i forall a. [a] -> [a] -> [a]
++ [Char]
":" forall a. [a] -> [a] -> [a]
++ [Char]
s)
        Right CertificateChain
cc    -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ CertificateChain -> Handshake
Certificates CertificateChain
cc
  where getCertRaw :: Get (Int, ByteString)
getCertRaw = Get ByteString
getOpaque24 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ByteString
cert -> forall (m :: * -> *) a. Monad m => a -> m a
return (Int
3 forall a. Num a => a -> a -> a
+ ByteString -> Int
B.length ByteString
cert, ByteString
cert)

decodeFinished :: Get Handshake
decodeFinished :: Get Handshake
decodeFinished = ByteString -> Handshake
Finished forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get Int
remaining forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get ByteString
getBytes)

decodeCertRequest :: CurrentParams -> Get Handshake
decodeCertRequest :: CurrentParams -> Get Handshake
decodeCertRequest CurrentParams
cp = do
    [Maybe CertificateType]
mcertTypes <- forall a b. (a -> b) -> [a] -> [b]
map (forall a. TypeValuable a => Word8 -> Maybe a
valToType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [Word8]
getWords8
    [CertificateType]
certTypes <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *) a. MonadFail m => [Char] -> Maybe a -> m a
fromJustM [Char]
"decodeCertRequest") [Maybe CertificateType]
mcertTypes
    Maybe [HashAndSignatureAlgorithm]
sigHashAlgs <- if CurrentParams -> Version
cParamsVersion CurrentParams
cp forall a. Ord a => a -> a -> Bool
>= Version
TLS12
                       then forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get Word16
getWord16 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {a}. Integral a => a -> Get [HashAndSignatureAlgorithm]
getSignatureHashAlgorithms)
                       else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    [CertificateType]
-> Maybe [HashAndSignatureAlgorithm]
-> [DistinguishedName]
-> Handshake
CertRequest [CertificateType]
certTypes Maybe [HashAndSignatureAlgorithm]
sigHashAlgs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [DistinguishedName]
getDNames
  where getSignatureHashAlgorithms :: a -> Get [HashAndSignatureAlgorithm]
getSignatureHashAlgorithms a
len = forall a. Int -> Get (Int, a) -> Get [a]
getList (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
len) (Get HashAndSignatureAlgorithm
getSignatureHashAlgorithm forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \HashAndSignatureAlgorithm
sh -> forall (m :: * -> *) a. Monad m => a -> m a
return (Int
2, HashAndSignatureAlgorithm
sh))

-- | Decode a list CA distinguished names
getDNames :: Get [DistinguishedName]
getDNames :: Get [DistinguishedName]
getDNames = do
    Word16
dNameLen <- Get Word16
getWord16
    -- FIXME: Decide whether to remove this check completely or to make it an option.
    -- when (cParamsVersion cp < TLS12 && dNameLen < 3) $ fail "certrequest distinguishname not of the correct size"
    forall a. Int -> Get (Int, a) -> Get [a]
getList (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
dNameLen) Get (Int, DistinguishedName)
getDName
  where
    getDName :: Get (Int, DistinguishedName)
getDName = do
        ByteString
dName <- Get ByteString
getOpaque16
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Int
B.length ByteString
dName forall a. Eq a => a -> a -> Bool
== Int
0) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"certrequest: invalid DN length"
        DistinguishedName
dn <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. ASN1Object a => [Char] -> ByteString -> Either [Char] a
decodeASN1Object [Char]
"cert request DistinguishedName" ByteString
dName
        forall (m :: * -> *) a. Monad m => a -> m a
return (Int
2 forall a. Num a => a -> a -> a
+ ByteString -> Int
B.length ByteString
dName, DistinguishedName
dn)

decodeCertVerify :: CurrentParams -> Get Handshake
decodeCertVerify :: CurrentParams -> Get Handshake
decodeCertVerify CurrentParams
cp = DigitallySigned -> Handshake
CertVerify forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Version -> Get DigitallySigned
getDigitallySigned (CurrentParams -> Version
cParamsVersion CurrentParams
cp)

decodeClientKeyXchg :: CurrentParams -> Get Handshake
decodeClientKeyXchg :: CurrentParams -> Get Handshake
decodeClientKeyXchg CurrentParams
cp = -- case  ClientKeyXchg <$> (remaining >>= getBytes)
    case CurrentParams -> Maybe CipherKeyExchangeType
cParamsKeyXchgType CurrentParams
cp of
        Maybe CipherKeyExchangeType
Nothing  -> forall a. HasCallStack => [Char] -> a
error [Char]
"no client key exchange type"
        Just CipherKeyExchangeType
cke -> ClientKeyXchgAlgorithmData -> Handshake
ClientKeyXchg forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CipherKeyExchangeType -> Get ClientKeyXchgAlgorithmData
parseCKE CipherKeyExchangeType
cke
  where parseCKE :: CipherKeyExchangeType -> Get ClientKeyXchgAlgorithmData
parseCKE CipherKeyExchangeType
CipherKeyExchange_RSA     = ByteString -> ClientKeyXchgAlgorithmData
CKX_RSA forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get Int
remaining forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get ByteString
getBytes)
        parseCKE CipherKeyExchangeType
CipherKeyExchange_DHE_RSA = Get ClientKeyXchgAlgorithmData
parseClientDHPublic
        parseCKE CipherKeyExchangeType
CipherKeyExchange_DHE_DSS = Get ClientKeyXchgAlgorithmData
parseClientDHPublic
        parseCKE CipherKeyExchangeType
CipherKeyExchange_DH_Anon = Get ClientKeyXchgAlgorithmData
parseClientDHPublic
        parseCKE CipherKeyExchangeType
CipherKeyExchange_ECDHE_RSA   = Get ClientKeyXchgAlgorithmData
parseClientECDHPublic
        parseCKE CipherKeyExchangeType
CipherKeyExchange_ECDHE_ECDSA = Get ClientKeyXchgAlgorithmData
parseClientECDHPublic
        parseCKE CipherKeyExchangeType
_                         = forall a. HasCallStack => [Char] -> a
error [Char]
"unsupported client key exchange type"
        parseClientDHPublic :: Get ClientKeyXchgAlgorithmData
parseClientDHPublic = DHPublic -> ClientKeyXchgAlgorithmData
CKX_DH forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> DHPublic
dhPublic forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Integer
getInteger16
        parseClientECDHPublic :: Get ClientKeyXchgAlgorithmData
parseClientECDHPublic = ByteString -> ClientKeyXchgAlgorithmData
CKX_ECDH forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getOpaque8

decodeServerKeyXchg_DH :: Get ServerDHParams
decodeServerKeyXchg_DH :: Get ServerDHParams
decodeServerKeyXchg_DH = Get ServerDHParams
getServerDHParams

-- We don't support ECDH_Anon at this moment
-- decodeServerKeyXchg_ECDH :: Get ServerECDHParams

decodeServerKeyXchg_RSA :: Get ServerRSAParams
decodeServerKeyXchg_RSA :: Get ServerRSAParams
decodeServerKeyXchg_RSA = Integer -> Integer -> ServerRSAParams
ServerRSAParams forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Integer
getInteger16 -- modulus
                                          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Integer
getInteger16 -- exponent

decodeServerKeyXchgAlgorithmData :: Version
                                 -> CipherKeyExchangeType
                                 -> Get ServerKeyXchgAlgorithmData
decodeServerKeyXchgAlgorithmData :: Version -> CipherKeyExchangeType -> Get ServerKeyXchgAlgorithmData
decodeServerKeyXchgAlgorithmData Version
ver CipherKeyExchangeType
cke = Get ServerKeyXchgAlgorithmData
toCKE
  where toCKE :: Get ServerKeyXchgAlgorithmData
toCKE = case CipherKeyExchangeType
cke of
            CipherKeyExchangeType
CipherKeyExchange_RSA     -> Maybe ServerRSAParams -> ServerKeyXchgAlgorithmData
SKX_RSA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ServerRSAParams
decodeServerKeyXchg_RSA
            CipherKeyExchangeType
CipherKeyExchange_DH_Anon -> ServerDHParams -> ServerKeyXchgAlgorithmData
SKX_DH_Anon forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ServerDHParams
decodeServerKeyXchg_DH
            CipherKeyExchangeType
CipherKeyExchange_DHE_RSA -> do
                ServerDHParams
dhparams  <- Get ServerDHParams
getServerDHParams
                DigitallySigned
signature <- Version -> Get DigitallySigned
getDigitallySigned Version
ver
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ServerDHParams -> DigitallySigned -> ServerKeyXchgAlgorithmData
SKX_DHE_RSA ServerDHParams
dhparams DigitallySigned
signature
            CipherKeyExchangeType
CipherKeyExchange_DHE_DSS -> do
                ServerDHParams
dhparams  <- Get ServerDHParams
getServerDHParams
                DigitallySigned
signature <- Version -> Get DigitallySigned
getDigitallySigned Version
ver
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ServerDHParams -> DigitallySigned -> ServerKeyXchgAlgorithmData
SKX_DHE_DSS ServerDHParams
dhparams DigitallySigned
signature
            CipherKeyExchangeType
CipherKeyExchange_ECDHE_RSA -> do
                ServerECDHParams
ecdhparams  <- Get ServerECDHParams
getServerECDHParams
                DigitallySigned
signature <- Version -> Get DigitallySigned
getDigitallySigned Version
ver
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ServerECDHParams -> DigitallySigned -> ServerKeyXchgAlgorithmData
SKX_ECDHE_RSA ServerECDHParams
ecdhparams DigitallySigned
signature
            CipherKeyExchangeType
CipherKeyExchange_ECDHE_ECDSA -> do
                ServerECDHParams
ecdhparams  <- Get ServerECDHParams
getServerECDHParams
                DigitallySigned
signature <- Version -> Get DigitallySigned
getDigitallySigned Version
ver
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ServerECDHParams -> DigitallySigned -> ServerKeyXchgAlgorithmData
SKX_ECDHE_ECDSA ServerECDHParams
ecdhparams DigitallySigned
signature
            CipherKeyExchangeType
_ -> do
                ByteString
bs <- Get Int
remaining forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get ByteString
getBytes
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> ServerKeyXchgAlgorithmData
SKX_Unknown ByteString
bs

decodeServerKeyXchg :: CurrentParams -> Get Handshake
decodeServerKeyXchg :: CurrentParams -> Get Handshake
decodeServerKeyXchg CurrentParams
cp =
    case CurrentParams -> Maybe CipherKeyExchangeType
cParamsKeyXchgType CurrentParams
cp of
        Just CipherKeyExchangeType
cke -> ServerKeyXchgAlgorithmData -> Handshake
ServerKeyXchg forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Version -> CipherKeyExchangeType -> Get ServerKeyXchgAlgorithmData
decodeServerKeyXchgAlgorithmData (CurrentParams -> Version
cParamsVersion CurrentParams
cp) CipherKeyExchangeType
cke
        Maybe CipherKeyExchangeType
Nothing  -> ServerKeyXchgAlgorithmData -> Handshake
ServerKeyXchg forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ServerKeyXchgAlgorithmData
SKX_Unparsed forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get Int
remaining forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get ByteString
getBytes)

encodeHandshake :: Handshake -> ByteString
encodeHandshake :: Handshake -> ByteString
encodeHandshake Handshake
o =
    let content :: ByteString
content = Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ Handshake -> Put
encodeHandshakeContent Handshake
o in
    let len :: Int
len = ByteString -> Int
B.length ByteString
content in
    let header :: ByteString
header = case Handshake
o of
                    ClientHello Version
_ ClientRandom
_ Session
_ [Word16]
_ [Word8]
_ [ExtensionRaw]
_ (Just ByteString
_) -> ByteString
"" -- SSLv2 ClientHello message
                    Handshake
_ -> Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ HandshakeType -> Int -> Put
encodeHandshakeHeader (Handshake -> HandshakeType
typeOfHandshake Handshake
o) Int
len in
    [ByteString] -> ByteString
B.concat [ ByteString
header, ByteString
content ]

encodeHandshakeHeader :: HandshakeType -> Int -> Put
encodeHandshakeHeader :: HandshakeType -> Int -> Put
encodeHandshakeHeader HandshakeType
ty Int
len = Putter Word8
putWord8 (forall a. TypeValuable a => a -> Word8
valOfType HandshakeType
ty) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Put
putWord24 Int
len

encodeHandshakeContent :: Handshake -> Put

encodeHandshakeContent :: Handshake -> Put
encodeHandshakeContent (ClientHello Version
_ ClientRandom
_ Session
_ [Word16]
_ [Word8]
_ [ExtensionRaw]
_ (Just ByteString
deprecated)) = do
    ByteString -> Put
putBytes ByteString
deprecated
encodeHandshakeContent (ClientHello Version
version ClientRandom
random Session
session [Word16]
cipherIDs [Word8]
compressionIDs [ExtensionRaw]
exts Maybe ByteString
Nothing) = do
    Version -> Put
putBinaryVersion Version
version
    ClientRandom -> Put
putClientRandom32 ClientRandom
random
    Session -> Put
putSession Session
session
    [Word16] -> Put
putWords16 [Word16]
cipherIDs
    [Word8] -> Put
putWords8 [Word8]
compressionIDs
    [ExtensionRaw] -> Put
putExtensions [ExtensionRaw]
exts
    forall (m :: * -> *) a. Monad m => a -> m a
return ()

encodeHandshakeContent (ServerHello Version
version ServerRandom
random Session
session Word16
cipherid Word8
compressionID [ExtensionRaw]
exts) = do
    Version -> Put
putBinaryVersion Version
version
    ServerRandom -> Put
putServerRandom32 ServerRandom
random
    Session -> Put
putSession Session
session
    Word16 -> Put
putWord16 Word16
cipherid
    Putter Word8
putWord8 Word8
compressionID
    [ExtensionRaw] -> Put
putExtensions [ExtensionRaw]
exts
    forall (m :: * -> *) a. Monad m => a -> m a
return ()

encodeHandshakeContent (Certificates CertificateChain
cc) = ByteString -> Put
putOpaque24 (Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ByteString -> Put
putOpaque24 [ByteString]
certs)
  where (CertificateChainRaw [ByteString]
certs) = CertificateChain -> CertificateChainRaw
encodeCertificateChain CertificateChain
cc

encodeHandshakeContent (ClientKeyXchg ClientKeyXchgAlgorithmData
ckx) = do
    case ClientKeyXchgAlgorithmData
ckx of
        CKX_RSA ByteString
encryptedPreMaster -> ByteString -> Put
putBytes ByteString
encryptedPreMaster
        CKX_DH DHPublic
clientDHPublic      -> Integer -> Put
putInteger16 forall a b. (a -> b) -> a -> b
$ DHPublic -> Integer
dhUnwrapPublic DHPublic
clientDHPublic
        CKX_ECDH ByteString
bytes             -> ByteString -> Put
putOpaque8 ByteString
bytes

encodeHandshakeContent (ServerKeyXchg ServerKeyXchgAlgorithmData
skg) =
    case ServerKeyXchgAlgorithmData
skg of
        SKX_RSA Maybe ServerRSAParams
_              -> forall a. HasCallStack => [Char] -> a
error [Char]
"encodeHandshakeContent SKX_RSA not implemented"
        SKX_DH_Anon ServerDHParams
params     -> ServerDHParams -> Put
putServerDHParams ServerDHParams
params
        SKX_DHE_RSA ServerDHParams
params DigitallySigned
sig -> ServerDHParams -> Put
putServerDHParams ServerDHParams
params forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DigitallySigned -> Put
putDigitallySigned DigitallySigned
sig
        SKX_DHE_DSS ServerDHParams
params DigitallySigned
sig -> ServerDHParams -> Put
putServerDHParams ServerDHParams
params forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DigitallySigned -> Put
putDigitallySigned DigitallySigned
sig
        SKX_ECDHE_RSA ServerECDHParams
params DigitallySigned
sig -> ServerECDHParams -> Put
putServerECDHParams ServerECDHParams
params forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DigitallySigned -> Put
putDigitallySigned DigitallySigned
sig
        SKX_ECDHE_ECDSA ServerECDHParams
params DigitallySigned
sig -> ServerECDHParams -> Put
putServerECDHParams ServerECDHParams
params forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DigitallySigned -> Put
putDigitallySigned DigitallySigned
sig
        SKX_Unparsed ByteString
bytes     -> ByteString -> Put
putBytes ByteString
bytes
        ServerKeyXchgAlgorithmData
_                      -> forall a. HasCallStack => [Char] -> a
error ([Char]
"encodeHandshakeContent: cannot handle: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show ServerKeyXchgAlgorithmData
skg)

encodeHandshakeContent Handshake
HelloRequest    = forall (m :: * -> *) a. Monad m => a -> m a
return ()
encodeHandshakeContent Handshake
ServerHelloDone = forall (m :: * -> *) a. Monad m => a -> m a
return ()

encodeHandshakeContent (CertRequest [CertificateType]
certTypes Maybe [HashAndSignatureAlgorithm]
sigAlgs [DistinguishedName]
certAuthorities) = do
    [Word8] -> Put
putWords8 (forall a b. (a -> b) -> [a] -> [b]
map forall a. TypeValuable a => a -> Word8
valOfType [CertificateType]
certTypes)
    case Maybe [HashAndSignatureAlgorithm]
sigAlgs of
        Maybe [HashAndSignatureAlgorithm]
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just [HashAndSignatureAlgorithm]
l  -> [Word16] -> Put
putWords16 forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(HashAlgorithm
x,SignatureAlgorithm
y) -> forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. TypeValuable a => a -> Word8
valOfType HashAlgorithm
x) forall a. Num a => a -> a -> a
* Word16
256 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. TypeValuable a => a -> Word8
valOfType SignatureAlgorithm
y)) [HashAndSignatureAlgorithm]
l
    [DistinguishedName] -> Put
putDNames [DistinguishedName]
certAuthorities

encodeHandshakeContent (CertVerify DigitallySigned
digitallySigned) = DigitallySigned -> Put
putDigitallySigned DigitallySigned
digitallySigned

encodeHandshakeContent (Finished ByteString
opaque) = ByteString -> Put
putBytes ByteString
opaque

------------------------------------------------------------

-- | Encode a list of distinguished names.
putDNames :: [DistinguishedName] -> Put
putDNames :: [DistinguishedName] -> Put
putDNames [DistinguishedName]
dnames = do
    [ByteString]
enc <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {m :: * -> *} {a}.
(Monad m, ASN1Object a) =>
a -> m ByteString
encodeCA [DistinguishedName]
dnames
    let totLength :: Int
totLength = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. Num a => a -> a -> a
(+) Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
B.length) [ByteString]
enc
    Word16 -> Put
putWord16 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
totLength)
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\ ByteString
b -> Word16 -> Put
putWord16 (forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
b)) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Put
putBytes ByteString
b) [ByteString]
enc
  where
    -- Convert a distinguished name to its DER encoding.
    encodeCA :: a -> m ByteString
encodeCA a
dn = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. ASN1Object a => a -> ByteString
encodeASN1Object a
dn

{- FIXME make sure it return error if not 32 available -}
getRandom32 :: Get ByteString
getRandom32 :: Get ByteString
getRandom32 = Int -> Get ByteString
getBytes Int
32

getServerRandom32 :: Get ServerRandom
getServerRandom32 :: Get ServerRandom
getServerRandom32 = ByteString -> ServerRandom
ServerRandom forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getRandom32

getClientRandom32 :: Get ClientRandom
getClientRandom32 :: Get ClientRandom
getClientRandom32 = ByteString -> ClientRandom
ClientRandom forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getRandom32

putRandom32 :: ByteString -> Put
putRandom32 :: ByteString -> Put
putRandom32 = ByteString -> Put
putBytes

putClientRandom32 :: ClientRandom -> Put
putClientRandom32 :: ClientRandom -> Put
putClientRandom32 (ClientRandom ByteString
r) = ByteString -> Put
putRandom32 ByteString
r

putServerRandom32 :: ServerRandom -> Put
putServerRandom32 :: ServerRandom -> Put
putServerRandom32 (ServerRandom ByteString
r) = ByteString -> Put
putRandom32 ByteString
r

getSession :: Get Session
getSession :: Get Session
getSession = do
    Word8
len8 <- Get Word8
getWord8
    case forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
len8 of
        Int
0   -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe ByteString -> Session
Session forall a. Maybe a
Nothing
        Int
len -> Maybe ByteString -> Session
Session forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getBytes Int
len

putSession :: Session -> Put
putSession :: Session -> Put
putSession (Session Maybe ByteString
Nothing)  = Putter Word8
putWord8 Word8
0
putSession (Session (Just ByteString
s)) = ByteString -> Put
putOpaque8 ByteString
s

getExtensions :: Int -> Get [ExtensionRaw]
getExtensions :: Int -> Get [ExtensionRaw]
getExtensions Int
0   = forall (m :: * -> *) a. Monad m => a -> m a
return []
getExtensions Int
len = do
    Word16
extty <- Get Word16
getWord16
    Word16
extdatalen <- Get Word16
getWord16
    ByteString
extdata <- Int -> Get ByteString
getBytes forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
extdatalen
    [ExtensionRaw]
extxs <- Int -> Get [ExtensionRaw]
getExtensions (Int
len forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
extdatalen forall a. Num a => a -> a -> a
- Int
4)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Word16 -> ByteString -> ExtensionRaw
ExtensionRaw Word16
extty ByteString
extdata forall a. a -> [a] -> [a]
: [ExtensionRaw]
extxs

putExtension :: ExtensionRaw -> Put
putExtension :: ExtensionRaw -> Put
putExtension (ExtensionRaw Word16
ty ByteString
l) = Word16 -> Put
putWord16 Word16
ty forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Put
putOpaque16 ByteString
l

putExtensions :: [ExtensionRaw] -> Put
putExtensions :: [ExtensionRaw] -> Put
putExtensions [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
putExtensions [ExtensionRaw]
es = ByteString -> Put
putOpaque16 (Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ExtensionRaw -> Put
putExtension [ExtensionRaw]
es)

getSignatureHashAlgorithm :: Get HashAndSignatureAlgorithm
getSignatureHashAlgorithm :: Get HashAndSignatureAlgorithm
getSignatureHashAlgorithm = do
    HashAlgorithm
h <- (forall a. TypeValuable a => Word8 -> Maybe a
valToType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. MonadFail m => [Char] -> Maybe a -> m a
fromJustM [Char]
"getSignatureHashAlgorithm"
    SignatureAlgorithm
s <- (forall a. TypeValuable a => Word8 -> Maybe a
valToType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. MonadFail m => [Char] -> Maybe a -> m a
fromJustM [Char]
"getSignatureHashAlgorithm"
    forall (m :: * -> *) a. Monad m => a -> m a
return (HashAlgorithm
h,SignatureAlgorithm
s)

putSignatureHashAlgorithm :: HashAndSignatureAlgorithm -> Put
putSignatureHashAlgorithm :: HashAndSignatureAlgorithm -> Put
putSignatureHashAlgorithm (HashAlgorithm
h,SignatureAlgorithm
s) =
    Putter Word8
putWord8 (forall a. TypeValuable a => a -> Word8
valOfType HashAlgorithm
h) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Word8
putWord8 (forall a. TypeValuable a => a -> Word8
valOfType SignatureAlgorithm
s)

getServerDHParams :: Get ServerDHParams
getServerDHParams :: Get ServerDHParams
getServerDHParams = BigNum -> BigNum -> BigNum -> ServerDHParams
ServerDHParams forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get BigNum
getBigNum16 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get BigNum
getBigNum16 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get BigNum
getBigNum16

putServerDHParams :: ServerDHParams -> Put
putServerDHParams :: ServerDHParams -> Put
putServerDHParams (ServerDHParams BigNum
p BigNum
g BigNum
y) = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ BigNum -> Put
putBigNum16 [BigNum
p,BigNum
g,BigNum
y]

-- RFC 4492 Section 5.4 Server Key Exchange
getServerECDHParams :: Get ServerECDHParams
getServerECDHParams :: Get ServerECDHParams
getServerECDHParams = do
    Word8
curveType <- Get Word8
getWord8
    case Word8
curveType of
        Word8
3 -> do               -- ECParameters ECCurveType: curve name type
            Maybe Group
mgrp <- forall a. EnumSafe16 a => Word16 -> Maybe a
toEnumSafe16 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16  -- ECParameters NamedCurve
            case Maybe Group
mgrp of
              Maybe Group
Nothing -> forall a. HasCallStack => [Char] -> a
error [Char]
"getServerECDHParams: unknown group"
              Just Group
grp -> do
                  ByteString
mxy <- Get ByteString
getOpaque8 -- ECPoint
                  case Group -> ByteString -> Either CryptoError GroupPublic
decodeGroupPublic Group
grp ByteString
mxy of
                    Left CryptoError
e       -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"getServerECDHParams: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show CryptoError
e
                    Right GroupPublic
grppub -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Group -> GroupPublic -> ServerECDHParams
ServerECDHParams Group
grp GroupPublic
grppub
        Word8
_ ->
            forall a. HasCallStack => [Char] -> a
error [Char]
"getServerECDHParams: unknown type for ECDH Params"

-- RFC 4492 Section 5.4 Server Key Exchange
putServerECDHParams :: ServerECDHParams -> Put
putServerECDHParams :: ServerECDHParams -> Put
putServerECDHParams (ServerECDHParams Group
grp GroupPublic
grppub) = do
    Putter Word8
putWord8 Word8
3                            -- ECParameters ECCurveType
    Word16 -> Put
putWord16 forall a b. (a -> b) -> a -> b
$ forall a. EnumSafe16 a => a -> Word16
fromEnumSafe16 Group
grp        -- ECParameters NamedCurve
    ByteString -> Put
putOpaque8 forall a b. (a -> b) -> a -> b
$ GroupPublic -> ByteString
encodeGroupPublic GroupPublic
grppub -- ECPoint

getDigitallySigned :: Version -> Get DigitallySigned
getDigitallySigned :: Version -> Get DigitallySigned
getDigitallySigned Version
ver
    | Version
ver forall a. Ord a => a -> a -> Bool
>= Version
TLS12 = Maybe HashAndSignatureAlgorithm -> ByteString -> DigitallySigned
DigitallySigned forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get HashAndSignatureAlgorithm
getSignatureHashAlgorithm)
                                     forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get ByteString
getOpaque16
    | Bool
otherwise    = Maybe HashAndSignatureAlgorithm -> ByteString -> DigitallySigned
DigitallySigned forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getOpaque16

putDigitallySigned :: DigitallySigned -> Put
putDigitallySigned :: DigitallySigned -> Put
putDigitallySigned (DigitallySigned Maybe HashAndSignatureAlgorithm
mhash ByteString
sig) =
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) HashAndSignatureAlgorithm -> Put
putSignatureHashAlgorithm Maybe HashAndSignatureAlgorithm
mhash forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Put
putOpaque16 ByteString
sig

{-
 - decode and encode ALERT
 -}

decodeChangeCipherSpec :: ByteString -> Either TLSError ()
decodeChangeCipherSpec :: ByteString -> Either TLSError ()
decodeChangeCipherSpec = forall a. [Char] -> Get a -> ByteString -> Either TLSError a
runGetErr [Char]
"changecipherspec" forall a b. (a -> b) -> a -> b
$ do
    Word8
x <- Get Word8
getWord8
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
x forall a. Eq a => a -> a -> Bool
/= Word8
1) (forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"unknown change cipher spec content")

encodeChangeCipherSpec :: ByteString
encodeChangeCipherSpec :: ByteString
encodeChangeCipherSpec = Put -> ByteString
runPut (Putter Word8
putWord8 Word8
1)

-- rsa pre master secret
decodePreMasterSecret :: ByteString -> Either TLSError (Version, ByteString)
decodePreMasterSecret :: ByteString -> Either TLSError (Version, ByteString)
decodePreMasterSecret = forall a. [Char] -> Get a -> ByteString -> Either TLSError a
runGetErr [Char]
"pre-master-secret" forall a b. (a -> b) -> a -> b
$
    (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Version
getVersion forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Get ByteString
getBytes Int
46

encodePreMasterSecret :: Version -> ByteString -> ByteString
encodePreMasterSecret :: Version -> ByteString -> ByteString
encodePreMasterSecret Version
version ByteString
bytes = Put -> ByteString
runPut (Version -> Put
putBinaryVersion Version
version forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Put
putBytes ByteString
bytes)

-- | in certain cases, we haven't manage to decode ServerKeyExchange properly,
-- because the decoding was too eager and the cipher wasn't been set yet.
-- we keep the Server Key Exchange in it unparsed format, and this function is
-- able to really decode the server key xchange if it's unparsed.
decodeReallyServerKeyXchgAlgorithmData :: Version
                                       -> CipherKeyExchangeType
                                       -> ByteString
                                       -> Either TLSError ServerKeyXchgAlgorithmData
decodeReallyServerKeyXchgAlgorithmData :: Version
-> CipherKeyExchangeType
-> ByteString
-> Either TLSError ServerKeyXchgAlgorithmData
decodeReallyServerKeyXchgAlgorithmData Version
ver CipherKeyExchangeType
cke =
    forall a. [Char] -> Get a -> ByteString -> Either TLSError a
runGetErr [Char]
"server-key-xchg-algorithm-data" (Version -> CipherKeyExchangeType -> Get ServerKeyXchgAlgorithmData
decodeServerKeyXchgAlgorithmData Version
ver CipherKeyExchangeType
cke)


{-
 - generate things for packet content
 -}
type PRF = ByteString -> ByteString -> Int -> ByteString

-- | The TLS12 PRF is cipher specific, and some TLS12 algorithms use SHA384
-- instead of the default SHA256.
getPRF :: Version -> Cipher -> PRF
getPRF :: Version -> Cipher -> PRF
getPRF Version
ver Cipher
ciph
    | Version
ver forall a. Ord a => a -> a -> Bool
< Version
TLS12 = PRF
prf_MD5SHA1
    | forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (forall a. Ord a => a -> a -> Bool
< Version
TLS12) (Cipher -> Maybe Version
cipherMinVer Cipher
ciph) = PRF
prf_SHA256
    | Bool
otherwise = Version -> Hash -> PRF
prf_TLS Version
ver forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Hash
SHA256 forall a b. (a -> b) -> a -> b
$ Cipher -> Maybe Hash
cipherPRFHash Cipher
ciph

generateMasterSecret_SSL :: ByteArrayAccess preMaster => preMaster -> ClientRandom -> ServerRandom -> ByteString
generateMasterSecret_SSL :: forall preMaster.
ByteArrayAccess preMaster =>
preMaster -> ClientRandom -> ServerRandom -> ByteString
generateMasterSecret_SSL preMaster
premasterSecret (ClientRandom ByteString
c) (ServerRandom ByteString
s) =
    [ByteString] -> ByteString
B.concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ByteString -> ByteString
computeMD5 [ByteString
"A",ByteString
"BB",ByteString
"CCC"]
  where computeMD5 :: ByteString -> ByteString
computeMD5  ByteString
label = Hash -> ByteString -> ByteString
hash Hash
MD5 forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
B.concat [ forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert preMaster
premasterSecret, ByteString -> ByteString
computeSHA1 ByteString
label ]
        computeSHA1 :: ByteString -> ByteString
computeSHA1 ByteString
label = Hash -> ByteString -> ByteString
hash Hash
SHA1 forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
B.concat [ ByteString
label, forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert preMaster
premasterSecret, ByteString
c, ByteString
s ]

generateMasterSecret_TLS :: ByteArrayAccess preMaster => PRF -> preMaster -> ClientRandom -> ServerRandom -> ByteString
generateMasterSecret_TLS :: forall preMaster.
ByteArrayAccess preMaster =>
PRF -> preMaster -> ClientRandom -> ServerRandom -> ByteString
generateMasterSecret_TLS PRF
prf preMaster
premasterSecret (ClientRandom ByteString
c) (ServerRandom ByteString
s) =
    PRF
prf (forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert preMaster
premasterSecret) ByteString
seed Int
48
  where seed :: ByteString
seed = [ByteString] -> ByteString
B.concat [ ByteString
"master secret", ByteString
c, ByteString
s ]

generateMasterSecret :: ByteArrayAccess preMaster
                     => Version
                     -> Cipher
                     -> preMaster
                     -> ClientRandom
                     -> ServerRandom
                     -> ByteString
generateMasterSecret :: forall preMaster.
ByteArrayAccess preMaster =>
Version
-> Cipher
-> preMaster
-> ClientRandom
-> ServerRandom
-> ByteString
generateMasterSecret Version
SSL2 Cipher
_ = forall preMaster.
ByteArrayAccess preMaster =>
preMaster -> ClientRandom -> ServerRandom -> ByteString
generateMasterSecret_SSL
generateMasterSecret Version
SSL3 Cipher
_ = forall preMaster.
ByteArrayAccess preMaster =>
preMaster -> ClientRandom -> ServerRandom -> ByteString
generateMasterSecret_SSL
generateMasterSecret Version
v    Cipher
c = forall preMaster.
ByteArrayAccess preMaster =>
PRF -> preMaster -> ClientRandom -> ServerRandom -> ByteString
generateMasterSecret_TLS forall a b. (a -> b) -> a -> b
$ Version -> Cipher -> PRF
getPRF Version
v Cipher
c

generateExtendedMasterSec :: ByteArrayAccess preMaster
                          => Version
                          -> Cipher
                          -> preMaster
                          -> ByteString
                          -> ByteString
generateExtendedMasterSec :: forall preMaster.
ByteArrayAccess preMaster =>
Version -> Cipher -> preMaster -> ByteString -> ByteString
generateExtendedMasterSec Version
v Cipher
c preMaster
premasterSecret ByteString
sessionHash =
    Version -> Cipher -> PRF
getPRF Version
v Cipher
c (forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert preMaster
premasterSecret) ByteString
seed Int
48
  where seed :: ByteString
seed = ByteString -> ByteString -> ByteString
B.append ByteString
"extended master secret" ByteString
sessionHash

generateKeyBlock_TLS :: PRF -> ClientRandom -> ServerRandom -> ByteString -> Int -> ByteString
generateKeyBlock_TLS :: PRF
-> ClientRandom -> ServerRandom -> ByteString -> Int -> ByteString
generateKeyBlock_TLS PRF
prf (ClientRandom ByteString
c) (ServerRandom ByteString
s) ByteString
mastersecret Int
kbsize =
    PRF
prf ByteString
mastersecret ByteString
seed Int
kbsize where seed :: ByteString
seed = [ByteString] -> ByteString
B.concat [ ByteString
"key expansion", ByteString
s, ByteString
c ]

generateKeyBlock_SSL :: ClientRandom -> ServerRandom -> ByteString -> Int -> ByteString
generateKeyBlock_SSL :: ClientRandom -> ServerRandom -> ByteString -> Int -> ByteString
generateKeyBlock_SSL (ClientRandom ByteString
c) (ServerRandom ByteString
s) ByteString
mastersecret Int
kbsize =
    [ByteString] -> ByteString
B.concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ByteString -> ByteString
computeMD5 forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take ((Int
kbsize forall a. Integral a => a -> a -> a
`div` Int
16) forall a. Num a => a -> a -> a
+ Int
1) [ByteString]
labels
  where labels :: [ByteString]
labels            = [ forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Char -> ByteString
BC.replicate (Int, Char)
x | (Int, Char)
x <- forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [Char
'A'..Char
'Z'] ]
        computeMD5 :: ByteString -> ByteString
computeMD5  ByteString
label = Hash -> ByteString -> ByteString
hash Hash
MD5 forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
B.concat [ ByteString
mastersecret, ByteString -> ByteString
computeSHA1 ByteString
label ]
        computeSHA1 :: ByteString -> ByteString
computeSHA1 ByteString
label = Hash -> ByteString -> ByteString
hash Hash
SHA1 forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
B.concat [ ByteString
label, ByteString
mastersecret, ByteString
s, ByteString
c ]

generateKeyBlock :: Version
                 -> Cipher
                 -> ClientRandom
                 -> ServerRandom
                 -> ByteString
                 -> Int
                 -> ByteString
generateKeyBlock :: Version
-> Cipher
-> ClientRandom
-> ServerRandom
-> ByteString
-> Int
-> ByteString
generateKeyBlock Version
SSL2 Cipher
_ = ClientRandom -> ServerRandom -> ByteString -> Int -> ByteString
generateKeyBlock_SSL
generateKeyBlock Version
SSL3 Cipher
_ = ClientRandom -> ServerRandom -> ByteString -> Int -> ByteString
generateKeyBlock_SSL
generateKeyBlock Version
v    Cipher
c = PRF
-> ClientRandom -> ServerRandom -> ByteString -> Int -> ByteString
generateKeyBlock_TLS forall a b. (a -> b) -> a -> b
$ Version -> Cipher -> PRF
getPRF Version
v Cipher
c

generateFinished_TLS :: PRF -> ByteString -> ByteString -> HashCtx -> ByteString
generateFinished_TLS :: PRF -> ByteString -> ByteString -> HashCtx -> ByteString
generateFinished_TLS PRF
prf ByteString
label ByteString
mastersecret HashCtx
hashctx = PRF
prf ByteString
mastersecret ByteString
seed Int
12
  where seed :: ByteString
seed = [ByteString] -> ByteString
B.concat [ ByteString
label, HashCtx -> ByteString
hashFinal HashCtx
hashctx ]

generateFinished_SSL :: ByteString -> ByteString -> HashCtx -> ByteString
generateFinished_SSL :: ByteString -> ByteString -> HashCtx -> ByteString
generateFinished_SSL ByteString
sender ByteString
mastersecret HashCtx
hashctx = [ByteString] -> ByteString
B.concat [ByteString
md5hash, ByteString
sha1hash]
  where md5hash :: ByteString
md5hash  = Hash -> ByteString -> ByteString
hash Hash
MD5 forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
B.concat [ ByteString
mastersecret, ByteString
pad2, ByteString
md5left ]
        sha1hash :: ByteString
sha1hash = Hash -> ByteString -> ByteString
hash Hash
SHA1 forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
B.concat [ ByteString
mastersecret, Int -> ByteString -> ByteString
B.take Int
40 ByteString
pad2, ByteString
sha1left ]

        lefthash :: ByteString
lefthash = HashCtx -> ByteString
hashFinal forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip HashCtx -> (ByteString, ByteString) -> HashCtx
hashUpdateSSL (ByteString
pad1, Int -> ByteString -> ByteString
B.take Int
40 ByteString
pad1)
                             forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl HashCtx -> ByteString -> HashCtx
hashUpdate HashCtx
hashctx [ByteString
sender,ByteString
mastersecret]
        (ByteString
md5left,ByteString
sha1left) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
16 ByteString
lefthash
        pad2 :: ByteString
pad2     = Int -> Word8 -> ByteString
B.replicate Int
48 Word8
0x5c
        pad1 :: ByteString
pad1     = Int -> Word8 -> ByteString
B.replicate Int
48 Word8
0x36

generateClientFinished :: Version
                       -> Cipher
                       -> ByteString
                       -> HashCtx
                       -> ByteString
generateClientFinished :: Version -> Cipher -> ByteString -> HashCtx -> ByteString
generateClientFinished Version
ver Cipher
ciph
    | Version
ver forall a. Ord a => a -> a -> Bool
< Version
TLS10 = ByteString -> ByteString -> HashCtx -> ByteString
generateFinished_SSL ByteString
"CLNT"
    | Bool
otherwise   = PRF -> ByteString -> ByteString -> HashCtx -> ByteString
generateFinished_TLS (Version -> Cipher -> PRF
getPRF Version
ver Cipher
ciph) ByteString
"client finished"

generateServerFinished :: Version
                       -> Cipher
                       -> ByteString
                       -> HashCtx
                       -> ByteString
generateServerFinished :: Version -> Cipher -> ByteString -> HashCtx -> ByteString
generateServerFinished Version
ver Cipher
ciph
    | Version
ver forall a. Ord a => a -> a -> Bool
< Version
TLS10 = ByteString -> ByteString -> HashCtx -> ByteString
generateFinished_SSL ByteString
"SRVR"
    | Bool
otherwise   = PRF -> ByteString -> ByteString -> HashCtx -> ByteString
generateFinished_TLS (Version -> Cipher -> PRF
getPRF Version
ver Cipher
ciph) ByteString
"server finished"

{- returns *output* after final MD5/SHA1 -}
generateCertificateVerify_SSL :: ByteString -> HashCtx -> ByteString
generateCertificateVerify_SSL :: ByteString -> HashCtx -> ByteString
generateCertificateVerify_SSL = ByteString -> ByteString -> HashCtx -> ByteString
generateFinished_SSL ByteString
""

{- returns *input* before final SHA1 -}
generateCertificateVerify_SSL_DSS :: ByteString -> HashCtx -> ByteString
generateCertificateVerify_SSL_DSS :: ByteString -> HashCtx -> ByteString
generateCertificateVerify_SSL_DSS ByteString
mastersecret HashCtx
hashctx = ByteString
toHash
  where toHash :: ByteString
toHash = [ByteString] -> ByteString
B.concat [ ByteString
mastersecret, ByteString
pad2, ByteString
sha1left ]

        sha1left :: ByteString
sha1left = HashCtx -> ByteString
hashFinal forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip HashCtx -> ByteString -> HashCtx
hashUpdate ByteString
pad1
                             forall a b. (a -> b) -> a -> b
$ HashCtx -> ByteString -> HashCtx
hashUpdate HashCtx
hashctx ByteString
mastersecret
        pad2 :: ByteString
pad2     = Int -> Word8 -> ByteString
B.replicate Int
40 Word8
0x5c
        pad1 :: ByteString
pad1     = Int -> Word8 -> ByteString
B.replicate Int
40 Word8
0x36

encodeSignedDHParams :: ServerDHParams -> ClientRandom -> ServerRandom -> ByteString
encodeSignedDHParams :: ServerDHParams -> ClientRandom -> ServerRandom -> ByteString
encodeSignedDHParams ServerDHParams
dhparams ClientRandom
cran ServerRandom
sran = Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$
    ClientRandom -> Put
putClientRandom32 ClientRandom
cran forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ServerRandom -> Put
putServerRandom32 ServerRandom
sran forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ServerDHParams -> Put
putServerDHParams ServerDHParams
dhparams

-- Combination of RFC 5246 and 4492 is ambiguous.
-- Let's assume ecdhe_rsa and ecdhe_dss are identical to
-- dhe_rsa and dhe_dss.
encodeSignedECDHParams :: ServerECDHParams -> ClientRandom -> ServerRandom -> ByteString
encodeSignedECDHParams :: ServerECDHParams -> ClientRandom -> ServerRandom -> ByteString
encodeSignedECDHParams ServerECDHParams
dhparams ClientRandom
cran ServerRandom
sran = Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$
    ClientRandom -> Put
putClientRandom32 ClientRandom
cran forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ServerRandom -> Put
putServerRandom32 ServerRandom
sran forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ServerECDHParams -> Put
putServerECDHParams ServerECDHParams
dhparams

fromJustM :: MonadFail m => String -> Maybe a -> m a
fromJustM :: forall (m :: * -> *) a. MonadFail m => [Char] -> Maybe a -> m a
fromJustM [Char]
what Maybe a
Nothing  = forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"fromJustM " forall a. [a] -> [a] -> [a]
++ [Char]
what forall a. [a] -> [a] -> [a]
++ [Char]
": Nothing")
fromJustM [Char]
_    (Just a
x) = forall (m :: * -> *) a. Monad m => a -> m a
return a
x