    {-# 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
        , encodeHandshakes
        , encodeHandshakeHeader
        , encodeHandshakeContent

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

        , decodePreMasterSecret
        , encodePreMasterSecret
        , encodeSignedDHParams
        , encodeSignedECDHParams

        , decodeReallyServerKeyXchgAlgorithmData

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

        , generateCertificateVerify_SSL

        -- * for extensions parsing
        , getSignatureHashAlgorithm
        , putSignatureHashAlgorithm
        ) where

    import Network.TLS.Struct
    import Network.TLS.Wire
    import Network.TLS.Cap
    import Data.Maybe (fromJust)
    import Data.Word
    import Control.Applicative ((<$>), (<*>))
    import Control.Monad
    import Data.ASN1.Types (fromASN1, toASN1)
    import Data.ASN1.Encoding (decodeASN1', encodeASN1')
    import Data.ASN1.BinaryEncoding (DER(..))
    import Data.X509 (CertificateChainRaw(..), encodeCertificateChain, decodeCertificateChain)
    import Network.TLS.Crypto
    import Network.TLS.MAC
    import Network.TLS.Cipher (CipherKeyExchangeType(..))
    import Network.TLS.Util.Serialization (os2ip,i2ospOf_)
    import Data.ByteString (ByteString)
    import qualified Data.ByteString as B
    import qualified Data.ByteString.Char8 as BC

    data CurrentParams = CurrentParams
        { cParamsVersion     :: Version                     -- ^ current protocol version
        , cParamsKeyXchgType :: Maybe CipherKeyExchangeType -- ^ current key exchange type
        , cParamsSupportNPN  :: Bool                        -- ^ support Next Protocol Negotiation extension
        } deriving (Show,Eq)

    {- marshall helpers -}
    getVersion :: Get Version
    getVersion = do
        major <- getWord8
        minor <- getWord8
        case verOfNum (major, minor) of
            Nothing -> fail ("invalid version : " ++ show major ++ "," ++ show minor)
            Just v  -> return v

    putVersion :: Version -> Put
    putVersion ver = putWord8 major >> putWord8 minor
      where (major, minor) = numericalVer ver

    getHeaderType :: Get ProtocolType
    getHeaderType = do
        ty <- getWord8
        case valToType ty of
            Nothing -> fail ("invalid header type: " ++ show ty)
            Just t  -> return t

    putHeaderType :: ProtocolType -> Put
    putHeaderType = putWord8 . valOfType

    getHandshakeType :: Get HandshakeType
    getHandshakeType = do
        ty <- getWord8
        case valToType ty of
            Nothing -> fail ("invalid handshake type: " ++ show ty)
            Just t  -> return t

    {-
     - decode and encode headers
     -}
    decodeHeader :: ByteString -> Either TLSError Header
    decodeHeader = runGetErr "header" $ liftM3 Header getHeaderType getVersion getWord16

    decodeDeprecatedHeaderLength :: ByteString -> Either TLSError Word16
    decodeDeprecatedHeaderLength = runGetErr "deprecatedheaderlength" $ subtract 0x8000 <$> getWord16

    decodeDeprecatedHeader :: Word16 -> ByteString -> Either TLSError Header
    decodeDeprecatedHeader size =
        runGetErr "deprecatedheader" $ do
            1 <- getWord8
            version <- getVersion
            return $ Header ProtocolType_DeprecatedHandshake version size

    encodeHeader :: Header -> ByteString
    encodeHeader (Header pt ver len) = runPut (putHeaderType pt >> putVersion ver >> putWord16 len)
            {- FIXME check len <= 2^14 -}

    encodeHeaderNoVer :: Header -> ByteString
    encodeHeaderNoVer (Header pt _ len) = runPut (putHeaderType pt >> putWord16 len)
            {- FIXME check len <= 2^14 -}

    {-
     - decode and encode ALERT
     -}
    decodeAlert :: Get (AlertLevel, AlertDescription)
    decodeAlert = do
        al <- getWord8
        ad <- getWord8
        case (valToType al, valToType ad) of
            (Just a, Just d) -> return (a, d)
            (Nothing, _)     -> fail "cannot decode alert level"
            (_, Nothing)     -> fail "cannot decode alert description"

    decodeAlerts :: ByteString -> Either TLSError [(AlertLevel, AlertDescription)]
    decodeAlerts = runGetErr "alerts" $ loop
      where loop = do
                r <- remaining
                if r == 0
                    then return []
                    else liftM2 (:) decodeAlert loop

    encodeAlerts :: [(AlertLevel, AlertDescription)] -> ByteString
    encodeAlerts l = runPut $ mapM_ encodeAlert l
      where encodeAlert (al, ad) = putWord8 (valOfType al) >> putWord8 (valOfType ad)

    {- decode and encode HANDSHAKE -}
    decodeHandshakeRecord :: ByteString -> GetResult (HandshakeType, Bytes)
    decodeHandshakeRecord = runGet "handshake-record" $ do
        ty      <- getHandshakeType
        content <- getOpaque24
        return (ty, content)

    decodeHandshake :: CurrentParams -> HandshakeType -> ByteString -> Either TLSError Handshake
    decodeHandshake cp ty = runGetErr ("handshake[" ++ show ty ++ "]") $ case ty of
        HandshakeType_HelloRequest    -> decodeHelloRequest
        HandshakeType_ClientHello     -> decodeClientHello
        HandshakeType_ServerHello     -> decodeServerHello
        HandshakeType_Certificate     -> decodeCertificates
        HandshakeType_ServerKeyXchg   -> decodeServerKeyXchg cp
        HandshakeType_CertRequest     -> decodeCertRequest cp
        HandshakeType_ServerHelloDone -> decodeServerHelloDone
        HandshakeType_CertVerify      -> decodeCertVerify cp
        HandshakeType_ClientKeyXchg   -> decodeClientKeyXchg cp
        HandshakeType_Finished        -> decodeFinished
        HandshakeType_NPN             -> do
            unless (cParamsSupportNPN cp) $ fail "unsupported handshake type"
            decodeNextProtocolNegotiation

    decodeDeprecatedHandshake :: ByteString -> Either TLSError Handshake
    decodeDeprecatedHandshake b = runGetErr "deprecatedhandshake" getDeprecated b
      where getDeprecated = do
                1 <- getWord8
                ver <- getVersion
                cipherSpecLen <- fromEnum <$> getWord16
                sessionIdLen <- fromEnum <$> getWord16
                challengeLen <- fromEnum <$> getWord16
                ciphers <- getCipherSpec cipherSpecLen
                session <- getSessionId sessionIdLen
                random <- getChallenge challengeLen
                let compressions = [0]
                return $ ClientHello ver random session ciphers compressions [] (Just b)
            getCipherSpec len | len < 3 = return []
            getCipherSpec len = do
                [c0,c1,c2] <- map fromEnum <$> replicateM 3 getWord8
                ([ toEnum $ c1 * 0x100 + c2 | c0 == 0 ] ++) <$> getCipherSpec (len - 3)
            getSessionId 0 = return $ Session Nothing
            getSessionId len = Session . Just <$> getBytes len
            getChallenge len | 32 < len = getBytes (len - 32) >> getChallenge 32
            getChallenge len = ClientRandom . B.append (B.replicate (32 - len) 0) <$> getBytes len

    decodeHelloRequest :: Get Handshake
    decodeHelloRequest = return HelloRequest

    decodeClientHello :: Get Handshake
    decodeClientHello = do
        ver          <- getVersion
        random       <- getClientRandom32
        session      <- getSession
        ciphers      <- getWords16
        compressions <- getWords8
        r            <- remaining
        exts <- if hasHelloExtensions ver && r > 0
                then fmap fromIntegral getWord16 >>= getExtensions
                else return []
        return $ ClientHello ver random session ciphers compressions exts Nothing

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

    decodeServerHelloDone :: Get Handshake
    decodeServerHelloDone = return ServerHelloDone

    decodeCertificates :: Get Handshake
    decodeCertificates = do
        certsRaw <- CertificateChainRaw <$> (getWord24 >>= \len -> getList (fromIntegral len) getCertRaw)
        case decodeCertificateChain certsRaw of
            Left (i, s) -> fail ("error certificate parsing " ++ show i ++ ":" ++ s)
            Right cc    -> return $ Certificates cc
      where getCertRaw = getOpaque24 >>= \cert -> return (3 + B.length cert, cert)

    decodeFinished :: Get Handshake
    decodeFinished = Finished <$> (remaining >>= getBytes)

    decodeNextProtocolNegotiation :: Get Handshake
    decodeNextProtocolNegotiation = do
        opaque <- getOpaque8
        _      <- getOpaque8 -- ignore padding
        return $ HsNextProtocolNegotiation opaque

    decodeCertRequest :: CurrentParams -> Get Handshake
    decodeCertRequest cp = do
        certTypes <- map (fromJust . valToType . fromIntegral) <$> getWords8

        sigHashAlgs <- if cParamsVersion cp >= TLS12
                           then Just <$> (getWord16 >>= getSignatureHashAlgorithms)
                           else return Nothing
        dNameLen <- 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"
        dNames <- getList (fromIntegral dNameLen) getDName
        return $ CertRequest certTypes sigHashAlgs dNames
      where getSignatureHashAlgorithms len = getList (fromIntegral len) (getSignatureHashAlgorithm >>= \sh -> return (2, sh))
            getDName = do
                dName <- getOpaque16
                when (B.length dName == 0) $ fail "certrequest: invalid DN length"
                dn <- case decodeASN1' DER dName of
                        Left e      -> fail ("cert request decoding DistinguishedName ASN1 failed: " ++ show e)
                        Right asn1s -> case fromASN1 asn1s of
                                            Left e      -> fail ("cert request parsing DistinguishedName ASN1 failed: " ++ show e)
                                            Right (d,_) -> return d
                return (2 + B.length dName, dn)

    decodeCertVerify :: CurrentParams -> Get Handshake
    decodeCertVerify cp = CertVerify <$> getDigitallySigned (cParamsVersion cp)

    decodeClientKeyXchg :: CurrentParams -> Get Handshake
    decodeClientKeyXchg cp = -- case  ClientKeyXchg <$> (remaining >>= getBytes)
        case cParamsKeyXchgType cp of
            Nothing  -> error "no client key exchange type"
            Just cke -> ClientKeyXchg <$> parseCKE cke
      where parseCKE CipherKeyExchange_RSA     = CKX_RSA <$> (remaining >>= getBytes)
            parseCKE CipherKeyExchange_DHE_RSA = parseClientDHPublic
            parseCKE CipherKeyExchange_DHE_DSS = parseClientDHPublic
            parseCKE CipherKeyExchange_DH_Anon = parseClientDHPublic
            parseCKE CipherKeyExchange_ECDHE_RSA = parseClientECDHPublic
            parseCKE CipherKeyExchange_ECDHE_ECDSA = parseClientECDHPublic
            parseCKE _                         = error "unsupported client key exchange type"
            parseClientDHPublic = CKX_DH . dhPublic <$> getInteger16
            parseClientECDHPublic = do
                len      <- getWord8
                formatTy <- getWord8
                case formatTy of
                    4 -> do -- uncompressed
                        let siz = fromIntegral len `div` 2
                        xb <- getBytes siz
                        yb <- getBytes siz
                        let x = os2ip xb
                            y = os2ip yb
                        return $ CKX_ECDH $ ecdhPublic x y siz
                    _ -> error ("unsupported EC format type: " ++ show formatTy)

    decodeServerKeyXchg_DH :: Get ServerDHParams
    decodeServerKeyXchg_DH = getServerDHParams

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

    decodeServerKeyXchg_RSA :: Get ServerRSAParams
    decodeServerKeyXchg_RSA = ServerRSAParams <$> getInteger16 -- modulus
                                              <*> getInteger16 -- exponent

    decodeServerKeyXchgAlgorithmData :: Version
                                     -> CipherKeyExchangeType
                                     -> Get ServerKeyXchgAlgorithmData
    decodeServerKeyXchgAlgorithmData ver cke = toCKE
      where toCKE = case cke of
                CipherKeyExchange_RSA     -> SKX_RSA . Just <$> decodeServerKeyXchg_RSA
                CipherKeyExchange_DH_Anon -> SKX_DH_Anon <$> decodeServerKeyXchg_DH
                CipherKeyExchange_DHE_RSA -> do
                    dhparams  <- getServerDHParams
                    signature <- getDigitallySigned ver
                    return $ SKX_DHE_RSA dhparams signature
                CipherKeyExchange_DHE_DSS -> do
                    dhparams  <- getServerDHParams
                    signature <- getDigitallySigned ver
                    return $ SKX_DHE_DSS dhparams signature
                CipherKeyExchange_ECDHE_RSA -> do
                    dhparams  <- getServerECDHParams
                    signature <- getDigitallySigned ver
                    return $ SKX_ECDHE_RSA dhparams signature
                CipherKeyExchange_ECDHE_ECDSA -> do
                    dhparams  <- getServerECDHParams
                    signature <- getDigitallySigned ver
                    return $ SKX_ECDHE_ECDSA dhparams signature
                _ -> do
                    bs <- remaining >>= getBytes
                    return $ SKX_Unknown bs

    decodeServerKeyXchg :: CurrentParams -> Get Handshake
    decodeServerKeyXchg cp =
        case cParamsKeyXchgType cp of
            Just cke -> ServerKeyXchg <$> decodeServerKeyXchgAlgorithmData (cParamsVersion cp) cke
            Nothing  -> ServerKeyXchg . SKX_Unparsed <$> (remaining >>= getBytes)

    encodeHandshake :: Handshake -> ByteString
    encodeHandshake o =
        let content = runPut $ encodeHandshakeContent o in
        let len = fromIntegral $ B.length content in
        let header = case o of
                        ClientHello _ _ _ _ _ _ (Just _) -> "" -- SSLv2 ClientHello message
                        _ -> runPut $ encodeHandshakeHeader (typeOfHandshake o) len in
        B.concat [ header, content ]

    encodeHandshakes :: [Handshake] -> ByteString
    encodeHandshakes hss = B.concat $ map encodeHandshake hss

    encodeHandshakeHeader :: HandshakeType -> Int -> Put
    encodeHandshakeHeader ty len = putWord8 (valOfType ty) >> putWord24 len

    encodeHandshakeContent :: Handshake -> Put

    encodeHandshakeContent (ClientHello _ _ _ _ _ _ (Just deprecated)) = do
        putBytes deprecated
    encodeHandshakeContent (ClientHello version random session cipherIDs compressionIDs exts Nothing) = do
        putVersion version
        putClientRandom32 random
        putSession session
        putWords16 cipherIDs
        putWords8 compressionIDs
        putExtensions exts
        return ()

    encodeHandshakeContent (ServerHello version random session cipherID compressionID exts) =
        putVersion version >> putServerRandom32 random >> putSession session
                           >> putWord16 cipherID >> putWord8 compressionID
                           >> putExtensions exts >> return ()

    encodeHandshakeContent (Certificates cc) = putOpaque24 (runPut $ mapM_ putOpaque24 certs)
      where (CertificateChainRaw certs) = encodeCertificateChain cc

    encodeHandshakeContent (ClientKeyXchg ckx) = do
        case ckx of
            CKX_RSA encryptedPreMaster -> putBytes encryptedPreMaster
            CKX_DH clientDHPublic      -> putInteger16 $ dhUnwrapPublic clientDHPublic
            CKX_ECDH clientECDHPublic  -> do
                let (x,y,siz) = ecdhUnwrapPublic clientECDHPublic
                let xb = i2ospOf_ siz x
                    yb = i2ospOf_ siz y
                putOpaque8 $ B.concat [B.singleton 4,xb,yb]

    encodeHandshakeContent (ServerKeyXchg skg) =
        case skg of
            SKX_RSA _              -> error "encodeHandshakeContent SKX_RSA not implemented"
            SKX_DH_Anon params     -> putServerDHParams params
            SKX_DHE_RSA params sig -> putServerDHParams params >> putDigitallySigned sig
            SKX_DHE_DSS params sig -> putServerDHParams params >> putDigitallySigned sig
            SKX_ECDHE_RSA params sig -> putServerECDHParams params >> putDigitallySigned sig
            SKX_ECDHE_ECDSA params sig -> putServerECDHParams params >> putDigitallySigned sig
            SKX_Unparsed bytes     -> putBytes bytes
            _                      -> error ("encodeHandshakeContent: cannot handle: " ++ show skg)

    encodeHandshakeContent (HelloRequest) = return ()
    encodeHandshakeContent (ServerHelloDone) = return ()

    encodeHandshakeContent (CertRequest certTypes sigAlgs certAuthorities) = do
        putWords8 (map valOfType certTypes)
        case sigAlgs of
            Nothing -> return ()
            Just l  -> putWords16 $ map (\(x,y) -> (fromIntegral $ valOfType x) * 256 + (fromIntegral $ valOfType y)) l
        encodeCertAuthorities certAuthorities
      where -- Convert a distinguished name to its DER encoding.
            encodeCA dn = return $ encodeASN1' DER (toASN1 dn []) --B.concat $ L.toChunks $ encodeDN dn

            -- Encode a list of distinguished names.
            encodeCertAuthorities certAuths = do
                enc <- mapM encodeCA certAuths
                let totLength = sum $ map (((+) 2) . B.length) enc
                putWord16 (fromIntegral totLength)
                mapM_ (\ b -> putWord16 (fromIntegral (B.length b)) >> putBytes b) enc

    encodeHandshakeContent (CertVerify digitallySigned) = putDigitallySigned digitallySigned

    encodeHandshakeContent (Finished opaque) = putBytes opaque

    encodeHandshakeContent (HsNextProtocolNegotiation protocol) = do
        putOpaque8 protocol
        putOpaque8 $ B.replicate paddingLen 0
      where paddingLen = 32 - ((B.length protocol + 2) `mod` 32)

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

    getServerRandom32 :: Get ServerRandom
    getServerRandom32 = ServerRandom <$> getRandom32

    getClientRandom32 :: Get ClientRandom
    getClientRandom32 = ClientRandom <$> getRandom32

    putRandom32 :: Bytes -> Put
    putRandom32 = putBytes

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

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

    getSession :: Get Session
    getSession = do
        len8 <- getWord8
        case fromIntegral len8 of
            0   -> return $ Session Nothing
            len -> Session . Just <$> getBytes len

    putSession :: Session -> Put
    putSession (Session Nothing)  = putWord8 0
    putSession (Session (Just s)) = putOpaque8 s

    getExtensions :: Int -> Get [ExtensionRaw]
    getExtensions 0   = return []
    getExtensions len = do
        extty <- getWord16
        extdatalen <- getWord16
        extdata <- getBytes $ fromIntegral extdatalen
        extxs <- getExtensions (len - fromIntegral extdatalen - 4)
        return $ (extty, extdata) : extxs

    putExtension :: ExtensionRaw -> Put
    putExtension (ty, l) = putWord16 ty >> putOpaque16 l

    putExtensions :: [ExtensionRaw] -> Put
    putExtensions [] = return ()
    putExtensions es = putOpaque16 (runPut $ mapM_ putExtension es)

    getSignatureHashAlgorithm :: Get HashAndSignatureAlgorithm
    getSignatureHashAlgorithm = do
        h <- fromJust . valToType <$> getWord8
        s <- fromJust . valToType <$> getWord8
        return (h,s)

    putSignatureHashAlgorithm :: HashAndSignatureAlgorithm -> Put
    putSignatureHashAlgorithm (h,s) =
        putWord8 (valOfType h) >> putWord8 (valOfType s)

    getServerDHParams :: Get ServerDHParams
    getServerDHParams = ServerDHParams <$> getBigNum16 <*> getBigNum16 <*> getBigNum16

    putServerDHParams :: ServerDHParams -> Put
    putServerDHParams (ServerDHParams p g y) = mapM_ putBigNum16 [p,g,y]

    getServerECDHParams :: Get ServerECDHParams
    getServerECDHParams = do
        curveType <- getWord8
        case curveType of
            1 -> do -- explicit prime
                _prime    <- getOpaque8
                _a        <- getOpaque8
                _b        <- getOpaque8
                _base     <- getOpaque8
                _order    <- getOpaque8
                _cofactor <- getOpaque8
                error "cannot handle explicit prime ECDH Params"
            2 -> -- explicit_char2
                error "cannot handle explicit char2 ECDH Params"
            3 -> do -- ECParameters ECCurveType: curve name type
                w16 <- getWord16   -- ECParameters NamedCurve
                mxy <- getOpaque8 -- ECPoint
                let xy = B.drop 1 mxy
                    siz = B.length xy `div` 2
                    (xb,yb) = B.splitAt siz xy
                    x = os2ip xb
                    y = os2ip yb
                return $ ServerECDHParams (ecdhParams w16) (ecdhPublic x y siz)
            _ ->
                error "unknown type for ECDH Params"

    putServerECDHParams :: ServerECDHParams -> Put
    putServerECDHParams (ServerECDHParams ecdhparams ecdhpub) = do
        let (w16,x,y,siz) = ecdhUnwrap ecdhparams ecdhpub
        putWord8 3    -- ECParameters ECCurveType: curve name type
        putWord16 w16 -- ECParameters NamedCurve
        let xb = i2ospOf_ siz x
            yb = i2ospOf_ siz y
        putOpaque8 $ B.concat [B.singleton 4,xb,yb] -- ECPoint

    getDigitallySigned :: Version -> Get DigitallySigned
    getDigitallySigned ver
        | ver >= TLS12 = DigitallySigned <$> (Just <$> getSignatureHashAlgorithm)
                                         <*> getOpaque16
        | otherwise    = DigitallySigned Nothing <$> getOpaque16

    putDigitallySigned :: DigitallySigned -> Put
    putDigitallySigned (DigitallySigned mhash sig) =
        maybe (return ()) putSignatureHashAlgorithm mhash >> putOpaque16 sig

    {-
     - decode and encode ALERT
     -}

    decodeChangeCipherSpec :: ByteString -> Either TLSError ()
    decodeChangeCipherSpec = runGetErr "changecipherspec" $ do
        x <- getWord8
        when (x /= 1) (fail "unknown change cipher spec content")

    encodeChangeCipherSpec :: ByteString
    encodeChangeCipherSpec = runPut (putWord8 1)

    -- rsa pre master secret
    decodePreMasterSecret :: Bytes -> Either TLSError (Version, Bytes)
    decodePreMasterSecret = runGetErr "pre-master-secret" $ do
        liftM2 (,) getVersion (getBytes 46)

    encodePreMasterSecret :: Version -> Bytes -> Bytes
    encodePreMasterSecret version bytes = runPut (putVersion version >> putBytes 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
                                           -> Bytes
                                           -> Either TLSError ServerKeyXchgAlgorithmData
    decodeReallyServerKeyXchgAlgorithmData ver cke =
        runGetErr "server-key-xchg-algorithm-data" (decodeServerKeyXchgAlgorithmData ver cke)

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

    generateMasterSecret_SSL :: Bytes -> ClientRandom -> ServerRandom -> Bytes
    generateMasterSecret_SSL premasterSecret (ClientRandom c) (ServerRandom s) =
        B.concat $ map (computeMD5) ["A","BB","CCC"]
      where computeMD5  label = hash MD5 $ B.concat [ premasterSecret, computeSHA1 label ]
            computeSHA1 label = hash SHA1 $ B.concat [ label, premasterSecret, c, s ]

    generateMasterSecret_TLS :: PRF -> Bytes -> ClientRandom -> ServerRandom -> Bytes
    generateMasterSecret_TLS prf premasterSecret (ClientRandom c) (ServerRandom s) =
        prf premasterSecret seed 48
      where seed = B.concat [ "master secret", c, s ]

    generateMasterSecret :: Version -> Bytes -> ClientRandom -> ServerRandom -> Bytes
    generateMasterSecret SSL2  = generateMasterSecret_SSL
    generateMasterSecret SSL3  = generateMasterSecret_SSL
    generateMasterSecret TLS10 = generateMasterSecret_TLS prf_MD5SHA1
    generateMasterSecret TLS11 = generateMasterSecret_TLS prf_MD5SHA1
    generateMasterSecret TLS12 = generateMasterSecret_TLS prf_SHA256

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

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

    generateKeyBlock :: Version -> ClientRandom -> ServerRandom -> Bytes -> Int -> Bytes
    generateKeyBlock SSL2  = generateKeyBlock_SSL
    generateKeyBlock SSL3  = generateKeyBlock_SSL
    generateKeyBlock TLS10 = generateKeyBlock_TLS prf_MD5SHA1
    generateKeyBlock TLS11 = generateKeyBlock_TLS prf_MD5SHA1
    generateKeyBlock TLS12 = generateKeyBlock_TLS prf_SHA256

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

    generateFinished_SSL :: Bytes -> Bytes -> HashCtx -> Bytes
    generateFinished_SSL sender mastersecret hashctx = B.concat [md5hash, sha1hash]
      where md5hash  = hash MD5 $ B.concat [ mastersecret, pad2, md5left ]
            sha1hash = hash SHA1 $ B.concat [ mastersecret, B.take 40 pad2, sha1left ]

            lefthash = hashFinal $ flip hashUpdateSSL (pad1, B.take 40 pad1)
                                 $ foldl hashUpdate hashctx [sender,mastersecret]
            (md5left,sha1left) = B.splitAt 16 lefthash
            pad2     = B.replicate 48 0x5c
            pad1     = B.replicate 48 0x36

    generateClientFinished :: Version -> Bytes -> HashCtx -> Bytes
    generateClientFinished ver
        | ver < TLS10 = generateFinished_SSL "CLNT"
        | ver < TLS12 = generateFinished_TLS prf_MD5SHA1 "client finished"
        | otherwise   = generateFinished_TLS prf_SHA256 "client finished"

    generateServerFinished :: Version -> Bytes -> HashCtx -> Bytes
    generateServerFinished ver
        | ver < TLS10 = generateFinished_SSL "SRVR"
        | ver < TLS12 = generateFinished_TLS prf_MD5SHA1 "server finished"
        | otherwise   = generateFinished_TLS prf_SHA256 "server finished"

    generateCertificateVerify_SSL :: Bytes -> HashCtx -> Bytes
    generateCertificateVerify_SSL = generateFinished_SSL ""

    encodeSignedDHParams :: ServerDHParams -> ClientRandom -> ServerRandom -> Bytes
    encodeSignedDHParams dhparams cran sran = runPut $
        putClientRandom32 cran >> putServerRandom32 sran >> putServerDHParams 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 -> Bytes
    encodeSignedECDHParams dhparams cran sran = runPut $
        putClientRandom32 cran >> putServerRandom32 sran >> putServerECDHParams dhparams