{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

-- | 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,
    encodeHeader,

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

    -- * marshall functions for handshake messages
    decodeHandshakeRecord,
    decodeHandshake,
    encodeHandshake,
    encodeCertificate,

    -- * marshall functions for change cipher spec message
    decodeChangeCipherSpec,
    encodeChangeCipherSpec,
    decodePreMainSecret,
    encodePreMainSecret,
    encodeSignedDHParams,
    encodeSignedECDHParams,
    decodeReallyServerKeyXchgAlgorithmData,

    -- * generate things for packet content
    generateMainSecret,
    generateExtendedMainSecret,
    generateKeyBlock,
    generateClientFinished,
    generateServerFinished,

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

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

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]
(Int -> CurrentParams -> ShowS)
-> (CurrentParams -> [Char])
-> ([CurrentParams] -> ShowS)
-> Show CurrentParams
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CurrentParams -> ShowS
showsPrec :: Int -> CurrentParams -> ShowS
$cshow :: CurrentParams -> [Char]
show :: CurrentParams -> [Char]
$cshowList :: [CurrentParams] -> ShowS
showList :: [CurrentParams] -> ShowS
Show, CurrentParams -> CurrentParams -> Bool
(CurrentParams -> CurrentParams -> Bool)
-> (CurrentParams -> CurrentParams -> Bool) -> Eq CurrentParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CurrentParams -> CurrentParams -> Bool
== :: CurrentParams -> CurrentParams -> Bool
$c/= :: CurrentParams -> CurrentParams -> Bool
/= :: CurrentParams -> CurrentParams -> Bool
Eq)

{- marshall helpers -}
getBinaryVersion :: Get Version
getBinaryVersion :: Get Version
getBinaryVersion = Word16 -> Version
Version (Word16 -> Version) -> Get Word16 -> Get Version
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16

putBinaryVersion :: Version -> Put
putBinaryVersion :: Version -> Put
putBinaryVersion (Version Word16
ver) = Word16 -> Put
putWord16 Word16
ver

getHeaderType :: Get ProtocolType
getHeaderType :: Get ProtocolType
getHeaderType = Word8 -> ProtocolType
ProtocolType (Word8 -> ProtocolType) -> Get Word8 -> Get ProtocolType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8

putHeaderType :: ProtocolType -> Put
putHeaderType :: ProtocolType -> Put
putHeaderType (ProtocolType Word8
pt) = Putter Word8
putWord8 Word8
pt

getHandshakeType :: Get HandshakeType
getHandshakeType :: Get HandshakeType
getHandshakeType = Word8 -> HandshakeType
HandshakeType (Word8 -> HandshakeType) -> Get Word8 -> Get HandshakeType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8

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

