    {-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving, BangPatterns #-}

    -- |
    -- Module      : Network.TLS.Handshake.Common13
    -- License     : BSD-style
    -- Maintainer  : Vincent Hanquez <vincent@snarc.org>
    -- Stability   : experimental
    -- Portability : unknown
    --
    module Network.TLS.Handshake.Common13
           ( makeFinished
           , checkFinished
           , makeServerKeyShare
           , makeClientKeyShare
           , fromServerKeyShare
           , makeCertVerify
           , checkCertVerify
           , makePSKBinder
           , replacePSKBinder
           , sendChangeCipherSpec13
           , handshakeTerminate13
           , makeCertRequest
           , createTLS13TicketInfo
           , ageToObfuscatedAge
           , isAgeValid
           , getAge
           , checkFreshness
           , getCurrentTimeFromBase
           , getSessionData13
           , ensureNullCompression
           , isHashSignatureValid13
           , safeNonNegative32
           , RecvHandshake13M
           , runRecvHandshake13
           , recvHandshake13
           , recvHandshake13hash
           , CipherChoice(..)
           , makeCipherChoice
           , initEarlySecret
           , calculateEarlySecret
           , calculateHandshakeSecret
           , calculateApplicationSecret
           , calculateResumptionSecret
           , derivePSK
           , checkKeyShareKeyLength
           ) where

    import qualified Data.ByteArray as BA
    import qualified Data.ByteString as B
    import Data.UnixTime
    import Foreign.C.Types (CTime(..))
    import Network.TLS.Cipher
    import Network.TLS.Compression
    import Network.TLS.Context.Internal
    import Network.TLS.Crypto
    import qualified Network.TLS.Crypto.IES as IES
    import Network.TLS.Extension
    import Network.TLS.Handshake.Certificate (extractCAname)
    import Network.TLS.Handshake.Common (unexpected)
    import Network.TLS.Handshake.Key
    import Network.TLS.Handshake.Process (processHandshake13)
    import Network.TLS.Handshake.Signature
    import Network.TLS.Handshake.State
    import Network.TLS.Handshake.State13
    import Network.TLS.IO
    import Network.TLS.Imports
    import Network.TLS.KeySchedule
    import Network.TLS.MAC
    import Network.TLS.Parameters
    import Network.TLS.State
    import Network.TLS.Struct
    import Network.TLS.Struct13
    import Network.TLS.Types
    import Network.TLS.Wire

    import Control.Concurrent.MVar
    import Control.Monad.State.Strict
    import Data.IORef (writeIORef)

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

    makeFinished :: MonadIO m => Context -> Hash -> ByteString -> m Handshake13
    makeFinished :: forall (m :: * -> *).
    MonadIO m =>
    Context -> Hash -> ByteString -> m Handshake13
    makeFinished Context
    ctx Hash
    usedHash ByteString
    baseKey = do
        ByteString
    finished <- Hash -> ByteString -> ByteString -> ByteString
    makeVerifyData Hash
    usedHash ByteString
    baseKey (ByteString -> ByteString) -> m ByteString -> m ByteString
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Context -> m ByteString
    forall (m :: * -> *). MonadIO m => Context -> m ByteString
    transcriptHash Context
    ctx
        IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ IORef (Maybe ByteString) -> Maybe ByteString -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef (Context -> IORef (Maybe ByteString)
    ctxFinished Context
    ctx) (ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just ByteString
    finished)
        Handshake13 -> m Handshake13
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Handshake13 -> m Handshake13) -> Handshake13 -> m Handshake13
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Handshake13
    Finished13 ByteString
    finished

    checkFinished :: MonadIO m => Context -> Hash -> ByteString -> ByteString -> ByteString -> m ()
    checkFinished :: forall (m :: * -> *).
    MonadIO m =>
    Context -> Hash -> ByteString -> ByteString -> ByteString -> m ()
    checkFinished Context
    ctx Hash
    usedHash ByteString
    baseKey ByteString
    hashValue ByteString
    verifyData = do
        let verifyData' :: ByteString
    verifyData' = Hash -> ByteString -> ByteString -> ByteString
    makeVerifyData Hash
    usedHash ByteString
    baseKey ByteString
    hashValue
        Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (ByteString -> Int
    B.length ByteString
    verifyData Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ByteString -> Int
    B.length ByteString
    verifyData') (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ TLSError -> m ()
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> m ()) -> TLSError -> m ()
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol (String
    "broken Finished", Bool
    True, AlertDescription
    DecodeError)
        Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (ByteString
    verifyData' ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString
    verifyData) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ String -> m ()
    forall (m :: * -> *) a. MonadIO m => String -> m a
    decryptError String
    "cannot verify finished"
        IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ IORef (Maybe ByteString) -> Maybe ByteString -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef (Context -> IORef (Maybe ByteString)
    ctxPeerFinished Context
    ctx) (ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just ByteString
    verifyData)

    makeVerifyData :: Hash -> ByteString -> ByteString -> ByteString
    makeVerifyData :: Hash -> ByteString -> ByteString -> ByteString
    makeVerifyData Hash
    usedHash ByteString
    baseKey = Hash -> ByteString -> ByteString -> ByteString
    hmac Hash
    usedHash ByteString
    finishedKey
      where
        hashSize :: Int
    hashSize = Hash -> Int
    hashDigestSize Hash
    usedHash
        finishedKey :: ByteString
    finishedKey = Hash -> ByteString -> ByteString -> ByteString -> Int -> ByteString
    hkdfExpandLabel Hash
    usedHash ByteString
    baseKey ByteString
    "finished" ByteString
    "" Int
    hashSize

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

    makeServerKeyShare :: Context -> KeyShareEntry -> IO (ByteString, KeyShareEntry)
    makeServerKeyShare :: Context -> KeyShareEntry -> IO (ByteString, KeyShareEntry)
    makeServerKeyShare Context
    ctx (KeyShareEntry Group
    grp ByteString
    wcpub) = case Either CryptoError GroupPublic
    ecpub of
      Left  CryptoError
    e    -> TLSError -> IO (ByteString, KeyShareEntry)
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO (ByteString, KeyShareEntry))
    -> TLSError -> IO (ByteString, KeyShareEntry)
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol (CryptoError -> String
    forall a. Show a => a -> String
    show CryptoError
    e, Bool
    True, AlertDescription
    IllegalParameter)
      Right GroupPublic
    cpub -> do
          Maybe (GroupPublic, GroupKey)
    ecdhePair <- Context -> GroupPublic -> IO (Maybe (GroupPublic, GroupKey))
    generateECDHEShared Context
    ctx GroupPublic
    cpub
          case Maybe (GroupPublic, GroupKey)
    ecdhePair of
              Maybe (GroupPublic, GroupKey)
    Nothing -> TLSError -> IO (ByteString, KeyShareEntry)
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO (ByteString, KeyShareEntry))
    -> TLSError -> IO (ByteString, KeyShareEntry)
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol (String
    msgInvalidPublic, Bool
    True, AlertDescription
    IllegalParameter)
              Just (GroupPublic
    spub, GroupKey
    share) ->
                  let wspub :: ByteString
    wspub = GroupPublic -> ByteString
    IES.encodeGroupPublic GroupPublic
    spub
                      serverKeyShare :: KeyShareEntry
    serverKeyShare = Group -> ByteString -> KeyShareEntry
    KeyShareEntry Group
    grp ByteString
    wspub
                   in (ByteString, KeyShareEntry) -> IO (ByteString, KeyShareEntry)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (GroupKey -> ByteString
    forall bin bout.
    (ByteArrayAccess bin, ByteArray bout) =>
    bin -> bout
    BA.convert GroupKey
    share, KeyShareEntry
    serverKeyShare)
      where
        ecpub :: Either CryptoError GroupPublic
    ecpub = Group -> ByteString -> Either CryptoError GroupPublic
    IES.decodeGroupPublic Group
    grp ByteString
    wcpub
        msgInvalidPublic :: String
    msgInvalidPublic = String
    "invalid client " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Group -> String
    forall a. Show a => a -> String
    show Group
    grp String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " public key"

    makeClientKeyShare :: Context -> Group -> IO (IES.GroupPrivate, KeyShareEntry)
    makeClientKeyShare :: Context -> Group -> IO (GroupPrivate, KeyShareEntry)
    makeClientKeyShare Context
    ctx Group
    grp = do
        (GroupPrivate
    cpri, GroupPublic
    cpub) <- Context -> Group -> IO (GroupPrivate, GroupPublic)
    generateECDHE Context
    ctx Group
    grp
        let wcpub :: ByteString
    wcpub = GroupPublic -> ByteString
    IES.encodeGroupPublic GroupPublic
    cpub
            clientKeyShare :: KeyShareEntry
    clientKeyShare = Group -> ByteString -> KeyShareEntry
    KeyShareEntry Group
    grp ByteString
    wcpub
        (GroupPrivate, KeyShareEntry) -> IO (GroupPrivate, KeyShareEntry)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (GroupPrivate
    cpri, KeyShareEntry
    clientKeyShare)

    fromServerKeyShare :: KeyShareEntry -> IES.GroupPrivate -> IO ByteString
    fromServerKeyShare :: KeyShareEntry -> GroupPrivate -> IO ByteString
    fromServerKeyShare (KeyShareEntry Group
    grp ByteString
    wspub) GroupPrivate
    cpri = case Either CryptoError GroupPublic
    espub of
      Left  CryptoError
    e    -> TLSError -> IO ByteString
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO ByteString) -> TLSError -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol (CryptoError -> String
    forall a. Show a => a -> String
    show CryptoError
    e, Bool
    True, AlertDescription
    IllegalParameter)
      Right GroupPublic
    spub -> case GroupPublic -> GroupPrivate -> Maybe GroupKey
    IES.groupGetShared GroupPublic
    spub GroupPrivate
    cpri of
        Just GroupKey
    shared -> ByteString -> IO ByteString
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ GroupKey -> ByteString
    forall bin bout.
    (ByteArrayAccess bin, ByteArray bout) =>
    bin -> bout
    BA.convert GroupKey
    shared
        Maybe GroupKey
    Nothing     -> TLSError -> IO ByteString
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO ByteString) -> TLSError -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol (String
    "cannot generate a shared secret on (EC)DH", Bool
    True, AlertDescription
    IllegalParameter)
      where
        espub :: Either CryptoError GroupPublic
    espub = Group -> ByteString -> Either CryptoError GroupPublic
    IES.decodeGroupPublic Group
    grp ByteString
    wspub

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

    serverContextString :: ByteString
    serverContextString :: ByteString
    serverContextString = ByteString
    "TLS 1.3, server CertificateVerify"

    clientContextString :: ByteString
    clientContextString :: ByteString
    clientContextString = ByteString
    "TLS 1.3, client CertificateVerify"

    makeCertVerify :: MonadIO m => Context -> PubKey -> HashAndSignatureAlgorithm -> ByteString -> m Handshake13
    makeCertVerify :: forall (m :: * -> *).
    MonadIO m =>
    Context
    -> PubKey
    -> HashAndSignatureAlgorithm
    -> ByteString
    -> m Handshake13
    makeCertVerify Context
    ctx PubKey
    pub HashAndSignatureAlgorithm
    hs ByteString
    hashValue = do
        Role
    cc <- IO Role -> m Role
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Role -> m Role) -> IO Role -> m Role
    forall a b. (a -> b) -> a -> b
    $ Context -> TLSSt Role -> IO Role
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx TLSSt Role
    isClientContext
        let ctxStr :: ByteString
    ctxStr | Role
    cc Role -> Role -> Bool
    forall a. Eq a => a -> a -> Bool
    == Role
    ClientRole = ByteString
    clientContextString
                   | Bool
    otherwise        = ByteString
    serverContextString
            target :: ByteString
    target = ByteString -> ByteString -> ByteString
    makeTarget ByteString
    ctxStr ByteString
    hashValue
        HashAndSignatureAlgorithm -> ByteString -> Handshake13
    CertVerify13 HashAndSignatureAlgorithm
    hs (ByteString -> Handshake13) -> m ByteString -> m Handshake13
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Context
    -> PubKey
    -> HashAndSignatureAlgorithm
    -> ByteString
    -> m ByteString
    forall (m :: * -> *).
    MonadIO m =>
    Context
    -> PubKey
    -> HashAndSignatureAlgorithm
    -> ByteString
    -> m ByteString
    sign Context
    ctx PubKey
    pub HashAndSignatureAlgorithm
    hs ByteString
    target

    checkCertVerify :: MonadIO m => Context -> PubKey -> HashAndSignatureAlgorithm -> Signature -> ByteString -> m Bool
    checkCertVerify :: forall (m :: * -> *).
    MonadIO m =>
    Context
    -> PubKey
    -> HashAndSignatureAlgorithm
    -> ByteString
    -> ByteString
    -> m Bool
    checkCertVerify Context
    ctx PubKey
    pub HashAndSignatureAlgorithm
    hs ByteString
    signature ByteString
    hashValue
        | PubKey
    pub PubKey -> HashAndSignatureAlgorithm -> Bool
    `signatureCompatible13` HashAndSignatureAlgorithm
    hs = IO Bool -> m Bool
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
    forall a b. (a -> b) -> a -> b
    $ do
            Role
    cc <- Context -> TLSSt Role -> IO Role
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx TLSSt Role
    isClientContext
            let ctxStr :: ByteString
    ctxStr | Role
    cc Role -> Role -> Bool
    forall a. Eq a => a -> a -> Bool
    == Role
    ClientRole = ByteString
    serverContextString -- opposite context
                    | Bool
    otherwise        = ByteString
    clientContextString
                target :: ByteString
    target = ByteString -> ByteString -> ByteString
    makeTarget ByteString
    ctxStr ByteString
    hashValue
                sigParams :: SignatureParams
    sigParams = PubKey -> Maybe HashAndSignatureAlgorithm -> SignatureParams
    signatureParams PubKey
    pub (HashAndSignatureAlgorithm -> Maybe HashAndSignatureAlgorithm
    forall a. a -> Maybe a
    Just HashAndSignatureAlgorithm
    hs)
            HashAndSignatureAlgorithm -> IO ()
    checkHashSignatureValid13 HashAndSignatureAlgorithm
    hs
            Context -> Maybe HashAndSignatureAlgorithm -> IO ()
    checkSupportedHashSignature Context
    ctx (HashAndSignatureAlgorithm -> Maybe HashAndSignatureAlgorithm
    forall a. a -> Maybe a
    Just HashAndSignatureAlgorithm
    hs)
            Context -> SignatureParams -> ByteString -> ByteString -> IO Bool
    verifyPublic Context
    ctx SignatureParams
    sigParams ByteString
    target ByteString
    signature
        | Bool
    otherwise = Bool -> m Bool
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False

    makeTarget :: ByteString -> ByteString -> ByteString
    makeTarget :: ByteString -> ByteString -> ByteString
    makeTarget ByteString
    contextString ByteString
    hashValue = Put -> ByteString
    runPut (Put -> ByteString) -> Put -> ByteString
    forall a b. (a -> b) -> a -> b
    $ do
        ByteString -> Put
    putBytes (ByteString -> Put) -> ByteString -> Put
    forall a b. (a -> b) -> a -> b
    $ Int -> CompressionID -> ByteString
    B.replicate Int
    64 CompressionID
    32
        ByteString -> Put
    putBytes ByteString
    contextString
        Putter CompressionID
    putWord8 CompressionID
    0
        ByteString -> Put
    putBytes ByteString
    hashValue

    sign :: MonadIO m => Context -> PubKey -> HashAndSignatureAlgorithm -> ByteString -> m Signature
    sign :: forall (m :: * -> *).
    MonadIO m =>
    Context
    -> PubKey
    -> HashAndSignatureAlgorithm
    -> ByteString
    -> m ByteString
    sign Context
    ctx PubKey
    pub HashAndSignatureAlgorithm
    hs ByteString
    target = IO ByteString -> m ByteString
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
    forall a b. (a -> b) -> a -> b
    $ do
        Role
    cc <- Context -> TLSSt Role -> IO Role
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx TLSSt Role
    isClientContext
        let sigParams :: SignatureParams
    sigParams = PubKey -> Maybe HashAndSignatureAlgorithm -> SignatureParams
    signatureParams PubKey
    pub (HashAndSignatureAlgorithm -> Maybe HashAndSignatureAlgorithm
    forall a. a -> Maybe a
    Just HashAndSignatureAlgorithm
    hs)
        Context -> Role -> SignatureParams -> ByteString -> IO ByteString
    signPrivate Context
    ctx Role
    cc SignatureParams
    sigParams ByteString
    target

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

    makePSKBinder :: Context -> BaseSecret EarlySecret -> Hash -> Int -> Maybe ByteString -> IO ByteString
    makePSKBinder :: Context
    -> BaseSecret EarlySecret
    -> Hash
    -> Int
    -> Maybe ByteString
    -> IO ByteString
    makePSKBinder Context
    ctx (BaseSecret ByteString
    sec) Hash
    usedHash Int
    truncLen Maybe ByteString
    mch = do
        [ByteString]
    rmsgs0 <- Context -> HandshakeM [ByteString] -> IO [ByteString]
    forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
    usingHState Context
    ctx HandshakeM [ByteString]
    getHandshakeMessagesRev -- fixme
        let rmsgs :: [ByteString]
    rmsgs = case Maybe ByteString
    mch of
              Just ByteString
    ch -> ByteString -> ByteString
    trunc ByteString
    ch ByteString -> [ByteString] -> [ByteString]
    forall a. a -> [a] -> [a]
    : [ByteString]
    rmsgs0
              Maybe ByteString
    Nothing -> ByteString -> ByteString
    trunc ([ByteString] -> ByteString
    forall a. HasCallStack => [a] -> a
    head [ByteString]
    rmsgs0) ByteString -> [ByteString] -> [ByteString]
    forall a. a -> [a] -> [a]
    : [ByteString] -> [ByteString]
    forall a. HasCallStack => [a] -> [a]
    tail [ByteString]
    rmsgs0
            hChTruncated :: ByteString
    hChTruncated = Hash -> ByteString -> ByteString
    hash Hash
    usedHash (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ [ByteString] -> ByteString
    B.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
    forall a b. (a -> b) -> a -> b
    $ [ByteString] -> [ByteString]
    forall a. [a] -> [a]
    reverse [ByteString]
    rmsgs
            binderKey :: ByteString
    binderKey = Hash -> ByteString -> ByteString -> ByteString -> ByteString
    deriveSecret Hash
    usedHash ByteString
    sec ByteString
    "res binder" (Hash -> ByteString -> ByteString
    hash Hash
    usedHash ByteString
    "")
        ByteString -> IO ByteString
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ Hash -> ByteString -> ByteString -> ByteString
    makeVerifyData Hash
    usedHash ByteString
    binderKey ByteString
    hChTruncated
      where
        trunc :: ByteString -> ByteString
    trunc ByteString
    x = Int -> ByteString -> ByteString
    B.take Int
    takeLen ByteString
    x
          where
            totalLen :: Int
    totalLen = ByteString -> Int
    B.length ByteString
    x
            takeLen :: Int
    takeLen = Int
    totalLen Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    truncLen

    replacePSKBinder :: ByteString -> ByteString -> ByteString
    replacePSKBinder :: ByteString -> ByteString -> ByteString
    replacePSKBinder ByteString
    pskz ByteString
    binder = ByteString
    identities ByteString -> ByteString -> ByteString
    `B.append` ByteString
    binders
      where
        bindersSize :: Int
    bindersSize = ByteString -> Int
    B.length ByteString
    binder Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    3
        identities :: ByteString
    identities  = Int -> ByteString -> ByteString
    B.take (ByteString -> Int
    B.length ByteString
    pskz Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    bindersSize) ByteString
    pskz
        binders :: ByteString
    binders     = Put -> ByteString
    runPut (Put -> ByteString) -> Put -> ByteString
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Put
    putOpaque16 (ByteString -> Put) -> ByteString -> Put
    forall a b. (a -> b) -> a -> b
    $ Put -> ByteString
    runPut (Put -> ByteString) -> Put -> ByteString
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Put
    putOpaque8 ByteString
    binder

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

    sendChangeCipherSpec13 :: Monoid b => Context -> PacketFlightM b ()
    sendChangeCipherSpec13 :: forall b. Monoid b => Context -> PacketFlightM b ()
    sendChangeCipherSpec13 Context
    ctx = do
        Bool
    sent <- Context -> HandshakeM Bool -> PacketFlightM b Bool
    forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
    usingHState Context
    ctx (HandshakeM Bool -> PacketFlightM b Bool)
    -> HandshakeM Bool -> PacketFlightM b Bool
    forall a b. (a -> b) -> a -> b
    $ do
                    Bool
    b <- HandshakeM Bool
    getCCS13Sent
                    Bool -> HandshakeM () -> HandshakeM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless Bool
    b (HandshakeM () -> HandshakeM ()) -> HandshakeM () -> HandshakeM ()
    forall a b. (a -> b) -> a -> b
    $ Bool -> HandshakeM ()
    setCCS13Sent Bool
    True
                    Bool -> HandshakeM Bool
    forall a. a -> HandshakeM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    b
        Bool -> PacketFlightM b () -> PacketFlightM b ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless Bool
    sent (PacketFlightM b () -> PacketFlightM b ())
    -> PacketFlightM b () -> PacketFlightM b ()
    forall a b. (a -> b) -> a -> b
    $ Context -> Packet13 -> PacketFlightM b ()
    forall b. Monoid b => Context -> Packet13 -> PacketFlightM b ()
    loadPacket13 Context
    ctx Packet13
    ChangeCipherSpec13

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

    -- | TLS13 handshake wrap up & clean up.  Contrary to @handshakeTerminate@, this
    -- does not handle session, which is managed separately for TLS 1.3.  This does
    -- not reset byte counters because renegotiation is not allowed.  And a few more
    -- state attributes are preserved, necessary for TLS13 handshake modes, session
    -- tickets and post-handshake authentication.
    handshakeTerminate13 :: Context -> IO ()
    handshakeTerminate13 :: Context -> IO ()
    handshakeTerminate13 Context
    ctx = do
        -- forget most handshake data
        IO () -> IO ()
    forall a. IO a -> IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ MVar (Maybe HandshakeState)
    -> (Maybe HandshakeState -> IO (Maybe HandshakeState)) -> IO ()
    forall a. MVar a -> (a -> IO a) -> IO ()
    modifyMVar_ (Context -> MVar (Maybe HandshakeState)
    ctxHandshake Context
    ctx) ((Maybe HandshakeState -> IO (Maybe HandshakeState)) -> IO ())
    -> (Maybe HandshakeState -> IO (Maybe HandshakeState)) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \ Maybe HandshakeState
    mhshake ->
            case Maybe HandshakeState
    mhshake of
                Maybe HandshakeState
    Nothing -> Maybe HandshakeState -> IO (Maybe HandshakeState)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe HandshakeState
    forall a. Maybe a
    Nothing
                Just HandshakeState
    hshake ->
                    Maybe HandshakeState -> IO (Maybe HandshakeState)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe HandshakeState -> IO (Maybe HandshakeState))
    -> Maybe HandshakeState -> IO (Maybe HandshakeState)
    forall a b. (a -> b) -> a -> b
    $ HandshakeState -> Maybe HandshakeState
    forall a. a -> Maybe a
    Just (Version -> ClientRandom -> HandshakeState
    newEmptyHandshake (HandshakeState -> Version
    hstClientVersion HandshakeState
    hshake) (HandshakeState -> ClientRandom
    hstClientRandom HandshakeState
    hshake))
                        { hstServerRandom = hstServerRandom hshake
                        , hstMasterSecret = hstMasterSecret hshake
                        , hstNegotiatedGroup = hstNegotiatedGroup hshake
                        , hstHandshakeDigest = hstHandshakeDigest hshake
                        , hstTLS13HandshakeMode = hstTLS13HandshakeMode hshake
                        , hstTLS13RTT0Status = hstTLS13RTT0Status hshake
                        , hstTLS13ResumptionSecret = hstTLS13ResumptionSecret hshake
                        }
        -- forget handshake data stored in TLS state
        Context -> TLSSt () -> IO ()
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx (TLSSt () -> IO ()) -> TLSSt () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
            Maybe KeyShare -> TLSSt ()
    setTLS13KeyShare Maybe KeyShare
    forall a. Maybe a
    Nothing
            Maybe PreSharedKey -> TLSSt ()
    setTLS13PreSharedKey Maybe PreSharedKey
    forall a. Maybe a
    Nothing
        -- mark the secure connection up and running.
        Context -> Established -> IO ()
    setEstablished Context
    ctx Established
    Established

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

    makeCertRequest :: ServerParams -> Context -> CertReqContext -> Handshake13
    makeCertRequest :: ServerParams -> Context -> ByteString -> Handshake13
    makeCertRequest ServerParams
    sparams Context
    ctx ByteString
    certReqCtx =
        let sigAlgs :: ByteString
    sigAlgs = SignatureAlgorithms -> ByteString
    forall a. Extension a => a -> ByteString
    extensionEncode (SignatureAlgorithms -> ByteString)
    -> SignatureAlgorithms -> ByteString
    forall a b. (a -> b) -> a -> b
    $ [HashAndSignatureAlgorithm] -> SignatureAlgorithms
    SignatureAlgorithms ([HashAndSignatureAlgorithm] -> SignatureAlgorithms)
    -> [HashAndSignatureAlgorithm] -> SignatureAlgorithms
    forall a b. (a -> b) -> a -> b
    $ Supported -> [HashAndSignatureAlgorithm]
    supportedHashSignatures (Supported -> [HashAndSignatureAlgorithm])
    -> Supported -> [HashAndSignatureAlgorithm]
    forall a b. (a -> b) -> a -> b
    $ Context -> Supported
    ctxSupported Context
    ctx
            caDns :: [DistinguishedName]
    caDns = (SignedCertificate -> DistinguishedName)
    -> [SignedCertificate] -> [DistinguishedName]
    forall a b. (a -> b) -> [a] -> [b]
    map SignedCertificate -> DistinguishedName
    extractCAname ([SignedCertificate] -> [DistinguishedName])
    -> [SignedCertificate] -> [DistinguishedName]
    forall a b. (a -> b) -> a -> b
    $ ServerParams -> [SignedCertificate]
    serverCACertificates ServerParams
    sparams
            caDnsEncoded :: ByteString
    caDnsEncoded = CertificateAuthorities -> ByteString
    forall a. Extension a => a -> ByteString
    extensionEncode (CertificateAuthorities -> ByteString)
    -> CertificateAuthorities -> ByteString
    forall a b. (a -> b) -> a -> b
    $ [DistinguishedName] -> CertificateAuthorities
    CertificateAuthorities [DistinguishedName]
    caDns
            caExtension :: [ExtensionRaw]
    caExtension
                | [DistinguishedName] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [DistinguishedName]
    caDns = []
                | Bool
    otherwise  = [ExtensionID -> ByteString -> ExtensionRaw
    ExtensionRaw ExtensionID
    extensionID_CertificateAuthorities ByteString
    caDnsEncoded]
            crexts :: [ExtensionRaw]
    crexts = ExtensionID -> ByteString -> ExtensionRaw
    ExtensionRaw ExtensionID
    extensionID_SignatureAlgorithms ByteString
    sigAlgs ExtensionRaw -> [ExtensionRaw] -> [ExtensionRaw]
    forall a. a -> [a] -> [a]
    : [ExtensionRaw]
    caExtension
         in ByteString -> [ExtensionRaw] -> Handshake13
    CertRequest13 ByteString
    certReqCtx [ExtensionRaw]
    crexts

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

    createTLS13TicketInfo :: Second -> Either Context Second -> Maybe Millisecond -> IO TLS13TicketInfo
    createTLS13TicketInfo :: Second
    -> Either Context Second -> Maybe Millisecond -> IO TLS13TicketInfo
    createTLS13TicketInfo Second
    life Either Context Second
    ecw Maybe Millisecond
    mrtt = do
        -- Left:  serverSendTime
        -- Right: clientReceiveTime
        Millisecond
    bTime <- IO Millisecond
    getCurrentTimeFromBase
        Second
    add <- case Either Context Second
    ecw of
            Left Context
    ctx -> (Second -> CompressionID -> Second)
    -> Second -> ByteString -> Second
    forall a. (a -> CompressionID -> a) -> a -> ByteString -> a
    B.foldl' Second -> CompressionID -> Second
    forall {a} {a}. (Integral a, Num a) => a -> a -> a
    (*+) Second
    0 (ByteString -> Second) -> IO ByteString -> IO Second
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Context -> Int -> IO ByteString
    getStateRNG Context
    ctx Int
    4
            Right Second
    ad -> Second -> IO Second
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Second
    ad
        TLS13TicketInfo -> IO TLS13TicketInfo
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TLS13TicketInfo -> IO TLS13TicketInfo)
    -> TLS13TicketInfo -> IO TLS13TicketInfo
    forall a b. (a -> b) -> a -> b
    $ Second
    -> Second -> Millisecond -> Maybe Millisecond -> TLS13TicketInfo
    TLS13TicketInfo Second
    life Second
    add Millisecond
    bTime Maybe Millisecond
    mrtt
      where
        a
    x *+ :: a -> a -> a
    *+ a
    y = a
    x a -> a -> a
    forall a. Num a => a -> a -> a
    * a
    256 a -> a -> a
    forall a. Num a => a -> a -> a
    + a -> a
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    y

    ageToObfuscatedAge :: Second -> TLS13TicketInfo -> Second
    ageToObfuscatedAge :: Second -> TLS13TicketInfo -> Second
    ageToObfuscatedAge Second
    age TLS13TicketInfo
    tinfo = Second
    obfage
      where
        !obfage :: Second
    obfage = Second
    age Second -> Second -> Second
    forall a. Num a => a -> a -> a
    + TLS13TicketInfo -> Second
    ageAdd TLS13TicketInfo
    tinfo

    obfuscatedAgeToAge :: Second -> TLS13TicketInfo -> Second
    obfuscatedAgeToAge :: Second -> TLS13TicketInfo -> Second
    obfuscatedAgeToAge Second
    obfage TLS13TicketInfo
    tinfo = Second
    age
      where
        !age :: Second
    age = Second
    obfage Second -> Second -> Second
    forall a. Num a => a -> a -> a
    - TLS13TicketInfo -> Second
    ageAdd TLS13TicketInfo
    tinfo

    isAgeValid :: Second -> TLS13TicketInfo -> Bool
    isAgeValid :: Second -> TLS13TicketInfo -> Bool
    isAgeValid Second
    age TLS13TicketInfo
    tinfo = Second
    age Second -> Second -> Bool
    forall a. Ord a => a -> a -> Bool
    <= TLS13TicketInfo -> Second
    lifetime TLS13TicketInfo
    tinfo Second -> Second -> Second
    forall a. Num a => a -> a -> a
    * Second
    1000

    getAge :: TLS13TicketInfo -> IO Second
    getAge :: TLS13TicketInfo -> IO Second
    getAge TLS13TicketInfo
    tinfo = do
        let clientReceiveTime :: Millisecond
    clientReceiveTime = TLS13TicketInfo -> Millisecond
    txrxTime TLS13TicketInfo
    tinfo
        Millisecond
    clientSendTime <- IO Millisecond
    getCurrentTimeFromBase
        Second -> IO Second
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Second -> IO Second) -> Second -> IO Second
    forall a b. (a -> b) -> a -> b
    $! Millisecond -> Second
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Millisecond
    clientSendTime Millisecond -> Millisecond -> Millisecond
    forall a. Num a => a -> a -> a
    - Millisecond
    clientReceiveTime) -- milliseconds

    checkFreshness :: TLS13TicketInfo -> Second -> IO Bool
    checkFreshness :: TLS13TicketInfo -> Second -> IO Bool
    checkFreshness TLS13TicketInfo
    tinfo Second
    obfAge = do
        Millisecond
    serverReceiveTime <- IO Millisecond
    getCurrentTimeFromBase
        let freshness :: Millisecond
    freshness = if Millisecond
    expectedArrivalTime Millisecond -> Millisecond -> Bool
    forall a. Ord a => a -> a -> Bool
    > Millisecond
    serverReceiveTime
                        then Millisecond
    expectedArrivalTime Millisecond -> Millisecond -> Millisecond
    forall a. Num a => a -> a -> a
    - Millisecond
    serverReceiveTime
                        else Millisecond
    serverReceiveTime Millisecond -> Millisecond -> Millisecond
    forall a. Num a => a -> a -> a
    - Millisecond
    expectedArrivalTime
        -- Some implementations round age up to second.
        -- We take max of 2000 and rtt in the case where rtt is too small.
        let tolerance :: Millisecond
    tolerance = Millisecond -> Millisecond -> Millisecond
    forall a. Ord a => a -> a -> a
    max Millisecond
    2000 Millisecond
    rtt
            isFresh :: Bool
    isFresh = Millisecond
    freshness Millisecond -> Millisecond -> Bool
    forall a. Ord a => a -> a -> Bool
    < Millisecond
    tolerance
        Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> IO Bool) -> Bool -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ Bool
    isAlive Bool -> Bool -> Bool
    && Bool
    isFresh
      where
        serverSendTime :: Millisecond
    serverSendTime = TLS13TicketInfo -> Millisecond
    txrxTime TLS13TicketInfo
    tinfo
        Just Millisecond
    rtt = TLS13TicketInfo -> Maybe Millisecond
    estimatedRTT TLS13TicketInfo
    tinfo
        age :: Second
    age = Second -> TLS13TicketInfo -> Second
    obfuscatedAgeToAge Second
    obfAge TLS13TicketInfo
    tinfo
        expectedArrivalTime :: Millisecond
    expectedArrivalTime = Millisecond
    serverSendTime Millisecond -> Millisecond -> Millisecond
    forall a. Num a => a -> a -> a
    + Millisecond
    rtt Millisecond -> Millisecond -> Millisecond
    forall a. Num a => a -> a -> a
    + Second -> Millisecond
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Second
    age
        isAlive :: Bool
    isAlive = Second -> TLS13TicketInfo -> Bool
    isAgeValid Second
    age TLS13TicketInfo
    tinfo

    getCurrentTimeFromBase :: IO Millisecond
    getCurrentTimeFromBase :: IO Millisecond
    getCurrentTimeFromBase = UnixTime -> Millisecond
    millisecondsFromBase (UnixTime -> Millisecond) -> IO UnixTime -> IO Millisecond
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO UnixTime
    getUnixTime

    millisecondsFromBase :: UnixTime -> Millisecond
    millisecondsFromBase :: UnixTime -> Millisecond
    millisecondsFromBase (UnixTime (CTime Int64
    s) Int32
    us) =
        Int64 -> Millisecond
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral ((Int64
    s Int64 -> Int64 -> Int64
    forall a. Num a => a -> a -> a
    - Int64
    base) Int64 -> Int64 -> Int64
    forall a. Num a => a -> a -> a
    * Int64
    1000) Millisecond -> Millisecond -> Millisecond
    forall a. Num a => a -> a -> a
    + Int32 -> Millisecond
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int32
    us Int32 -> Int32 -> Int32
    forall a. Integral a => a -> a -> a
    `div` Int32
    1000)
      where
        base :: Int64
    base = Int64
    1483228800
        -- UnixTime (CTime base) _= parseUnixTimeGMT webDateFormat "Sun, 01 Jan 2017 00:00:00 GMT"

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

    getSessionData13 :: Context -> Cipher -> TLS13TicketInfo -> Int -> ByteString -> IO SessionData
    getSessionData13 :: Context
    -> Cipher -> TLS13TicketInfo -> Int -> ByteString -> IO SessionData
    getSessionData13 Context
    ctx Cipher
    usedCipher TLS13TicketInfo
    tinfo Int
    maxSize ByteString
    psk = do
        Version
    ver   <- Context -> TLSSt Version -> IO Version
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx TLSSt Version
    getVersion
        Maybe ByteString
    malpn <- Context -> TLSSt (Maybe ByteString) -> IO (Maybe ByteString)
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx TLSSt (Maybe ByteString)
    getNegotiatedProtocol
        Maybe String
    sni   <- Context -> TLSSt (Maybe String) -> IO (Maybe String)
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx TLSSt (Maybe String)
    getClientSNI
        Maybe Group
    mgrp  <- Context -> HandshakeM (Maybe Group) -> IO (Maybe Group)
    forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
    usingHState Context
    ctx HandshakeM (Maybe Group)
    getNegotiatedGroup
        SessionData -> IO SessionData
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return SessionData {
            sessionVersion :: Version
    sessionVersion     = Version
    ver
          , sessionCipher :: ExtensionID
    sessionCipher      = Cipher -> ExtensionID
    cipherID Cipher
    usedCipher
          , sessionCompression :: CompressionID
    sessionCompression = CompressionID
    0
          , sessionClientSNI :: Maybe String
    sessionClientSNI   = Maybe String
    sni
          , sessionSecret :: ByteString
    sessionSecret      = ByteString
    psk
          , sessionGroup :: Maybe Group
    sessionGroup       = Maybe Group
    mgrp
          , sessionTicketInfo :: Maybe TLS13TicketInfo
    sessionTicketInfo  = TLS13TicketInfo -> Maybe TLS13TicketInfo
    forall a. a -> Maybe a
    Just TLS13TicketInfo
    tinfo
          , sessionALPN :: Maybe ByteString
    sessionALPN        = Maybe ByteString
    malpn
          , sessionMaxEarlyDataSize :: Int
    sessionMaxEarlyDataSize = Int
    maxSize
          , sessionFlags :: [SessionFlag]
    sessionFlags       = []
          }

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

    ensureNullCompression :: MonadIO m => CompressionID -> m ()
    ensureNullCompression :: forall (m :: * -> *). MonadIO m => CompressionID -> m ()
    ensureNullCompression CompressionID
    compression =
        Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (CompressionID
    compression CompressionID -> CompressionID -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Compression -> CompressionID
    compressionID Compression
    nullCompression) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $
            TLSError -> m ()
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> m ()) -> TLSError -> m ()
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol (String
    "compression is not allowed in TLS 1.3", Bool
    True, AlertDescription
    IllegalParameter)

    -- Word32 is used in TLS 1.3 protocol.
    -- Int is used for API for Haskell TLS because it is natural.
    -- If Int is 64 bits, users can specify bigger number than Word32.
    -- If Int is 32 bits, 2^31 or larger may be converted into minus numbers.
    safeNonNegative32 :: (Num a, Ord a, FiniteBits a) => a -> a
    safeNonNegative32 :: forall a. (Num a, Ord a, FiniteBits a) => a -> a
    safeNonNegative32 a
    x
      | a
    x a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    <= a
    0                = a
    0
      | a -> Int
    forall b. FiniteBits b => b -> Int
    finiteBitSize a
    x Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    32 = a
    x
      | Bool
    otherwise             = a
    x a -> a -> a
    forall a. Ord a => a -> a -> a
    `min` Second -> a
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Second
    forall a. Bounded a => a
    maxBound :: Word32)
    ----------------------------------------------------------------

    newtype RecvHandshake13M m a = RecvHandshake13M (StateT [Handshake13] m a)
        deriving ((forall a b.
     (a -> b) -> RecvHandshake13M m a -> RecvHandshake13M m b)
    -> (forall a b. a -> RecvHandshake13M m b -> RecvHandshake13M m a)
    -> Functor (RecvHandshake13M m)
    forall a b. a -> RecvHandshake13M m b -> RecvHandshake13M m a
    forall a b.
    (a -> b) -> RecvHandshake13M m a -> RecvHandshake13M m b
    forall (m :: * -> *) a b.
    Functor m =>
    a -> RecvHandshake13M m b -> RecvHandshake13M m a
    forall (m :: * -> *) a b.
    Functor m =>
    (a -> b) -> RecvHandshake13M m a -> RecvHandshake13M m b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall (m :: * -> *) a b.
    Functor m =>
    (a -> b) -> RecvHandshake13M m a -> RecvHandshake13M m b
    fmap :: forall a b.
    (a -> b) -> RecvHandshake13M m a -> RecvHandshake13M m b
    $c<$ :: forall (m :: * -> *) a b.
    Functor m =>
    a -> RecvHandshake13M m b -> RecvHandshake13M m a
    <$ :: forall a b. a -> RecvHandshake13M m b -> RecvHandshake13M m a
    Functor, Functor (RecvHandshake13M m)
    Functor (RecvHandshake13M m) =>
    (forall a. a -> RecvHandshake13M m a)
    -> (forall a b.
        RecvHandshake13M m (a -> b)
        -> RecvHandshake13M m a -> RecvHandshake13M m b)
    -> (forall a b c.
        (a -> b -> c)
        -> RecvHandshake13M m a
        -> RecvHandshake13M m b
        -> RecvHandshake13M m c)
    -> (forall a b.
        RecvHandshake13M m a
        -> RecvHandshake13M m b -> RecvHandshake13M m b)
    -> (forall a b.
        RecvHandshake13M m a
        -> RecvHandshake13M m b -> RecvHandshake13M m a)
    -> Applicative (RecvHandshake13M m)
    forall a. a -> RecvHandshake13M m a
    forall a b.
    RecvHandshake13M m a
    -> RecvHandshake13M m b -> RecvHandshake13M m a
    forall a b.
    RecvHandshake13M m a
    -> RecvHandshake13M m b -> RecvHandshake13M m b
    forall a b.
    RecvHandshake13M m (a -> b)
    -> RecvHandshake13M m a -> RecvHandshake13M m b
    forall a b c.
    (a -> b -> c)
    -> RecvHandshake13M m a
    -> RecvHandshake13M m b
    -> RecvHandshake13M m c
    forall (m :: * -> *). Monad m => Functor (RecvHandshake13M m)
    forall (m :: * -> *) a. Monad m => a -> RecvHandshake13M m a
    forall (m :: * -> *) a b.
    Monad m =>
    RecvHandshake13M m a
    -> RecvHandshake13M m b -> RecvHandshake13M m a
    forall (m :: * -> *) a b.
    Monad m =>
    RecvHandshake13M m a
    -> RecvHandshake13M m b -> RecvHandshake13M m b
    forall (m :: * -> *) a b.
    Monad m =>
    RecvHandshake13M m (a -> b)
    -> RecvHandshake13M m a -> RecvHandshake13M m b
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> b -> c)
    -> RecvHandshake13M m a
    -> RecvHandshake13M m b
    -> RecvHandshake13M m c
    forall (f :: * -> *).
    Functor f =>
    (forall a. a -> f a)
    -> (forall a b. f (a -> b) -> f a -> f b)
    -> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
    -> (forall a b. f a -> f b -> f b)
    -> (forall a b. f a -> f b -> f a)
    -> Applicative f
    $cpure :: forall (m :: * -> *) a. Monad m => a -> RecvHandshake13M m a
    pure :: forall a. a -> RecvHandshake13M m a
    $c<*> :: forall (m :: * -> *) a b.
    Monad m =>
    RecvHandshake13M m (a -> b)
    -> RecvHandshake13M m a -> RecvHandshake13M m b
    <*> :: forall a b.
    RecvHandshake13M m (a -> b)
    -> RecvHandshake13M m a -> RecvHandshake13M m b
    $cliftA2 :: forall (m :: * -> *) a b c.
    Monad m =>
    (a -> b -> c)
    -> RecvHandshake13M m a
    -> RecvHandshake13M m b
    -> RecvHandshake13M m c
    liftA2 :: forall a b c.
    (a -> b -> c)
    -> RecvHandshake13M m a
    -> RecvHandshake13M m b
    -> RecvHandshake13M m c
    $c*> :: forall (m :: * -> *) a b.
    Monad m =>
    RecvHandshake13M m a
    -> RecvHandshake13M m b -> RecvHandshake13M m b
    *> :: forall a b.
    RecvHandshake13M m a
    -> RecvHandshake13M m b -> RecvHandshake13M m b
    $c<* :: forall (m :: * -> *) a b.
    Monad m =>
    RecvHandshake13M m a
    -> RecvHandshake13M m b -> RecvHandshake13M m a
    <* :: forall a b.
    RecvHandshake13M m a
    -> RecvHandshake13M m b -> RecvHandshake13M m a
    Applicative, Applicative (RecvHandshake13M m)
    Applicative (RecvHandshake13M m) =>
    (forall a b.
     RecvHandshake13M m a
     -> (a -> RecvHandshake13M m b) -> RecvHandshake13M m b)
    -> (forall a b.
        RecvHandshake13M m a
        -> RecvHandshake13M m b -> RecvHandshake13M m b)
    -> (forall a. a -> RecvHandshake13M m a)
    -> Monad (RecvHandshake13M m)
    forall a. a -> RecvHandshake13M m a
    forall a b.
    RecvHandshake13M m a
    -> RecvHandshake13M m b -> RecvHandshake13M m b
    forall a b.
    RecvHandshake13M m a
    -> (a -> RecvHandshake13M m b) -> RecvHandshake13M m b
    forall (m :: * -> *). Monad m => Applicative (RecvHandshake13M m)
    forall (m :: * -> *) a. Monad m => a -> RecvHandshake13M m a
    forall (m :: * -> *) a b.
    Monad m =>
    RecvHandshake13M m a
    -> RecvHandshake13M m b -> RecvHandshake13M m b
    forall (m :: * -> *) a b.
    Monad m =>
    RecvHandshake13M m a
    -> (a -> RecvHandshake13M m b) -> RecvHandshake13M m b
    forall (m :: * -> *).
    Applicative m =>
    (forall a b. m a -> (a -> m b) -> m b)
    -> (forall a b. m a -> m b -> m b)
    -> (forall a. a -> m a)
    -> Monad m
    $c>>= :: forall (m :: * -> *) a b.
    Monad m =>
    RecvHandshake13M m a
    -> (a -> RecvHandshake13M m b) -> RecvHandshake13M m b
    >>= :: forall a b.
    RecvHandshake13M m a
    -> (a -> RecvHandshake13M m b) -> RecvHandshake13M m b
    $c>> :: forall (m :: * -> *) a b.
    Monad m =>
    RecvHandshake13M m a
    -> RecvHandshake13M m b -> RecvHandshake13M m b
    >> :: forall a b.
    RecvHandshake13M m a
    -> RecvHandshake13M m b -> RecvHandshake13M m b
    $creturn :: forall (m :: * -> *) a. Monad m => a -> RecvHandshake13M m a
    return :: forall a. a -> RecvHandshake13M m a
    Monad, Monad (RecvHandshake13M m)
    Monad (RecvHandshake13M m) =>
    (forall a. IO a -> RecvHandshake13M m a)
    -> MonadIO (RecvHandshake13M m)
    forall a. IO a -> RecvHandshake13M m a
    forall (m :: * -> *).
    Monad m =>
    (forall a. IO a -> m a) -> MonadIO m
    forall (m :: * -> *). MonadIO m => Monad (RecvHandshake13M m)
    forall (m :: * -> *) a. MonadIO m => IO a -> RecvHandshake13M m a
    $cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> RecvHandshake13M m a
    liftIO :: forall a. IO a -> RecvHandshake13M m a
    MonadIO)

    recvHandshake13 :: MonadIO m
                    => Context
                    -> (Handshake13 -> RecvHandshake13M m a)
                    -> RecvHandshake13M m a
    recvHandshake13 :: forall (m :: * -> *) a.
    MonadIO m =>
    Context
    -> (Handshake13 -> RecvHandshake13M m a) -> RecvHandshake13M m a
    recvHandshake13 Context
    ctx Handshake13 -> RecvHandshake13M m a
    f = Context -> RecvHandshake13M m Handshake13
    forall (m :: * -> *).
    MonadIO m =>
    Context -> RecvHandshake13M m Handshake13
    getHandshake13 Context
    ctx RecvHandshake13M m Handshake13
    -> (Handshake13 -> RecvHandshake13M m a) -> RecvHandshake13M m a
    forall a b.
    RecvHandshake13M m a
    -> (a -> RecvHandshake13M m b) -> RecvHandshake13M m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Handshake13 -> RecvHandshake13M m a
    f

    recvHandshake13hash :: MonadIO m
                        => Context
                        -> (ByteString -> Handshake13 -> RecvHandshake13M m a)
                        -> RecvHandshake13M m a
    recvHandshake13hash :: forall (m :: * -> *) a.
    MonadIO m =>
    Context
    -> (ByteString -> Handshake13 -> RecvHandshake13M m a)
    -> RecvHandshake13M m a
    recvHandshake13hash Context
    ctx ByteString -> Handshake13 -> RecvHandshake13M m a
    f = do
        ByteString
    d <- Context -> RecvHandshake13M m ByteString
    forall (m :: * -> *). MonadIO m => Context -> m ByteString
    transcriptHash Context
    ctx
        Context -> RecvHandshake13M m Handshake13
    forall (m :: * -> *).
    MonadIO m =>
    Context -> RecvHandshake13M m Handshake13
    getHandshake13 Context
    ctx RecvHandshake13M m Handshake13
    -> (Handshake13 -> RecvHandshake13M m a) -> RecvHandshake13M m a
    forall a b.
    RecvHandshake13M m a
    -> (a -> RecvHandshake13M m b) -> RecvHandshake13M m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= ByteString -> Handshake13 -> RecvHandshake13M m a
    f ByteString
    d

    getHandshake13 :: MonadIO m => Context -> RecvHandshake13M m Handshake13
    getHandshake13 :: forall (m :: * -> *).
    MonadIO m =>
    Context -> RecvHandshake13M m Handshake13
    getHandshake13 Context
    ctx = StateT [Handshake13] m Handshake13
    -> RecvHandshake13M m Handshake13
    forall (m :: * -> *) a.
    StateT [Handshake13] m a -> RecvHandshake13M m a
    RecvHandshake13M (StateT [Handshake13] m Handshake13
     -> RecvHandshake13M m Handshake13)
    -> StateT [Handshake13] m Handshake13
    -> RecvHandshake13M m Handshake13
    forall a b. (a -> b) -> a -> b
    $ do
        [Handshake13]
    currentState <- StateT [Handshake13] m [Handshake13]
    forall s (m :: * -> *). MonadState s m => m s
    get
        case [Handshake13]
    currentState of
            (Handshake13
    h:[Handshake13]
    hs) -> Handshake13 -> [Handshake13] -> StateT [Handshake13] m Handshake13
    forall {m :: * -> *} {s}.
    (MonadIO m, MonadState s m) =>
    Handshake13 -> s -> m Handshake13
    found Handshake13
    h [Handshake13]
    hs
            []     -> StateT [Handshake13] m Handshake13
    recvLoop
      where
        found :: Handshake13 -> s -> m Handshake13
    found Handshake13
    h s
    hs = IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (Context -> Handshake13 -> IO ()
    processHandshake13 Context
    ctx Handshake13
    h) m () -> m () -> m ()
    forall a b. m a -> m b -> m b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> s -> m ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put s
    hs m () -> m Handshake13 -> m Handshake13
    forall a b. m a -> m b -> m b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Handshake13 -> m Handshake13
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Handshake13
    h
        recvLoop :: StateT [Handshake13] m Handshake13
    recvLoop = do
            Either TLSError Packet13
    epkt <- IO (Either TLSError Packet13)
    -> StateT [Handshake13] m (Either TLSError Packet13)
    forall a. IO a -> StateT [Handshake13] m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (Context -> IO (Either TLSError Packet13)
    recvPacket13 Context
    ctx)
            case Either TLSError Packet13
    epkt of
                Right (Handshake13 [])     -> String -> StateT [Handshake13] m Handshake13
    forall a. HasCallStack => String -> a
    error String
    "invalid recvPacket13 result"
                Right (Handshake13 (Handshake13
    h:[Handshake13]
    hs)) -> Handshake13 -> [Handshake13] -> StateT [Handshake13] m Handshake13
    forall {m :: * -> *} {s}.
    (MonadIO m, MonadState s m) =>
    Handshake13 -> s -> m Handshake13
    found Handshake13
    h [Handshake13]
    hs
                Right Packet13
    ChangeCipherSpec13   -> StateT [Handshake13] m Handshake13
    recvLoop
                Right Packet13
    x                    -> String -> Maybe String -> StateT [Handshake13] m Handshake13
    forall (m :: * -> *) a. MonadIO m => String -> Maybe String -> m a
    unexpected (Packet13 -> String
    forall a. Show a => a -> String
    show Packet13
    x) (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    "handshake 13")
                Left TLSError
    err                   -> TLSError -> StateT [Handshake13] m Handshake13
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore TLSError
    err

    runRecvHandshake13 :: MonadIO m => RecvHandshake13M m a -> m a
    runRecvHandshake13 :: forall (m :: * -> *) a. MonadIO m => RecvHandshake13M m a -> m a
    runRecvHandshake13 (RecvHandshake13M StateT [Handshake13] m a
    f) = do
        (a
    result, [Handshake13]
    new) <- StateT [Handshake13] m a -> [Handshake13] -> m (a, [Handshake13])
    forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
    runStateT StateT [Handshake13] m a
    f []
        Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([Handshake13] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Handshake13]
    new) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ String -> Maybe String -> m ()
    forall (m :: * -> *) a. MonadIO m => String -> Maybe String -> m a
    unexpected String
    "spurious handshake 13" Maybe String
    forall a. Maybe a
    Nothing
        a -> m a
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    result

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

    -- some hash/signature combinations have been deprecated in TLS13 and should
    -- not be used
    checkHashSignatureValid13 :: HashAndSignatureAlgorithm -> IO ()
    checkHashSignatureValid13 :: HashAndSignatureAlgorithm -> IO ()
    checkHashSignatureValid13 HashAndSignatureAlgorithm
    hs =
        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (HashAndSignatureAlgorithm -> Bool
    isHashSignatureValid13 HashAndSignatureAlgorithm
    hs) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            let msg :: String
    msg = String
    "invalid TLS13 hash and signature algorithm: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ HashAndSignatureAlgorithm -> String
    forall a. Show a => a -> String
    show HashAndSignatureAlgorithm
    hs
             in TLSError -> IO ()
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO ()) -> TLSError -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol (String
    msg, Bool
    True, AlertDescription
    IllegalParameter)

    isHashSignatureValid13 :: HashAndSignatureAlgorithm -> Bool
    isHashSignatureValid13 :: HashAndSignatureAlgorithm -> Bool
    isHashSignatureValid13 (HashAlgorithm
    HashIntrinsic, SignatureAlgorithm
    s) =
        SignatureAlgorithm
    s SignatureAlgorithm -> [SignatureAlgorithm] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [ SignatureAlgorithm
    SignatureRSApssRSAeSHA256
                 , SignatureAlgorithm
    SignatureRSApssRSAeSHA384
                 , SignatureAlgorithm
    SignatureRSApssRSAeSHA512
                 , SignatureAlgorithm
    SignatureEd25519
                 , SignatureAlgorithm
    SignatureEd448
                 , SignatureAlgorithm
    SignatureRSApsspssSHA256
                 , SignatureAlgorithm
    SignatureRSApsspssSHA384
                 , SignatureAlgorithm
    SignatureRSApsspssSHA512
                 ]
    isHashSignatureValid13 (HashAlgorithm
    h, SignatureAlgorithm
    SignatureECDSA) =
        HashAlgorithm
    h HashAlgorithm -> [HashAlgorithm] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [ HashAlgorithm
    HashSHA256, HashAlgorithm
    HashSHA384, HashAlgorithm
    HashSHA512 ]
    isHashSignatureValid13 HashAndSignatureAlgorithm
    _ = Bool
    False

    data CipherChoice = CipherChoice {
        CipherChoice -> Version
    cVersion :: Version
      , CipherChoice -> Cipher
    cCipher  :: Cipher
      , CipherChoice -> Hash
    cHash    :: Hash
      , CipherChoice -> ByteString
    cZero    :: !ByteString
      }

    makeCipherChoice :: Version -> Cipher -> CipherChoice
    makeCipherChoice :: Version -> Cipher -> CipherChoice
    makeCipherChoice Version
    ver Cipher
    cipher = Version -> Cipher -> Hash -> ByteString -> CipherChoice
    CipherChoice Version
    ver Cipher
    cipher Hash
    h ByteString
    zero
      where
        h :: Hash
    h = Cipher -> Hash
    cipherHash Cipher
    cipher
        zero :: ByteString
    zero = Int -> CompressionID -> ByteString
    B.replicate (Hash -> Int
    hashDigestSize Hash
    h) CompressionID
    0

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

    calculateEarlySecret :: Context -> CipherChoice
                         -> Either ByteString (BaseSecret EarlySecret)
                         -> Bool -> IO (SecretPair EarlySecret)
    calculateEarlySecret :: Context
    -> CipherChoice
    -> Either ByteString (BaseSecret EarlySecret)
    -> Bool
    -> IO (SecretPair EarlySecret)
    calculateEarlySecret Context
    ctx CipherChoice
    choice Either ByteString (BaseSecret EarlySecret)
    maux Bool
    initialized = do
        ByteString
    hCh <- if Bool
    initialized then
                   Context -> IO ByteString
    forall (m :: * -> *). MonadIO m => Context -> m ByteString
    transcriptHash Context
    ctx
                 else do
                   [ByteString]
    hmsgs <- Context -> HandshakeM [ByteString] -> IO [ByteString]
    forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
    usingHState Context
    ctx HandshakeM [ByteString]
    getHandshakeMessages
                   ByteString -> IO ByteString
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ Hash -> ByteString -> ByteString
    hash Hash
    usedHash (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ [ByteString] -> ByteString
    B.concat [ByteString]
    hmsgs
        let earlySecret :: ByteString
    earlySecret = case Either ByteString (BaseSecret EarlySecret)
    maux of
              Right (BaseSecret ByteString
    sec) -> ByteString
    sec
              Left  ByteString
    psk              -> Hash -> ByteString -> ByteString -> ByteString
    hkdfExtract Hash
    usedHash ByteString
    zero ByteString
    psk
            clientEarlySecret :: ByteString
    clientEarlySecret = Hash -> ByteString -> ByteString -> ByteString -> ByteString
    deriveSecret Hash
    usedHash ByteString
    earlySecret ByteString
    "c e traffic" ByteString
    hCh
            cets :: ClientTrafficSecret EarlySecret
    cets = ByteString -> ClientTrafficSecret EarlySecret
    forall a. ByteString -> ClientTrafficSecret a
    ClientTrafficSecret ByteString
    clientEarlySecret :: ClientTrafficSecret EarlySecret
        Context -> ClientTrafficSecret EarlySecret -> IO ()
    forall a. LogLabel a => Context -> a -> IO ()
    logKey Context
    ctx ClientTrafficSecret EarlySecret
    cets
        SecretPair EarlySecret -> IO (SecretPair EarlySecret)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SecretPair EarlySecret -> IO (SecretPair EarlySecret))
    -> SecretPair EarlySecret -> IO (SecretPair EarlySecret)
    forall a b. (a -> b) -> a -> b
    $ BaseSecret EarlySecret
    -> ClientTrafficSecret EarlySecret -> SecretPair EarlySecret
    forall a. BaseSecret a -> ClientTrafficSecret a -> SecretPair a
    SecretPair (ByteString -> BaseSecret EarlySecret
    forall a. ByteString -> BaseSecret a
    BaseSecret ByteString
    earlySecret) ClientTrafficSecret EarlySecret
    cets
      where
        usedHash :: Hash
    usedHash = CipherChoice -> Hash
    cHash CipherChoice
    choice
        zero :: ByteString
    zero = CipherChoice -> ByteString
    cZero CipherChoice
    choice

    initEarlySecret :: CipherChoice -> Maybe ByteString -> BaseSecret EarlySecret
    initEarlySecret :: CipherChoice -> Maybe ByteString -> BaseSecret EarlySecret
    initEarlySecret CipherChoice
    choice Maybe ByteString
    mpsk = ByteString -> BaseSecret EarlySecret
    forall a. ByteString -> BaseSecret a
    BaseSecret ByteString
    sec
      where
        sec :: ByteString
    sec = Hash -> ByteString -> ByteString -> ByteString
    hkdfExtract Hash
    usedHash ByteString
    zero ByteString
    zeroOrPSK
        usedHash :: Hash
    usedHash = CipherChoice -> Hash
    cHash CipherChoice
    choice
        zero :: ByteString
    zero = CipherChoice -> ByteString
    cZero CipherChoice
    choice
        zeroOrPSK :: ByteString
    zeroOrPSK = case Maybe ByteString
    mpsk of
          Just ByteString
    psk -> ByteString
    psk
          Maybe ByteString
    Nothing  -> ByteString
    zero

    calculateHandshakeSecret :: Context -> CipherChoice -> BaseSecret EarlySecret -> ByteString
                             -> IO (SecretTriple HandshakeSecret)
    calculateHandshakeSecret :: Context
    -> CipherChoice
    -> BaseSecret EarlySecret
    -> ByteString
    -> IO (SecretTriple HandshakeSecret)
    calculateHandshakeSecret Context
    ctx CipherChoice
    choice (BaseSecret ByteString
    sec) ByteString
    ecdhe = do
            ByteString
    hChSh <- Context -> IO ByteString
    forall (m :: * -> *). MonadIO m => Context -> m ByteString
    transcriptHash Context
    ctx
            let handshakeSecret :: ByteString
    handshakeSecret = Hash -> ByteString -> ByteString -> ByteString
    hkdfExtract Hash
    usedHash (Hash -> ByteString -> ByteString -> ByteString -> ByteString
    deriveSecret Hash
    usedHash ByteString
    sec ByteString
    "derived" (Hash -> ByteString -> ByteString
    hash Hash
    usedHash ByteString
    "")) ByteString
    ecdhe
            let clientHandshakeSecret :: ByteString
    clientHandshakeSecret = Hash -> ByteString -> ByteString -> ByteString -> ByteString
    deriveSecret Hash
    usedHash ByteString
    handshakeSecret ByteString
    "c hs traffic" ByteString
    hChSh
                serverHandshakeSecret :: ByteString
    serverHandshakeSecret = Hash -> ByteString -> ByteString -> ByteString -> ByteString
    deriveSecret Hash
    usedHash ByteString
    handshakeSecret ByteString
    "s hs traffic" ByteString
    hChSh
            let shts :: ServerTrafficSecret HandshakeSecret
    shts = ByteString -> ServerTrafficSecret HandshakeSecret
    forall a. ByteString -> ServerTrafficSecret a
    ServerTrafficSecret ByteString
    serverHandshakeSecret :: ServerTrafficSecret HandshakeSecret
                chts :: ClientTrafficSecret HandshakeSecret
    chts = ByteString -> ClientTrafficSecret HandshakeSecret
    forall a. ByteString -> ClientTrafficSecret a
    ClientTrafficSecret ByteString
    clientHandshakeSecret :: ClientTrafficSecret HandshakeSecret
            Context -> ServerTrafficSecret HandshakeSecret -> IO ()
    forall a. LogLabel a => Context -> a -> IO ()
    logKey Context
    ctx ServerTrafficSecret HandshakeSecret
    shts
            Context -> ClientTrafficSecret HandshakeSecret -> IO ()
    forall a. LogLabel a => Context -> a -> IO ()
    logKey Context
    ctx ClientTrafficSecret HandshakeSecret
    chts
            SecretTriple HandshakeSecret -> IO (SecretTriple HandshakeSecret)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SecretTriple HandshakeSecret -> IO (SecretTriple HandshakeSecret))
    -> SecretTriple HandshakeSecret
    -> IO (SecretTriple HandshakeSecret)
    forall a b. (a -> b) -> a -> b
    $ BaseSecret HandshakeSecret
    -> ClientTrafficSecret HandshakeSecret
    -> ServerTrafficSecret HandshakeSecret
    -> SecretTriple HandshakeSecret
    forall a.
    BaseSecret a
    -> ClientTrafficSecret a -> ServerTrafficSecret a -> SecretTriple a
    SecretTriple (ByteString -> BaseSecret HandshakeSecret
    forall a. ByteString -> BaseSecret a
    BaseSecret ByteString
    handshakeSecret) ClientTrafficSecret HandshakeSecret
    chts ServerTrafficSecret HandshakeSecret
    shts
      where
        usedHash :: Hash
    usedHash = CipherChoice -> Hash
    cHash CipherChoice
    choice

    calculateApplicationSecret :: Context -> CipherChoice -> BaseSecret HandshakeSecret -> ByteString
                               -> IO (SecretTriple ApplicationSecret)
    calculateApplicationSecret :: Context
    -> CipherChoice
    -> BaseSecret HandshakeSecret
    -> ByteString
    -> IO (SecretTriple ApplicationSecret)
    calculateApplicationSecret Context
    ctx CipherChoice
    choice (BaseSecret ByteString
    sec) ByteString
    hChSf = do
        let applicationSecret :: ByteString
    applicationSecret = Hash -> ByteString -> ByteString -> ByteString
    hkdfExtract Hash
    usedHash (Hash -> ByteString -> ByteString -> ByteString -> ByteString
    deriveSecret Hash
    usedHash ByteString
    sec ByteString
    "derived" (Hash -> ByteString -> ByteString
    hash Hash
    usedHash ByteString
    "")) ByteString
    zero
        let clientApplicationSecret0 :: ByteString
    clientApplicationSecret0 = Hash -> ByteString -> ByteString -> ByteString -> ByteString
    deriveSecret Hash
    usedHash ByteString
    applicationSecret ByteString
    "c ap traffic" ByteString
    hChSf
            serverApplicationSecret0 :: ByteString
    serverApplicationSecret0 = Hash -> ByteString -> ByteString -> ByteString -> ByteString
    deriveSecret Hash
    usedHash ByteString
    applicationSecret ByteString
    "s ap traffic" ByteString
    hChSf
            exporterMasterSecret :: ByteString
    exporterMasterSecret = Hash -> ByteString -> ByteString -> ByteString -> ByteString
    deriveSecret Hash
    usedHash ByteString
    applicationSecret ByteString
    "exp master" ByteString
    hChSf
        Context -> TLSSt () -> IO ()
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx (TLSSt () -> IO ()) -> TLSSt () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ ByteString -> TLSSt ()
    setExporterMasterSecret ByteString
    exporterMasterSecret
        let sts0 :: ServerTrafficSecret ApplicationSecret
    sts0 = ByteString -> ServerTrafficSecret ApplicationSecret
    forall a. ByteString -> ServerTrafficSecret a
    ServerTrafficSecret ByteString
    serverApplicationSecret0 :: ServerTrafficSecret ApplicationSecret
        let cts0 :: ClientTrafficSecret ApplicationSecret
    cts0 = ByteString -> ClientTrafficSecret ApplicationSecret
    forall a. ByteString -> ClientTrafficSecret a
    ClientTrafficSecret ByteString
    clientApplicationSecret0 :: ClientTrafficSecret ApplicationSecret
        Context -> ServerTrafficSecret ApplicationSecret -> IO ()
    forall a. LogLabel a => Context -> a -> IO ()
    logKey Context
    ctx ServerTrafficSecret ApplicationSecret
    sts0
        Context -> ClientTrafficSecret ApplicationSecret -> IO ()
    forall a. LogLabel a => Context -> a -> IO ()
    logKey Context
    ctx ClientTrafficSecret ApplicationSecret
    cts0
        SecretTriple ApplicationSecret
    -> IO (SecretTriple ApplicationSecret)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SecretTriple ApplicationSecret
     -> IO (SecretTriple ApplicationSecret))
    -> SecretTriple ApplicationSecret
    -> IO (SecretTriple ApplicationSecret)
    forall a b. (a -> b) -> a -> b
    $ BaseSecret ApplicationSecret
    -> ClientTrafficSecret ApplicationSecret
    -> ServerTrafficSecret ApplicationSecret
    -> SecretTriple ApplicationSecret
    forall a.
    BaseSecret a
    -> ClientTrafficSecret a -> ServerTrafficSecret a -> SecretTriple a
    SecretTriple (ByteString -> BaseSecret ApplicationSecret
    forall a. ByteString -> BaseSecret a
    BaseSecret ByteString
    applicationSecret) ClientTrafficSecret ApplicationSecret
    cts0 ServerTrafficSecret ApplicationSecret
    sts0
      where
        usedHash :: Hash
    usedHash = CipherChoice -> Hash
    cHash CipherChoice
    choice
        zero :: ByteString
    zero = CipherChoice -> ByteString
    cZero CipherChoice
    choice

    calculateResumptionSecret :: Context -> CipherChoice -> BaseSecret ApplicationSecret
                              -> IO (BaseSecret ResumptionSecret)
    calculateResumptionSecret :: Context
    -> CipherChoice
    -> BaseSecret ApplicationSecret
    -> IO (BaseSecret ResumptionSecret)
    calculateResumptionSecret Context
    ctx CipherChoice
    choice (BaseSecret ByteString
    sec) = do
        ByteString
    hChCf <- Context -> IO ByteString
    forall (m :: * -> *). MonadIO m => Context -> m ByteString
    transcriptHash Context
    ctx
        let resumptionMasterSecret :: ByteString
    resumptionMasterSecret = Hash -> ByteString -> ByteString -> ByteString -> ByteString
    deriveSecret Hash
    usedHash ByteString
    sec ByteString
    "res master" ByteString
    hChCf
        BaseSecret ResumptionSecret -> IO (BaseSecret ResumptionSecret)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (BaseSecret ResumptionSecret -> IO (BaseSecret ResumptionSecret))
    -> BaseSecret ResumptionSecret -> IO (BaseSecret ResumptionSecret)
    forall a b. (a -> b) -> a -> b
    $ ByteString -> BaseSecret ResumptionSecret
    forall a. ByteString -> BaseSecret a
    BaseSecret ByteString
    resumptionMasterSecret
      where
        usedHash :: Hash
    usedHash = CipherChoice -> Hash
    cHash CipherChoice
    choice

    derivePSK :: CipherChoice -> BaseSecret ResumptionSecret -> ByteString -> ByteString
    derivePSK :: CipherChoice
    -> BaseSecret ResumptionSecret -> ByteString -> ByteString
    derivePSK CipherChoice
    choice (BaseSecret ByteString
    sec) ByteString
    nonce =
        Hash -> ByteString -> ByteString -> ByteString -> Int -> ByteString
    hkdfExpandLabel Hash
    usedHash ByteString
    sec ByteString
    "resumption" ByteString
    nonce Int
    hashSize
      where
        usedHash :: Hash
    usedHash = CipherChoice -> Hash
    cHash CipherChoice
    choice
        hashSize :: Int
    hashSize = Hash -> Int
    hashDigestSize Hash
    usedHash

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

    checkKeyShareKeyLength :: KeyShareEntry -> Bool
    checkKeyShareKeyLength :: KeyShareEntry -> Bool
    checkKeyShareKeyLength KeyShareEntry
    ks = Group -> Int
    keyShareKeyLength Group
    grp Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString -> Int
    B.length ByteString
    key
      where
        grp :: Group
    grp = KeyShareEntry -> Group
    keyShareEntryGroup KeyShareEntry
    ks
        key :: ByteString
    key = KeyShareEntry -> ByteString
    keyShareEntryKeyExchange KeyShareEntry
    ks

    keyShareKeyLength :: Group -> Int
    keyShareKeyLength :: Group -> Int
    keyShareKeyLength Group
    P256      =   Int
    65 -- 32 * 2 + 1
    keyShareKeyLength Group
    P384      =   Int
    97 -- 48 * 2 + 1
    keyShareKeyLength Group
    P521      =  Int
    133 -- 66 * 2 + 1
    keyShareKeyLength Group
    X25519    =   Int
    32
    keyShareKeyLength Group
    X448      =   Int
    56
    keyShareKeyLength Group
    FFDHE2048 =  Int
    256
    keyShareKeyLength Group
    FFDHE3072 =  Int
    384
    keyShareKeyLength Group
    FFDHE4096 =  Int
    512
    keyShareKeyLength Group
    FFDHE6144 =  Int
    768
    keyShareKeyLength Group
    FFDHE8192 = Int
    1024