{-# 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 -> String
(Int -> CurrentParams -> ShowS)
-> (CurrentParams -> String)
-> ([CurrentParams] -> ShowS)
-> Show CurrentParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CurrentParams] -> ShowS
$cshowList :: [CurrentParams] -> ShowS
show :: CurrentParams -> String
$cshow :: CurrentParams -> String
showsPrec :: Int -> CurrentParams -> ShowS
$cshowsPrec :: Int -> CurrentParams -> ShowS
Show,CurrentParams -> CurrentParams -> Bool
(CurrentParams -> CurrentParams -> Bool)
-> (CurrentParams -> CurrentParams -> Bool) -> Eq CurrentParams
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 -> String -> Get Version
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"invalid version : " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
major String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"," String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
minor)
        Just Version
v  -> Version -> Get Version
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
    Maybe Version -> Get (Maybe Version)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Version -> Get (Maybe Version))
-> Maybe Version -> Get (Maybe Version)
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 Put -> Put -> Put
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 Word8 -> Maybe ProtocolType
forall a. TypeValuable a => Word8 -> Maybe a
valToType Word8
ty of
        Maybe ProtocolType
Nothing -> String -> Get ProtocolType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"invalid header type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
ty)
        Just ProtocolType
t  -> ProtocolType -> Get ProtocolType
forall (m :: * -> *) a. Monad m => a -> m a
return ProtocolType
t

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

getHandshakeType :: Get HandshakeType
getHandshakeType :: Get HandshakeType
getHandshakeType = do
    Word8
ty <- Get Word8
getWord8
    case Word8 -> Maybe HandshakeType
forall a. TypeValuable a => Word8 -> Maybe a
valToType Word8
ty of
        Maybe HandshakeType
Nothing -> String -> Get HandshakeType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"invalid handshake type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
ty)
        Just HandshakeType
t  -> HandshakeType -> Get HandshakeType
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 = String -> Get Header -> ByteString -> Either TLSError Header
forall a. String -> Get a -> ByteString -> Either TLSError a
runGetErr String
"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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Version
getVersion Get (Word16 -> Header) -> Get Word16 -> Get Header
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 = String -> Get Word16 -> ByteString -> Either TLSError Word16
forall a. String -> Get a -> ByteString -> Either TLSError a
runGetErr String
"deprecatedheaderlength" (Get Word16 -> ByteString -> Either TLSError Word16)
-> Get Word16 -> ByteString -> Either TLSError Word16
forall a b. (a -> b) -> a -> b
$ Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
subtract Word16
0x8000 (Word16 -> Word16) -> Get Word16 -> Get Word16
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 =
    String -> Get Header -> ByteString -> Either TLSError Header
forall a. String -> Get a -> ByteString -> Either TLSError a
runGetErr String
"deprecatedheader" (Get Header -> ByteString -> Either TLSError Header)
-> Get Header -> ByteString -> Either TLSError Header
forall a b. (a -> b) -> a -> b
$ do
        Word8
1 <- Get Word8
getWord8
        Version
version <- Get Version
getVersion
        Header -> Get Header
forall (m :: * -> *) a. Monad m => a -> m a
return (Header -> Get Header) -> Header -> Get Header
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 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Version -> Put
putBinaryVersion Version
ver Put -> Put -> Put
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 Put -> Put -> Put
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 (Word8 -> Maybe AlertLevel
forall a. TypeValuable a => Word8 -> Maybe a
valToType Word8
al, Word8 -> Maybe AlertDescription
forall a. TypeValuable a => Word8 -> Maybe a
valToType Word8
ad) of
        (Just AlertLevel
a, Just AlertDescription
d) -> (AlertLevel, AlertDescription)
-> Get (AlertLevel, AlertDescription)
forall (m :: * -> *) a. Monad m => a -> m a
return (AlertLevel
a, AlertDescription
d)
        (Maybe AlertLevel
Nothing, Maybe AlertDescription
_)     -> String -> Get (AlertLevel, AlertDescription)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"cannot decode alert level"
        (Maybe AlertLevel
_, Maybe AlertDescription
Nothing)     -> String -> Get (AlertLevel, AlertDescription)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"cannot decode alert description"