encodeHeader :: Header -> ByteString
encodeHeader :: Header -> ByteString
encodeHeader (Header ProtocolType
pt Version
ver Word16
len) = Put -> ByteString
runPut (ProtocolType -> Put
putHeaderType ProtocolType
pt Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Version -> Put
putBinaryVersion Version
ver Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
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
    AlertLevel
al <- Word8 -> AlertLevel
AlertLevel (Word8 -> AlertLevel) -> Get Word8 -> Get AlertLevel
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
    AlertDescription
ad <- Word8 -> AlertDescription
AlertDescription (Word8 -> AlertDescription) -> Get Word8 -> Get AlertDescription
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
    (AlertLevel, AlertDescription)
-> Get (AlertLevel, AlertDescription)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (AlertLevel
al, AlertDescription
ad)

decodeAlerts :: ByteString -> Either TLSError [(AlertLevel, AlertDescription)]
decodeAlerts :: ByteString -> Either TLSError [(AlertLevel, AlertDescription)]
decodeAlerts = [Char]
-> Get [(AlertLevel, AlertDescription)]
-> ByteString
-> Either TLSError [(AlertLevel, AlertDescription)]
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
            then [(AlertLevel, AlertDescription)]
-> Get [(AlertLevel, AlertDescription)]
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return []
            else (:) ((AlertLevel, AlertDescription)
 -> [(AlertLevel, AlertDescription)]
 -> [(AlertLevel, AlertDescription)])
-> Get (AlertLevel, AlertDescription)
-> Get
     ([(AlertLevel, AlertDescription)]
      -> [(AlertLevel, AlertDescription)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (AlertLevel, AlertDescription)
decodeAlert Get
  ([(AlertLevel, AlertDescription)]
   -> [(AlertLevel, AlertDescription)])
-> Get [(AlertLevel, AlertDescription)]
-> Get [(AlertLevel, AlertDescription)]
forall a b. Get (a -> b) -> Get a -> Get b
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 (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ ((AlertLevel, AlertDescription) -> Put)
-> [(AlertLevel, AlertDescription)] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (AlertLevel, AlertDescription) -> Put
encodeAlert [(AlertLevel, AlertDescription)]
l
  where
    encodeAlert :: (AlertLevel, AlertDescription) -> Put
encodeAlert (AlertLevel
al, AlertDescription
ad) = Putter Word8
putWord8 (AlertLevel -> Word8
fromAlertLevel AlertLevel
al) Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Word8
putWord8 (AlertDescription -> Word8
fromAlertDescription AlertDescription
ad)

{- decode and encode HANDSHAKE -}
decodeHandshakeRecord :: ByteString -> GetResult (HandshakeType, ByteString)
decodeHandshakeRecord :: ByteString -> GetResult (HandshakeType, ByteString)
decodeHandshakeRecord = [Char]
-> Get (HandshakeType, ByteString)
-> ByteString
-> GetResult (HandshakeType, ByteString)
forall a. [Char] -> Get a -> ByteString -> GetResult a
runGet [Char]
"handshake-record" (Get (HandshakeType, ByteString)
 -> ByteString -> GetResult (HandshakeType, ByteString))
-> Get (HandshakeType, ByteString)
-> ByteString
-> GetResult (HandshakeType, ByteString)
forall a b. (a -> b) -> a -> b
$ do
    HandshakeType
ty <- Get HandshakeType
getHandshakeType
    ByteString
content <- Get ByteString
getOpaque24
    (HandshakeType, ByteString) -> Get (HandshakeType, ByteString)
forall a. a -> Get a
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 = [Char] -> Get Handshake -> ByteString -> Either TLSError Handshake
forall a. [Char] -> Get a -> ByteString -> Either TLSError a
runGetErr ([Char]
"handshake[" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ HandshakeType -> [Char]
forall a. Show a => a -> [Char]
show HandshakeType
ty [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"]") (Get Handshake -> ByteString -> Either TLSError Handshake)
-> Get Handshake -> ByteString -> Either TLSError Handshake
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
decodeCertificate
    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
    HandshakeType
HandshakeType_NewSessionTicket -> Get Handshake
decodeNewSessionTicket
    HandshakeType
x -> [Char] -> Get Handshake
forall a. [Char] -> Get a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Get Handshake) -> [Char] -> Get Handshake
forall a b. (a -> b) -> a -> b
$ [Char]
"Unsupported HandshakeType " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ HandshakeType -> [Char]
forall a. Show a => a -> [Char]
show HandshakeType
x

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

decodeClientHello :: Get Handshake
decodeClientHello :: Get Handshake
decodeClientHello = do
    Version
ver <- Get Version
getBinaryVersion
    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 Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
            then Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Get Word16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16 Get Int -> (Int -> Get [ExtensionRaw]) -> Get [ExtensionRaw]
forall a b. Get a -> (a -> Get b) -> Get b
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
                [ExtensionRaw] -> Get [ExtensionRaw]
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    let ch :: CH
ch = Session -> [Word16] -> [ExtensionRaw] -> CH
CH Session
session [Word16]
ciphers [ExtensionRaw]
exts
    Handshake -> Get Handshake
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Handshake -> Get Handshake) -> Handshake -> Get Handshake
forall a b. (a -> b) -> a -> b
$ Version -> ClientRandom -> [Word8] -> CH -> Handshake
ClientHello Version
ver ClientRandom
random [Word8]
compressions CH
ch

decodeServerHello :: Get Handshake
decodeServerHello :: Get Handshake
decodeServerHello = do
    Version
ver <- Get Version
getBinaryVersion
    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 Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
            then Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Get Word16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16 Get Int -> (Int -> Get [ExtensionRaw]) -> Get [ExtensionRaw]
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get [ExtensionRaw]
getExtensions
            else [ExtensionRaw] -> Get [ExtensionRaw]
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    Handshake -> Get Handshake
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Handshake -> Get Handshake) -> Handshake -> Get Handshake
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 = Handshake -> Get Handshake
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return Handshake
ServerHelloDone

decodeCertificate :: Get Handshake
decodeCertificate :: Get Handshake
decodeCertificate = do
    CertificateChainRaw
certsRaw <-
        [ByteString] -> CertificateChainRaw
CertificateChainRaw
            ([ByteString] -> CertificateChainRaw)
-> Get [ByteString] -> Get CertificateChainRaw
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get Int
getWord24 Get Int -> (Int -> Get [ByteString]) -> Get [ByteString]
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
len -> Int -> Get (Int, ByteString) -> Get [ByteString]
forall a. Int -> Get (Int, a) -> Get [a]
getList (Int -> Int
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) -> [Char] -> Get Handshake
forall a. [Char] -> Get a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"error certificate parsing " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
":" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
s)
        Right CertificateChain
cc -> Handshake -> Get Handshake
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Handshake -> Get Handshake) -> Handshake -> Get Handshake
forall a b. (a -> b) -> a -> b
$ CertificateChain -> Handshake
Certificate CertificateChain
cc
  where
    getCertRaw :: Get (Int, ByteString)
