    {-# 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.Crypto
    import Network.TLS.Imports
    import Network.TLS.MAC
    import Network.TLS.Struct
    import Network.TLS.Types
    import Network.TLS.Util.ASN1
    import Network.TLS.Wire

    ----------------------------------------------------------------
    -- Header

    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

    ------------------------------------------------------------
    -- CCS

    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
        x <- Get Word8
    getWord8
        when (x /= 1) $ fail "unknown change cipher spec content"
        len <- remaining
        when (len /= 0) $ fail "the length of CSS must be 1"

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

    ----------------------------------------------------------------
    -- Alert

    decodeAlert :: Get (AlertLevel, AlertDescription)
    decodeAlert :: Get (AlertLevel, AlertDescription)
    decodeAlert = do
        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
        ad <- AlertDescription <$> getWord8
        return (al, 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
            r <- Get Int
    remaining
            if r == 0
                then return []
                else (:) <$> decodeAlert <*> 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 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
        ty <- Get HandshakeType
    getHandshakeType
        content <- getOpaque24
        return (ty, content)

    {- FOURMOLU_DISABLE -}
    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_NewSessionTicket -> Get Handshake
    decodeNewSessionTicket
        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
    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
    {- FOURMOLU_ENABLE -}

    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
        ver <- Get Version
    getBinaryVersion
        random <- getClientRandom32
        session <- getSession
        ciphers <- map CipherId <$> getWords16
        compressions <- getWords8
        r <- remaining
        exts <-
            if r > 0
                then getWord16 >>= getExtensions . fromIntegral
                else return []
        r1 <- remaining
        when (r1 /= 0) $ fail "Client hello"
        let ch = Session -> [CipherId] -> [ExtensionRaw] -> CH
    CH Session
    session [CipherId]
    ciphers [ExtensionRaw]
    exts
        return $ ClientHello ver random compressions ch

    decodeServerHello :: Get Handshake
    decodeServerHello :: Get Handshake
    decodeServerHello = do
        ver <- Get Version
    getBinaryVersion
        random <- getServerRandom32
        session <- getSession
        cipherid <- CipherId <$> getWord16
        compressionid <- getWord8
        r <- remaining
        exts <-
            if r > 0
                then getWord16 >>= getExtensions . fromIntegral
                else return []
        return $ ServerHello ver random session cipherid compressionid exts

    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

    decodeCertificate :: Get Handshake
    decodeCertificate :: Get Handshake
    decodeCertificate = do
        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 decodeCertificateChain 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
    $ TLSCertificateChain -> Handshake
    Certificate (TLSCertificateChain -> Handshake)
    -> TLSCertificateChain -> Handshake
    forall a b. (a -> b) -> a -> b
    $ CertificateChain -> TLSCertificateChain
    TLSCertificateChain 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)

    ----

    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)

    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
                dhparams <- Get ServerDHParams
    getServerDHParams
                signature <- getDigitallySigned ver
                return $ SKX_DHE_RSA dhparams signature
            CipherKeyExchangeType
    CipherKeyExchange_DHE_DSA -> do
                dhparams <- Get ServerDHParams
    getServerDHParams
                signature <- getDigitallySigned ver
                return $ SKX_DHE_DSA dhparams signature
            CipherKeyExchangeType
    CipherKeyExchange_ECDHE_RSA -> do
                ecdhparams <- Get ServerECDHParams
    getServerECDHParams
                signature <- getDigitallySigned ver
                return $ SKX_ECDHE_RSA ecdhparams signature
            CipherKeyExchangeType
    CipherKeyExchange_ECDHE_ECDSA -> do
                ecdhparams <- Get ServerECDHParams
    getServerECDHParams
                signature <- getDigitallySigned ver
                return $ SKX_ECDHE_ECDSA ecdhparams signature
            CipherKeyExchangeType
    _ -> do
                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
                return $ SKX_Unknown bs

    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

    ----

    decodeCertRequest :: CurrentParams -> Get Handshake
    decodeCertRequest :: CurrentParams -> Get Handshake
    decodeCertRequest CurrentParams
    _cp = do
        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
        sigHashAlgs <- getWord16 >>= getSignatureHashAlgorithms
        CertRequest certTypes sigHashAlgs <$> 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))

    ----

    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

    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. [Char] -> Get a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail [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. [Char] -> Get a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail [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

    decodeFinished :: Get Handshake
    decodeFinished :: Get Handshake
    decodeFinished = VerifyData -> Handshake
    Finished (VerifyData -> Handshake)
    -> (ByteString -> VerifyData) -> ByteString -> Handshake
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> VerifyData
    VerifyData (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)

    ----------------------------------------------------------------
    -- encode HANDSHAKE

    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' Handshake
    HelloRequest = ByteString
    ""
    encodeHandshake' (ClientHello Version
    version ClientRandom
    random [Word8]
    compressionIDs CH{[CipherId]
    [ExtensionRaw]
    Session
    chSession :: Session
    chCiphers :: [CipherId]
    chExtensions :: [ExtensionRaw]
    chExtensions :: CH -> [ExtensionRaw]
    chCiphers :: CH -> [CipherId]
    chSession :: CH -> Session
    ..}) = 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] -> Put) -> [Word16] -> Put
    forall a b. (a -> b) -> a -> b
    $ (CipherId -> Word16) -> [CipherId] -> [Word16]
    forall a b. (a -> b) -> [a] -> [b]
    map CipherId -> Word16
    fromCipherId [CipherId]
    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 CipherId
    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 -> Put) -> Word16 -> Put
    forall a b. (a -> b) -> a -> b
    $ CipherId -> Word16
    fromCipherId CipherId
    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' (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
    encodeHandshake' (Certificate (TLSCertificateChain CertificateChain
    cc)) = CertificateChain -> ByteString
    encodeCertificate CertificateChain
    cc
    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' (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' Handshake
    ServerHelloDone = ByteString
    ""
    encodeHandshake' (CertVerify DigitallySigned
    digitallySigned) = Put -> ByteString
    runPut (Put -> ByteString) -> Put -> ByteString
    forall a b. (a -> b) -> a -> b
    $ DigitallySigned -> Put
    putDigitallySigned DigitallySigned
    digitallySigned
    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' (Finished (VerifyData ByteString
    opaque)) = Put -> ByteString
    runPut (Put -> ByteString) -> Put -> ByteString
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Put
    putBytes ByteString
    opaque

    ------------------------------------------------------------
    -- CA distinguished names

    -- | Decode a list CA distinguished names
    getDNames :: Get [DistinguishedName]
    getDNames :: Get [DistinguishedName]
    getDNames = do
        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"
        getList (fromIntegral dNameLen) getDName
      where
        getDName :: Get (Int, DistinguishedName)
    getDName = do
            dName <- Get ByteString
    getOpaque16
            when (B.length dName == 0) $ fail "certrequest: invalid DN length"
            dn <-
                either fail return $ decodeASN1Object "cert request DistinguishedName" dName
            return (2 + B.length dName, dn)

    -- | Encode a list of distinguished names.
    putDNames :: [DistinguishedName] -> Put
    putDNames :: [DistinguishedName] -> Put
    putDNames [DistinguishedName]
    dnames = do
        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] -> 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
        putWord16 (fromIntegral totLength)
        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) 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
        len8 <- Get Word8
    getWord8
        case fromIntegral 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
                | Int
    len Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    32 -> [Char] -> Get Session
    forall a. [Char] -> Get a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail [Char]
    "the length of session id must be <= 32"
                | Bool
    otherwise -> 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
        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
        extdatalen <- getWord16
        extdata <- getBytes $ fromIntegral extdatalen
        extxs <- getExtensions (len - fromIntegral extdatalen - 4)
        return $ ExtensionRaw extty extdata : 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
        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
        s <- SignatureAlgorithm <$> getWord8
        return (h, 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
        curveType <- Get Word8
    getWord8
        case curveType of
            Word8
    3 -> do
                -- ECParameters ECCurveType: curve name type
                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
                mxy <- getOpaque8 -- ECPoint
                case decodeGroupPublic grp mxy of
                    Left CryptoError
    e -> [Char] -> Get ServerECDHParams
    forall a. [Char] -> Get a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail ([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. [Char] -> Get a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail [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

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

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

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

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

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