decodeAlerts :: ByteString -> Either TLSError [(AlertLevel, AlertDescription)]
decodeAlerts :: ByteString -> Either TLSError [(AlertLevel, AlertDescription)]
decodeAlerts = String
-> Get [(AlertLevel, AlertDescription)]
-> ByteString
-> Either TLSError [(AlertLevel, AlertDescription)]
forall a. String -> Get a -> ByteString -> Either TLSError a
runGetErr String
"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 (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 (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
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 (a -> Word8
forall a. TypeValuable a => a -> Word8
valOfType a
al) Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Word8
putWord8 (a -> Word8
forall a. TypeValuable a => a -> Word8
valOfType a
ad)

{- decode and encode HANDSHAKE -}
decodeHandshakeRecord :: ByteString -> GetResult (HandshakeType, ByteString)
decodeHandshakeRecord :: ByteString -> GetResult (HandshakeType, ByteString)
decodeHandshakeRecord = String
-> Get (HandshakeType, ByteString)
-> ByteString
-> GetResult (HandshakeType, ByteString)
forall a. String -> Get a -> ByteString -> GetResult a
runGet String
"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 (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 = String -> Get Handshake -> ByteString -> Either TLSError Handshake
forall a. String -> Get a -> ByteString -> Either TLSError a
runGetErr (String
"handshake[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ HandshakeType -> String
forall a. Show a => a -> String
show HandshakeType
ty String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]") (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
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 = String -> Get Handshake -> ByteString -> Either TLSError Handshake
forall a. String -> Get a -> ByteString -> Either TLSError a
runGetErr String
"deprecatedhandshake" Get Handshake
getDeprecated ByteString
b
  where getDeprecated :: Get Handshake
getDeprecated = do
            Word8
1 <- Get Word8
getWord8
            Version
ver <- Get Version
getVersion
            Int
cipherSpecLen <- Word16 -> Int
forall a. Enum a => a -> Int
fromEnum (Word16 -> Int) -> Get Word16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16
            Int
sessionIdLen <- Word16 -> Int
forall a. Enum a => a -> Int
fromEnum (Word16 -> Int) -> Get Word16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16
            Int
challengeLen <- Word16 -> Int
forall a. Enum a => a -> Int
fromEnum (Word16 -> Int) -> Get Word16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16
            [Word16]
ciphers <- Int -> Get [Word16]
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]
            Handshake -> Get Handshake
forall (m :: * -> *) a. Monad m => a -> m a
return (Handshake -> Get Handshake) -> Handshake -> Get Handshake
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 [] (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
b)
        getCipherSpec :: t -> Get [a]