getCertRaw = Get ByteString
getOpaque24 Get ByteString
-> (ByteString -> Get (Int, ByteString)) -> Get (Int, ByteString)
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ByteString
cert -> (Int, ByteString) -> Get (Int, ByteString)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
3 Int -> Int -> Int
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 (ByteString -> Handshake) -> Get ByteString -> Get Handshake
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get Int
remaining Get Int -> (Int -> Get ByteString) -> Get ByteString
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get ByteString
getBytes)

decodeNewSessionTicket :: Get Handshake
decodeNewSessionTicket :: Get Handshake
decodeNewSessionTicket = Second -> ByteString -> Handshake
NewSessionTicket (Second -> ByteString -> Handshake)
-> Get Second -> Get (ByteString -> Handshake)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Second
getWord32 Get (ByteString -> Handshake) -> Get ByteString -> Get Handshake
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get ByteString
getOpaque16

decodeCertRequest :: CurrentParams -> Get Handshake
decodeCertRequest :: CurrentParams -> Get Handshake
decodeCertRequest CurrentParams
_cp = do
    [CertificateType]
certTypes <- (Word8 -> CertificateType) -> [Word8] -> [CertificateType]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> CertificateType
CertificateType ([Word8] -> [CertificateType])
-> Get [Word8] -> Get [CertificateType]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [Word8]
getWords8
    [HashAndSignatureAlgorithm]
sigHashAlgs <- Get Word16
getWord16 Get Word16
-> (Word16 -> Get [HashAndSignatureAlgorithm])
-> Get [HashAndSignatureAlgorithm]
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word16 -> Get [HashAndSignatureAlgorithm]
forall {a}. Integral a => a -> Get [HashAndSignatureAlgorithm]
getSignatureHashAlgorithms
    [CertificateType]
-> [HashAndSignatureAlgorithm] -> [DistinguishedName] -> Handshake
CertRequest [CertificateType]
certTypes [HashAndSignatureAlgorithm]
sigHashAlgs ([DistinguishedName] -> Handshake)
-> Get [DistinguishedName] -> Get Handshake
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [DistinguishedName]
getDNames
  where
    getSignatureHashAlgorithms :: a -> Get [HashAndSignatureAlgorithm]
getSignatureHashAlgorithms a
len =
        Int
-> Get (Int, HashAndSignatureAlgorithm)
-> Get [HashAndSignatureAlgorithm]
forall a. Int -> Get (Int, a) -> Get [a]
getList (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
len) (Get HashAndSignatureAlgorithm
getSignatureHashAlgorithm Get HashAndSignatureAlgorithm
-> (HashAndSignatureAlgorithm
    -> Get (Int, HashAndSignatureAlgorithm))
-> Get (Int, HashAndSignatureAlgorithm)
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \HashAndSignatureAlgorithm
sh -> (Int, HashAndSignatureAlgorithm)
-> Get (Int, HashAndSignatureAlgorithm)
forall a. a -> Get a
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"
    Int -> Get (Int, DistinguishedName) -> Get [DistinguishedName]
forall a. Int -> Get (Int, a) -> Get [a]
getList (Word16 -> Int
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
        Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Int
B.length ByteString
dName Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Get ()
forall a. [Char] -> Get a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"certrequest: invalid DN length"
        DistinguishedName
dn <-
            ([Char] -> Get DistinguishedName)
-> (DistinguishedName -> Get DistinguishedName)
-> Either [Char] DistinguishedName
-> Get DistinguishedName
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> Get DistinguishedName
forall a. [Char] -> Get a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail DistinguishedName -> Get DistinguishedName
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] DistinguishedName -> Get DistinguishedName)
-> Either [Char] DistinguishedName -> Get DistinguishedName
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString -> Either [Char] DistinguishedName
forall a. ASN1Object a => [Char] -> ByteString -> Either [Char] a
decodeASN1Object [Char]
"cert request DistinguishedName" ByteString
dName
        (Int, DistinguishedName) -> Get (Int, DistinguishedName)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
2 Int -> Int -> Int
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 (DigitallySigned -> Handshake)
-> Get DigitallySigned -> Get Handshake
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 -> [Char] -> Get Handshake
forall a. HasCallStack => [Char] -> a
error [Char]
"no client key exchange type"
        Just CipherKeyExchangeType
cke -> ClientKeyXchgAlgorithmData -> Handshake
ClientKeyXchg (ClientKeyXchgAlgorithmData -> Handshake)
-> Get ClientKeyXchgAlgorithmData -> Get Handshake
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 (ByteString -> ClientKeyXchgAlgorithmData)
-> Get ByteString -> Get ClientKeyXchgAlgorithmData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get Int
remaining Get Int -> (Int -> Get ByteString) -> Get ByteString
forall a b. Get a -> (a -> Get b) -> Get b
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_DSA = 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
_ = [Char] -> Get ClientKeyXchgAlgorithmData
forall a. HasCallStack => [Char] -> a
error [Char]
"unsupported client key exchange type"
    parseClientDHPublic :: Get ClientKeyXchgAlgorithmData
parseClientDHPublic = DHPublic -> ClientKeyXchgAlgorithmData
CKX_DH (DHPublic -> ClientKeyXchgAlgorithmData)
-> (Integer -> DHPublic) -> Integer -> ClientKeyXchgAlgorithmData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> DHPublic
dhPublic (Integer -> ClientKeyXchgAlgorithmData)
-> Get Integer -> Get ClientKeyXchgAlgorithmData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Integer
getInteger16
    parseClientECDHPublic :: Get ClientKeyXchgAlgorithmData
parseClientECDHPublic = ByteString -> ClientKeyXchgAlgorithmData
CKX_ECDH (ByteString -> ClientKeyXchgAlgorithmData)
-> Get ByteString -> Get ClientKeyXchgAlgorithmData
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
        (Integer -> Integer -> ServerRSAParams)
-> Get Integer -> Get (Integer -> ServerRSAParams)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Integer
getInteger16 -- modulus
        Get (Integer -> ServerRSAParams)
-> Get Integer -> Get ServerRSAParams
forall a b. Get (a -> b) -> Get a -> Get b
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 (Maybe ServerRSAParams -> ServerKeyXchgAlgorithmData)
-> (ServerRSAParams -> Maybe ServerRSAParams)
-> ServerRSAParams
-> ServerKeyXchgAlgorithmData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServerRSAParams -> Maybe ServerRSAParams
forall a. a -> Maybe a
Just (ServerRSAParams -> ServerKeyXchgAlgorithmData)
-> Get ServerRSAParams -> Get ServerKeyXchgAlgorithmData
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 (ServerDHParams -> ServerKeyXchgAlgorithmData)
-> Get ServerDHParams -> Get ServerKeyXchgAlgorithmData
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
            ServerKeyXchgAlgorithmData -> Get ServerKeyXchgAlgorithmData
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (ServerKeyXchgAlgorithmData -> Get ServerKeyXchgAlgorithmData)
-> ServerKeyXchgAlgorithmData -> Get ServerKeyXchgAlgorithmData
forall a b. (a -> b) -> a -> b
$ ServerDHParams -> DigitallySigned -> ServerKeyXchgAlgorithmData
SKX_DHE_RSA ServerDHParams
dhparams DigitallySigned
signature
        CipherKeyExchangeType
CipherKeyExchange_DHE_DSA -> do
            ServerDHParams
dhparams <- Get ServerDHParams
getServerDHParams
            DigitallySigned
signature <- Version -> Get DigitallySigned
getDigitallySigned Version
ver
            ServerKeyXchgAlgorithmData -> Get ServerKeyXchgAlgorithmData
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (ServerKeyXchgAlgorithmData -> Get ServerKeyXchgAlgorithmData)
-> ServerKeyXchgAlgorithmData -> Get ServerKeyXchgAlgorithmData
forall a b. (a -> b) -> a -> b
$ ServerDHParams -> DigitallySigned -> ServerKeyXchgAlgorithmData
SKX_DHE_DSA ServerDHParams
dhparams DigitallySigned
signature
        CipherKeyExchangeType
CipherKeyExchange_ECDHE_RSA -> do
            ServerECDHParams
ecdhparams <- Get ServerECDHParams
getServerECDHParams
            DigitallySigned
signature <- Version -> Get DigitallySigned
getDigitallySigned Version
ver
            ServerKeyXchgAlgorithmData -> Get ServerKeyXchgAlgorithmData
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (ServerKeyXchgAlgorithmData -> Get ServerKeyXchgAlgorithmData)
-> ServerKeyXchgAlgorithmData -> Get ServerKeyXchgAlgorithmData
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
            ServerKeyXchgAlgorithmData -> Get ServerKeyXchgAlgorithmData
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (ServerKeyXchgAlgorithmData -> Get ServerKeyXchgAlgorithmData)
-> ServerKeyXchgAlgorithmData -> Get ServerKeyXchgAlgorithmData
forall a b. (a -> b) -> a -> b
$ ServerECDHParams -> DigitallySigned -> ServerKeyXchgAlgorithmData
SKX_ECDHE_ECDSA ServerECDHParams
ecdhparams DigitallySigned
signature
        CipherKeyExchangeType
_ -> do
            ByteString