getCipherSpec t
len | t
len t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
3 = [a] -> Get [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
        getCipherSpec t
len = do
            [Int
c0,Int
c1,Int
c2] <- (Word8 -> Int) -> [Word8] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Int
forall a. Enum a => a -> Int
fromEnum ([Word8] -> [Int]) -> Get [Word8] -> Get [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get Word8 -> Get [Word8]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
3 Get Word8
getWord8
            ([ Int -> a
forall a. Enum a => Int -> a
toEnum (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$ Int
c1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
0x100 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
c2 | Int
c0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 ] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++) ([a] -> [a]) -> Get [a] -> Get [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t -> Get [a]
getCipherSpec (t
len t -> t -> t
forall a. Num a => a -> a -> a
- t
3)
        getSessionId :: Int -> Get Session
getSessionId Int
0 = Session -> Get Session
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
        getSessionId 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
        getChallenge :: Int -> Get ClientRandom
getChallenge Int
len | Int
32 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len = Int -> Get ByteString
getBytes (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
32) Get ByteString -> Get ClientRandom -> Get ClientRandom
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Get ClientRandom
getChallenge Int
32
        getChallenge Int
len = ByteString -> ClientRandom
ClientRandom (ByteString -> ClientRandom)
-> (ByteString -> ByteString) -> ByteString -> ClientRandom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> ByteString
B.append (Int -> Word8 -> ByteString
B.replicate (Int
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len) Word8
0) (ByteString -> ClientRandom) -> Get ByteString -> Get ClientRandom
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 = Handshake -> Get Handshake
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 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 (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 (m :: * -> *) a. Monad m => a -> m a
return []
    Handshake -> Get Handshake
forall (m :: * -> *) a. Monad m => a -> m a
return (Handshake -> Get Handshake) -> Handshake -> Get Handshake
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 Maybe ByteString
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 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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get [ExtensionRaw]
getExtensions
            else [ExtensionRaw] -> Get [ExtensionRaw]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    Handshake -> Get Handshake
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 (m :: * -> *) a. Monad m => a -> m a
return Handshake
ServerHelloDone

decodeCertificates :: Get Handshake
decodeCertificates :: Get Handshake
decodeCertificates = 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 (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, String) CertificateChain
decodeCertificateChain CertificateChainRaw
certsRaw of
        Left (Int
i, String
s) -> String -> Get Handshake
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"error certificate parsing " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s)
        Right CertificateChain
cc    -> Handshake -> Get Handshake
forall (m :: * -> *) a. Monad m => a -> m a
return (Handshake -> Get Handshake) -> Handshake -> Get Handshake
forall a b. (a -> b) -> a -> b
$ CertificateChain -> Handshake
Certificates CertificateChain
cc
  where getCertRaw :: Get (Int, ByteString)
getCertRaw = Get ByteString
getOpaque24 Get ByteString
-> (ByteString -> Get (Int, ByteString)) -> Get (Int, ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ByteString
cert -> (Int, ByteString) -> Get (Int, ByteString)
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 (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 <- (Word8 -> Maybe CertificateType)
-> [Word8] -> [Maybe CertificateType]
forall a b. (a -> b) -> [a] -> [b]
map (Word8 -> Maybe CertificateType
forall a. TypeValuable a => Word8 -> Maybe a
valToType (Word8 -> Maybe CertificateType)
-> (Word8 -> Word8) -> Word8 -> Maybe CertificateType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral) ([Word8] -> [Maybe CertificateType])
-> Get [Word8] -> Get [Maybe CertificateType]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [Word8]
getWords8
    [CertificateType]
certTypes <- (Maybe CertificateType -> Get CertificateType)
-> [Maybe CertificateType] -> Get [CertificateType]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (String -> Maybe CertificateType -> Get CertificateType
forall (m :: * -> *) a. MonadFail m => String -> Maybe a -> m a
fromJustM String
"decodeCertRequest") [Maybe CertificateType]
mcertTypes
    Maybe [HashAndSignatureAlgorithm]
sigHashAlgs <- if CurrentParams -> Version
cParamsVersion CurrentParams
cp Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= Version
TLS12
                       then [HashAndSignatureAlgorithm] -> Maybe [HashAndSignatureAlgorithm]
forall a. a -> Maybe a
Just ([HashAndSignatureAlgorithm] -> Maybe [HashAndSignatureAlgorithm])
-> Get [HashAndSignatureAlgorithm]
-> Get (Maybe [HashAndSignatureAlgorithm])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get Word16
getWord16 Get Word16
-> (Word16 -> Get [HashAndSignatureAlgorithm])
-> Get [HashAndSignatureAlgorithm]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word16 -> Get [HashAndSignatureAlgorithm]
forall a. Integral a => a -> Get [HashAndSignatureAlgorithm]
getSignatureHashAlgorithms)
                       else Maybe [HashAndSignatureAlgorithm]
-> Get (Maybe [HashAndSignatureAlgorithm])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [HashAndSignatureAlgorithm]
forall a. Maybe a
Nothing
    [CertificateType]
-> Maybe [HashAndSignatureAlgorithm]
-> [DistinguishedName]
-> Handshake
CertRequest [CertificateType]
certTypes Maybe [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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \HashAndSignatureAlgorithm
sh -> (Int, HashAndSignatureAlgorithm)
-> Get (Int, HashAndSignatureAlgorithm)
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
$ String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"certrequest: invalid DN length"
        DistinguishedName
dn <- (String -> Get DistinguishedName)
-> (DistinguishedName -> Get DistinguishedName)
-> Either String DistinguishedName
-> Get DistinguishedName
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Get DistinguishedName
forall (m :: * -> *) a. MonadFail m => String -> m a
fail DistinguishedName -> Get DistinguishedName
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String DistinguishedName -> Get DistinguishedName)
-> Either String DistinguishedName -> Get DistinguishedName
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> Either String DistinguishedName
forall a. ASN1Object a => String -> ByteString -> Either String a
decodeASN1Object String
"cert request DistinguishedName" ByteString
dName
        (Int, DistinguishedName) -> Get (Int, DistinguishedName)
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  -> String -> Get Handshake
forall a. HasCallStack => String -> a
error String
"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 (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
_                         = String -> Get ClientKeyXchgAlgorithmData
forall a. HasCallStack => String -> a
error String
"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 (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 (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_DSS -> do
                ServerDHParams
dhparams  <- Get ServerDHParams
getServerDHParams
                DigitallySigned
signature <- Version -> Get DigitallySigned
getDigitallySigned Version
ver
                ServerKeyXchgAlgorithmData -> Get ServerKeyXchgAlgorithmData
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_DSS 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 (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 (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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get ByteString
getBytes
                ServerKeyXchgAlgorithmData -> Get ServerKeyXchgAlgorithmData
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 (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 (Put -> ByteString) -> Put -> ByteString
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 (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
forall a. TypeValuable a => a -> Word8
valOfType HandshakeType
ty) Put -> Put -> Put
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
    () -> Put
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
    () -> Put
forall (m :: * -> *) a. Monad m => a -> m a
return ()

encodeHandshakeContent (Certificates CertificateChain
cc) = 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

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 (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

encodeHandshakeContent (ServerKeyXchg ServerKeyXchgAlgorithmData
skg) =
    case ServerKeyXchgAlgorithmData
skg of
        SKX_RSA Maybe ServerRSAParams
_              -> String -> Put
forall a. HasCallStack => String -> a
error String
"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 Put -> Put -> Put
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 Put -> Put -> Put
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 (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 (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
_                      -> String -> Put
forall a. HasCallStack => String -> a
error (String
"encodeHandshakeContent: cannot handle: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ServerKeyXchgAlgorithmData -> String
forall a. Show a => a -> String
show ServerKeyXchgAlgorithmData
skg)

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

encodeHandshakeContent (CertRequest [CertificateType]
certTypes Maybe [HashAndSignatureAlgorithm]
sigAlgs [DistinguishedName]
certAuthorities) = do
    [Word8] -> Put
putWords8 ((CertificateType -> Word8) -> [CertificateType] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map CertificateType -> Word8
forall a. TypeValuable a => a -> Word8
valOfType [CertificateType]
certTypes)
    case Maybe [HashAndSignatureAlgorithm]
sigAlgs of
        Maybe [HashAndSignatureAlgorithm]
Nothing -> () -> Put
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just [HashAndSignatureAlgorithm]
l  -> [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
x,SignatureAlgorithm
y) -> Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HashAlgorithm -> Word8
forall a. TypeValuable a => a -> Word8
valOfType HashAlgorithm
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 (SignatureAlgorithm -> Word8
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 <- (DistinguishedName -> PutM ByteString)
-> [DistinguishedName] -> PutM [ByteString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t 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 (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 (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 (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 (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 (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 (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 (m :: * -> *) a. Monad m => a -> m a
return ([ExtensionRaw] -> Get [ExtensionRaw])
-> [ExtensionRaw] -> Get [ExtensionRaw]
forall a b. (a -> b) -> a -> b
$ Word16 -> ByteString -> ExtensionRaw
ExtensionRaw Word16
extty ByteString
extdata ExtensionRaw -> [ExtensionRaw] -> [ExtensionRaw]
forall a. a -> [a] -> [a]
: [ExtensionRaw]
extxs

putExtension :: ExtensionRaw -> Put
putExtension :: ExtensionRaw -> Put
putExtension (ExtensionRaw Word16
ty ByteString
l) = Word16 -> Put
putWord16 Word16
ty Put -> Put -> Put
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 (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 -> Maybe HashAlgorithm
forall a. TypeValuable a => Word8 -> Maybe a
valToType (Word8 -> Maybe HashAlgorithm)
-> Get Word8 -> Get (Maybe HashAlgorithm)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8) Get (Maybe HashAlgorithm)
-> (Maybe HashAlgorithm -> Get HashAlgorithm) -> Get HashAlgorithm
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe HashAlgorithm -> Get HashAlgorithm
forall (m :: * -> *) a. MonadFail m => String -> Maybe a -> m a
fromJustM String
"getSignatureHashAlgorithm"
    SignatureAlgorithm
s <- (Word8 -> Maybe SignatureAlgorithm
forall a. TypeValuable a => Word8 -> Maybe a
valToType (Word8 -> Maybe SignatureAlgorithm)
-> Get Word8 -> Get (Maybe SignatureAlgorithm)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8) Get (Maybe SignatureAlgorithm)
-> (Maybe SignatureAlgorithm -> Get SignatureAlgorithm)
-> Get SignatureAlgorithm
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe SignatureAlgorithm -> Get SignatureAlgorithm
forall (m :: * -> *) a. MonadFail m => String -> Maybe a -> m a
fromJustM String
"getSignatureHashAlgorithm"
    HashAndSignatureAlgorithm -> Get HashAndSignatureAlgorithm
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 (HashAlgorithm -> Word8
forall a. TypeValuable a => a -> Word8
valOfType HashAlgorithm
h) Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Word8
putWord8 (SignatureAlgorithm -> Word8
forall a. TypeValuable a => a -> Word8
valOfType SignatureAlgorithm
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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get BigNum
getBigNum16 Get (BigNum -> ServerDHParams) -> Get BigNum -> Get ServerDHParams
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
            Maybe Group
mgrp <- Word16 -> Maybe Group
forall a. EnumSafe16 a => Word16 -> Maybe a
toEnumSafe16 (Word16 -> Maybe Group) -> Get Word16 -> Get (Maybe Group)
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 -> String -> Get ServerECDHParams
forall a. HasCallStack => String -> a
error String
"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       -> String -> Get ServerECDHParams
forall a. HasCallStack => String -> a
error (String -> Get ServerECDHParams) -> String -> Get ServerECDHParams
forall a b. (a -> b) -> a -> b
$ String
"getServerECDHParams: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CryptoError -> String
forall a. Show a => a -> String
show CryptoError
e
                    Right GroupPublic
grppub -> ServerECDHParams -> Get ServerECDHParams
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
_ ->
            String -> Get ServerECDHParams
forall a. HasCallStack => String -> a
error String
"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 (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ Group -> Word16
forall a. EnumSafe16 a => a -> Word16
fromEnumSafe16 Group
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
    | Version
ver Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= Version
TLS12 = Maybe HashAndSignatureAlgorithm -> ByteString -> DigitallySigned
DigitallySigned (Maybe HashAndSignatureAlgorithm -> ByteString -> DigitallySigned)
-> Get (Maybe HashAndSignatureAlgorithm)
-> Get (ByteString -> DigitallySigned)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HashAndSignatureAlgorithm -> Maybe HashAndSignatureAlgorithm
forall a. a -> Maybe a
Just (HashAndSignatureAlgorithm -> Maybe HashAndSignatureAlgorithm)
-> Get HashAndSignatureAlgorithm
-> Get (Maybe HashAndSignatureAlgorithm)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get HashAndSignatureAlgorithm
getSignatureHashAlgorithm)
                                     Get (ByteString -> DigitallySigned)
-> Get ByteString -> Get DigitallySigned
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get ByteString
getOpaque16
    | Bool
otherwise    = Maybe HashAndSignatureAlgorithm -> ByteString -> DigitallySigned
DigitallySigned Maybe HashAndSignatureAlgorithm
forall a. Maybe a
Nothing (ByteString -> DigitallySigned)
-> Get ByteString -> Get DigitallySigned
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) =
    Put
-> (HashAndSignatureAlgorithm -> Put)
-> Maybe HashAndSignatureAlgorithm
-> Put
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Put
forall (m :: * -> *) a. Monad m => a -> m a
return ()) HashAndSignatureAlgorithm -> Put
putSignatureHashAlgorithm Maybe HashAndSignatureAlgorithm
mhash Put -> Put -> Put
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 = String -> Get () -> ByteString -> Either TLSError ()
forall a. String -> Get a -> ByteString -> Either TLSError a
runGetErr String
"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) (String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"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 = String
-> Get (Version, ByteString)
-> ByteString
-> Either TLSError (Version, ByteString)
forall a. String -> Get a -> ByteString -> Either TLSError a
runGetErr String
"pre-master-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
getVersion Get (ByteString -> (Version, ByteString))
-> Get ByteString -> Get (Version, ByteString)
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 Put -> Put -> Put
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 =
    String
-> Get ServerKeyXchgAlgorithmData
-> ByteString
-> Either TLSError ServerKeyXchgAlgorithmData
forall a. String -> Get a -> ByteString -> Either TLSError a
runGetErr String
"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

generateMasterSecret_SSL :: ByteArrayAccess preMaster => preMaster -> ClientRandom -> ServerRandom -> ByteString
generateMasterSecret_SSL :: preMaster -> ClientRandom -> ServerRandom -> ByteString
generateMasterSecret_SSL preMaster
premasterSecret (ClientRandom ByteString
c) (ServerRandom ByteString
s) =
    [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString) -> [ByteString] -> [ByteString]
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 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
B.concat [ preMaster -> ByteString
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 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
B.concat [ ByteString
label, preMaster -> ByteString
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 :: PRF -> preMaster -> ClientRandom -> ServerRandom -> ByteString
generateMasterSecret_TLS PRF
prf preMaster
premasterSecret (ClientRandom ByteString
c) (ServerRandom ByteString
s) =
    PRF
prf (preMaster -> ByteString
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 :: Version
-> Cipher
-> preMaster
-> ClientRandom
-> ServerRandom
-> ByteString
generateMasterSecret Version
SSL2 Cipher
_ = preMaster -> ClientRandom -> ServerRandom -> ByteString
forall preMaster.
ByteArrayAccess preMaster =>
preMaster -> ClientRandom -> ServerRandom -> ByteString
generateMasterSecret_SSL
generateMasterSecret Version
SSL3 Cipher
_ = preMaster -> ClientRandom -> ServerRandom -> ByteString
forall preMaster.
ByteArrayAccess preMaster =>
preMaster -> ClientRandom -> ServerRandom -> ByteString
generateMasterSecret_SSL
generateMasterSecret Version
v    Cipher
c = PRF -> preMaster -> ClientRandom -> ServerRandom -> ByteString
forall preMaster.
ByteArrayAccess preMaster =>
PRF -> preMaster -> ClientRandom -> ServerRandom -> ByteString
generateMasterSecret_TLS (PRF -> preMaster -> ClientRandom -> ServerRandom -> ByteString)
-> PRF -> preMaster -> ClientRandom -> ServerRandom -> ByteString
forall a b. (a -> b) -> a -> b
$ Version -> Cipher -> PRF
getPRF Version
v Cipher
c

generateExtendedMasterSec :: ByteArrayAccess preMaster
                          => Version
                          -> Cipher
                          -> preMaster
                          -> ByteString
                          -> ByteString
generateExtendedMasterSec :: Version -> Cipher -> preMaster -> ByteString -> ByteString
generateExtendedMasterSec Version
v Cipher
c preMaster
premasterSecret ByteString
sessionHash =
    Version -> Cipher -> PRF
getPRF Version
v Cipher
c (preMaster -> ByteString
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 ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> ByteString
computeMD5 ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Int -> [ByteString] -> [ByteString]
forall a. Int -> [a] -> [a]
take ((Int
kbsize Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
16) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [ByteString]
labels
  where labels :: [ByteString]
labels            = [ (Int -> Char -> ByteString) -> (Int, Char) -> ByteString
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Char -> ByteString
BC.replicate (Int, Char)
x | (Int, Char)
x <- [Int] -> String -> [(Int, Char)]
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 (ByteString -> ByteString) -> ByteString -> ByteString
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 (ByteString -> ByteString) -> ByteString -> ByteString
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 (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
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 (ByteString -> ByteString) -> ByteString -> ByteString
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 (ByteString -> ByteString) -> ByteString -> ByteString
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 (HashCtx -> ByteString) -> HashCtx -> ByteString
forall a b. (a -> b) -> a -> b
$ (HashCtx -> (ByteString, ByteString) -> HashCtx)
-> (ByteString, ByteString) -> HashCtx -> HashCtx
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)
                             (HashCtx -> HashCtx) -> HashCtx -> HashCtx
forall a b. (a -> b) -> a -> b
$ (HashCtx -> ByteString -> HashCtx)
-> HashCtx -> [ByteString] -> HashCtx
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 Version -> Version -> Bool
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 Version -> Version -> Bool
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 (HashCtx -> ByteString) -> HashCtx -> ByteString
forall a b. (a -> b) -> a -> b
$ (HashCtx -> ByteString -> HashCtx)
-> ByteString -> HashCtx -> HashCtx
forall a b c. (a -> b -> c) -> b -> a -> c
flip HashCtx -> ByteString -> HashCtx
hashUpdate ByteString
pad1
                             (HashCtx -> HashCtx) -> HashCtx -> HashCtx
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 (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$
    ClientRandom -> Put
putClientRandom32 ClientRandom
cran Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ServerRandom -> Put
putServerRandom32 ServerRandom
sran Put -> Put -> Put
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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ServerRandom -> Put
putServerRandom32 ServerRandom
sran Put -> Put -> Put
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 :: String -> Maybe a -> m a
fromJustM String
what Maybe a
Nothing  = String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"fromJustM " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
what String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": Nothing")
fromJustM String
_    (Just a
x) = a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x