bs <- Get Int
remaining Get Int -> (Int -> Get ByteString) -> Get ByteString
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get ByteString
getBytes
            ServerKeyXchgAlgorithmData -> Get ServerKeyXchgAlgorithmData
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (ServerKeyXchgAlgorithmData -> Get ServerKeyXchgAlgorithmData)
-> ServerKeyXchgAlgorithmData -> Get ServerKeyXchgAlgorithmData
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 (ServerKeyXchgAlgorithmData -> Handshake)
-> Get ServerKeyXchgAlgorithmData -> Get Handshake
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 (ServerKeyXchgAlgorithmData -> Handshake)
-> (ByteString -> ServerKeyXchgAlgorithmData)
-> ByteString
-> Handshake
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ServerKeyXchgAlgorithmData
SKX_Unparsed (ByteString -> Handshake) -> Get ByteString -> Get Handshake
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get Int
remaining Get Int -> (Int -> Get ByteString) -> Get ByteString
forall a b. Get a -> (a -> Get b) -> Get b
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 = Handshake -> ByteString
encodeHandshake' Handshake
o
     in let len :: Int
len = ByteString -> Int
B.length ByteString
content
         in let header :: ByteString
header = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
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 (HandshakeType -> Word8
fromHandshakeType HandshakeType
ty) Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Put
putWord24 Int
len

encodeHandshake' :: Handshake -> ByteString
encodeHandshake' :: Handshake -> ByteString
encodeHandshake' (ClientHello Version
version ClientRandom
random [Word8]
compressionIDs CH{[Word16]
[ExtensionRaw]
Session
chSession :: Session
chCiphers :: [Word16]
chExtensions :: [ExtensionRaw]
chSession :: CH -> Session
chCiphers :: CH -> [Word16]
chExtensions :: CH -> [ExtensionRaw]
..}) = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
    Version -> Put
putBinaryVersion Version
version
    ClientRandom -> Put
putClientRandom32 ClientRandom
random
    Session -> Put
putSession Session
chSession
    [Word16] -> Put
putWords16 [Word16]
chCiphers
    [Word8] -> Put
putWords8 [Word8]
compressionIDs
    [ExtensionRaw] -> Put
putExtensions [ExtensionRaw]
chExtensions
    () -> Put
forall a. a -> PutM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
encodeHandshake' (ServerHello Version
version ServerRandom
random Session
session Word16
cipherid Word8
compressionID [ExtensionRaw]
exts) = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ 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
    () -> Put
forall a. a -> PutM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
encodeHandshake' (Certificate CertificateChain
cc) = CertificateChain -> ByteString
encodeCertificate CertificateChain
cc
encodeHandshake' (ClientKeyXchg ClientKeyXchgAlgorithmData
ckx) = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
    case ClientKeyXchgAlgorithmData
ckx of
        CKX_RSA ByteString
encryptedPreMain -> ByteString -> Put
putBytes ByteString
encryptedPreMain
        CKX_DH DHPublic
clientDHPublic -> Integer -> Put
putInteger16 (Integer -> Put) -> Integer -> Put
forall a b. (a -> b) -> a -> b
$ DHPublic -> Integer
dhUnwrapPublic DHPublic
clientDHPublic
        CKX_ECDH ByteString
bytes -> ByteString -> Put
putOpaque8 ByteString
bytes
encodeHandshake' (ServerKeyXchg ServerKeyXchgAlgorithmData
skg) = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$
    case ServerKeyXchgAlgorithmData
skg of
        SKX_RSA Maybe ServerRSAParams
_ -> [Char] -> Put
forall a. HasCallStack => [Char] -> a
error [Char]
"encodeHandshake' 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 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DigitallySigned -> Put
putDigitallySigned DigitallySigned
sig
        SKX_DHE_DSA ServerDHParams
params DigitallySigned
sig -> ServerDHParams -> Put
putServerDHParams ServerDHParams
params Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
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 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
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 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
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
_ ->
            [Char] -> Put
forall a. HasCallStack => [Char] -> a
error ([Char]
"encodeHandshake': cannot handle: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ServerKeyXchgAlgorithmData -> [Char]
forall a. Show a => a -> [Char]
show ServerKeyXchgAlgorithmData
skg)
encodeHandshake' Handshake
HelloRequest = ByteString
""
encodeHandshake' Handshake
ServerHelloDone = ByteString
""
encodeHandshake' (CertRequest [CertificateType]
certTypes [HashAndSignatureAlgorithm]
sigAlgs [DistinguishedName]
certAuthorities) = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
    [Word8] -> Put
putWords8 ((CertificateType -> Word8) -> [CertificateType] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map CertificateType -> Word8
fromCertificateType [CertificateType]
certTypes)
    [Word16] -> Put
putWords16 ([Word16] -> Put) -> [Word16] -> Put
forall a b. (a -> b) -> a -> b
$
        (HashAndSignatureAlgorithm -> Word16)
-> [HashAndSignatureAlgorithm] -> [Word16]
forall a b. (a -> b) -> [a] -> [b]
map
            ( \(HashAlgorithm Word8
x, SignatureAlgorithm Word8
y) -> Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
* Word16
256 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
y
            )
            [HashAndSignatureAlgorithm]
sigAlgs
    [DistinguishedName] -> Put
putDNames [DistinguishedName]
certAuthorities
encodeHandshake' (CertVerify DigitallySigned
digitallySigned) = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ DigitallySigned -> Put
putDigitallySigned DigitallySigned
digitallySigned
encodeHandshake' (Finished ByteString
opaque) = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Put
putBytes ByteString
opaque
encodeHandshake' (NewSessionTicket Second
life ByteString
ticket) = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
    Second -> Put
putWord32 Second
life
    ByteString -> Put
putOpaque16 ByteString
ticket

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

-- | Encode a list of distinguished names.
putDNames :: [DistinguishedName] -> Put
putDNames :: [DistinguishedName] -> Put
putDNames [DistinguishedName]
dnames = do
    [ByteString]
enc <- (DistinguishedName -> PutM ByteString)
-> [DistinguishedName] -> PutM [ByteString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM DistinguishedName -> PutM ByteString
forall {m :: * -> *} {a}.
(Monad m, ASN1Object a) =>
a -> m ByteString
encodeCA [DistinguishedName]
dnames
    let totLength :: Int
totLength = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (ByteString -> Int) -> [ByteString] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
2 (Int -> Int) -> (ByteString -> Int) -> ByteString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
B.length) [ByteString]
enc
    Word16 -> Put
putWord16 (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
totLength)
    (ByteString -> Put) -> [ByteString] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\ByteString
b -> Word16 -> Put
putWord16 (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
b)) Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM 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 = ByteString -> m ByteString
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ a -> ByteString
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 (ByteString -> ServerRandom) -> Get ByteString -> Get 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 (ByteString -> ClientRandom) -> Get ByteString -> Get 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 Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
len8 of
        Int
0 -> Session -> Get Session
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Session -> Get Session) -> Session -> Get Session
forall a b. (a -> b) -> a -> b
$ Maybe ByteString -> Session
Session Maybe ByteString
forall a. Maybe a
Nothing
        Int
len -> Maybe ByteString -> Session
Session (Maybe ByteString -> Session)
-> (ByteString -> Maybe ByteString) -> ByteString -> Session
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Session) -> Get ByteString -> Get Session
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 = [ExtensionRaw] -> Get [ExtensionRaw]
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return []
getExtensions Int
len = do
    ExtensionID
extty <- Word16 -> ExtensionID
ExtensionID (Word16 -> ExtensionID) -> Get Word16 -> Get ExtensionID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16
    Word16
extdatalen <- Get Word16
getWord16
    ByteString
extdata <- Int -> Get ByteString
getBytes (Int -> Get ByteString) -> Int -> Get ByteString
forall a b. (a -> b) -> a -> b
$ Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
extdatalen
    [ExtensionRaw]
extxs <- Int -> Get [ExtensionRaw]
getExtensions (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
extdatalen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4)
    [ExtensionRaw] -> Get [ExtensionRaw]
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ExtensionRaw] -> Get [ExtensionRaw])
-> [ExtensionRaw] -> Get [ExtensionRaw]
forall a b. (a -> b) -> a -> b
$ ExtensionID -> ByteString -> ExtensionRaw
ExtensionRaw ExtensionID
extty ByteString
extdata ExtensionRaw -> [ExtensionRaw] -> [ExtensionRaw]
forall a. a -> [a] -> [a]
: [ExtensionRaw]
extxs

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

putExtensions :: [ExtensionRaw] -> Put
putExtensions :: [ExtensionRaw] -> Put
putExtensions [] = () -> Put
forall a. a -> PutM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
putExtensions [ExtensionRaw]
es = ByteString -> Put
putOpaque16 (Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ (ExtensionRaw -> Put) -> [ExtensionRaw] -> Put
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 <- Word8 -> HashAlgorithm
HashAlgorithm (Word8 -> HashAlgorithm) -> Get Word8 -> Get HashAlgorithm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
    SignatureAlgorithm
s <- Word8 -> SignatureAlgorithm
SignatureAlgorithm (Word8 -> SignatureAlgorithm)
-> Get Word8 -> Get SignatureAlgorithm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
    HashAndSignatureAlgorithm -> Get HashAndSignatureAlgorithm
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (HashAlgorithm
h, SignatureAlgorithm
s)

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

getServerDHParams :: Get ServerDHParams
getServerDHParams :: Get ServerDHParams
getServerDHParams = BigNum -> BigNum -> BigNum -> ServerDHParams
ServerDHParams (BigNum -> BigNum -> BigNum -> ServerDHParams)
-> Get BigNum -> Get (BigNum -> BigNum -> ServerDHParams)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get BigNum
getBigNum16 Get (BigNum -> BigNum -> ServerDHParams)
-> Get BigNum -> Get (BigNum -> ServerDHParams)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get BigNum
getBigNum16 Get (BigNum -> ServerDHParams) -> Get BigNum -> Get ServerDHParams
forall a b. Get (a -> b) -> Get a -> Get b
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) = (BigNum -> Put) -> [BigNum] -> Put
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
            Group
grp <- Word16 -> Group
Group (Word16 -> Group) -> Get Word16 -> Get Group
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16 -- ECParameters NamedCurve
            ByteString
mxy <- Get ByteString
getOpaque8 -- ECPoint
            case Group -> ByteString -> Either CryptoError GroupPublic
decodeGroupPublic Group
grp ByteString
mxy of
                Left CryptoError
e -> [Char] -> Get ServerECDHParams
forall a. HasCallStack => [Char] -> a
error ([Char] -> Get ServerECDHParams) -> [Char] -> Get ServerECDHParams
forall a b. (a -> b) -> a -> b
$ [Char]
"getServerECDHParams: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ CryptoError -> [Char]
forall a. Show a => a -> [Char]
show CryptoError
e
                Right GroupPublic
grppub -> ServerECDHParams -> Get ServerECDHParams
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (ServerECDHParams -> Get ServerECDHParams)
-> ServerECDHParams -> Get ServerECDHParams
forall a b. (a -> b) -> a -> b
$ Group -> GroupPublic -> ServerECDHParams
ServerECDHParams Group
grp GroupPublic
grppub
        Word8
_ ->
            [Char] -> Get ServerECDHParams
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 Word16
grp) GroupPublic
grppub) = do
    Putter Word8
putWord8 Word8
3 -- ECParameters ECCurveType
    Word16 -> Put
putWord16 Word16
grp -- ECParameters NamedCurve
    ByteString -> Put
putOpaque8 (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ GroupPublic -> ByteString
encodeGroupPublic GroupPublic
grppub -- ECPoint

getDigitallySigned :: Version -> Get DigitallySigned
getDigitallySigned :: Version -> Get DigitallySigned
getDigitallySigned Version
_ver =
    HashAndSignatureAlgorithm -> ByteString -> DigitallySigned
DigitallySigned
        (HashAndSignatureAlgorithm -> ByteString -> DigitallySigned)
-> Get HashAndSignatureAlgorithm
-> Get (ByteString -> DigitallySigned)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get HashAndSignatureAlgorithm
getSignatureHashAlgorithm
        Get (ByteString -> DigitallySigned)
-> Get ByteString -> Get DigitallySigned
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get ByteString
getOpaque16

putDigitallySigned :: DigitallySigned -> Put
putDigitallySigned :: DigitallySigned -> Put
putDigitallySigned (DigitallySigned HashAndSignatureAlgorithm
h ByteString
sig) =
    HashAndSignatureAlgorithm -> Put
putSignatureHashAlgorithm HashAndSignatureAlgorithm
h Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
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 = [Char] -> Get () -> ByteString -> Either TLSError ()
forall a. [Char] -> Get a -> ByteString -> Either TLSError a
runGetErr [Char]
"changecipherspec" (Get () -> ByteString -> Either TLSError ())
-> Get () -> ByteString -> Either TLSError ()
forall a b. (a -> b) -> a -> b
$ do
    Word8
x <- Get Word8
getWord8
    Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
1) ([Char] -> Get ()
forall a. [Char] -> Get a
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-main secret
decodePreMainSecret :: ByteString -> Either TLSError (Version, ByteString)
decodePreMainSecret :: ByteString -> Either TLSError (Version, ByteString)
decodePreMainSecret =
    [Char]
-> Get (Version, ByteString)
-> ByteString
-> Either TLSError (Version, ByteString)
forall a. [Char] -> Get a -> ByteString -> Either TLSError a
runGetErr [Char]
"pre-main-secret" (Get (Version, ByteString)
 -> ByteString -> Either TLSError (Version, ByteString))
-> Get (Version, ByteString)
-> ByteString
-> Either TLSError (Version, ByteString)
forall a b. (a -> b) -> a -> b
$
        (,) (Version -> ByteString -> (Version, ByteString))
-> Get Version -> Get (ByteString -> (Version, ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Version
getBinaryVersion Get (ByteString -> (Version, ByteString))
-> Get ByteString -> Get (Version, ByteString)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Get ByteString
getBytes Int
46

encodePreMainSecret :: Version -> ByteString -> ByteString
encodePreMainSecret :: Version -> ByteString -> ByteString
encodePreMainSecret Version
version ByteString
bytes = Put -> ByteString
runPut (Version -> Put
putBinaryVersion Version
version Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
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 =
    [Char]
-> Get ServerKeyXchgAlgorithmData
-> ByteString
-> Either TLSError ServerKeyXchgAlgorithmData
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 Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< Version
TLS12 = PRF
prf_MD5SHA1
    | Bool -> (Version -> Bool) -> Maybe Version -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Version -> Version -> Bool
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 (Hash -> PRF) -> Hash -> PRF
forall a b. (a -> b) -> a -> b
$ Hash -> Maybe Hash -> Hash
forall a. a -> Maybe a -> a
fromMaybe Hash
SHA256 (Maybe Hash -> Hash) -> Maybe Hash -> Hash
forall a b. (a -> b) -> a -> b
$ Cipher -> Maybe Hash
cipherPRFHash Cipher
ciph

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

generateMainSecret
    :: ByteArrayAccess preMain
    => Version
    -> Cipher
    -> preMain
    -> ClientRandom
    -> ServerRandom
    -> ByteString
generateMainSecret :: forall preMain.
ByteArrayAccess preMain =>
Version
-> Cipher -> preMain -> ClientRandom -> ServerRandom -> ByteString
generateMainSecret Version
v Cipher
c = PRF -> preMain -> ClientRandom -> ServerRandom -> ByteString
forall preMain.
ByteArrayAccess preMain =>
PRF -> preMain -> ClientRandom -> ServerRandom -> ByteString
generateMainSecret_TLS (PRF -> preMain -> ClientRandom -> ServerRandom -> ByteString)
-> PRF -> preMain -> ClientRandom -> ServerRandom -> ByteString
forall a b. (a -> b) -> a -> b
$ Version -> Cipher -> PRF
getPRF Version
v Cipher
c

generateExtendedMainSecret
    :: ByteArrayAccess preMain
    => Version
    -> Cipher
    -> preMain
    -> ByteString
    -> ByteString
generateExtendedMainSecret :: forall preMain.
ByteArrayAccess preMain =>
Version -> Cipher -> preMain -> ByteString -> ByteString
generateExtendedMainSecret Version
v Cipher
c preMain
preMainSecret ByteString
sessionHash =
    Version -> Cipher -> PRF
getPRF Version
v Cipher
c (preMain -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert preMain
preMainSecret) 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
mainSecret Int
kbsize =
    PRF
prf ByteString
mainSecret ByteString
seed Int
kbsize
  where
    seed :: ByteString
seed = [ByteString] -> ByteString
B.concat [ByteString
"key expansion", ByteString
s, ByteString
c]

generateKeyBlock
    :: Version
    -> Cipher
    -> ClientRandom
    -> ServerRandom
    -> ByteString
    -> Int
    -> ByteString
generateKeyBlock :: Version
-> Cipher
-> ClientRandom
-> ServerRandom
-> ByteString
-> Int
-> ByteString
generateKeyBlock Version
v Cipher
c = PRF
-> ClientRandom -> ServerRandom -> ByteString -> Int -> ByteString
generateKeyBlock_TLS (PRF
 -> ClientRandom -> ServerRandom -> ByteString -> Int -> ByteString)
-> PRF
-> ClientRandom
-> ServerRandom
-> ByteString
-> Int
-> ByteString
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
mainSecret HashCtx
hashctx = PRF
prf ByteString
mainSecret ByteString
seed Int
12
  where
    seed :: ByteString
seed = [ByteString] -> ByteString
B.concat [ByteString
label, HashCtx -> ByteString
hashFinal HashCtx
hashctx]

generateClientFinished
    :: Version
    -> Cipher
    -> ByteString
    -> HashCtx
    -> ByteString
generateClientFinished :: Version -> Cipher -> ByteString -> HashCtx -> ByteString
generateClientFinished Version
ver Cipher
ciph =
    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 =
    PRF -> ByteString -> ByteString -> HashCtx -> ByteString
generateFinished_TLS (Version -> Cipher -> PRF
getPRF Version
ver Cipher
ciph) ByteString
"server finished"

encodeSignedDHParams
    :: ServerDHParams -> ClientRandom -> ServerRandom -> ByteString
encodeSignedDHParams :: ServerDHParams -> ClientRandom -> ServerRandom -> ByteString
encodeSignedDHParams ServerDHParams
dhparams ClientRandom
cran ServerRandom
sran =
    Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$
        ClientRandom -> Put
putClientRandom32 ClientRandom
cran Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ServerRandom -> Put
putServerRandom32 ServerRandom
sran Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
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 (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$
        ClientRandom -> Put
putClientRandom32 ClientRandom
cran Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ServerRandom -> Put
putServerRandom32 ServerRandom
sran Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ServerECDHParams -> Put
putServerECDHParams ServerECDHParams
dhparams

encodeCertificate :: CertificateChain -> ByteString
encodeCertificate :: CertificateChain -> ByteString
encodeCertificate CertificateChain
cc = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Put
putOpaque24 (Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString -> Put) -> [ByteString] -> Put
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