    {-# OPTIONS_HADDOCK hide #-}
    {-# LANGUAGE OverloadedStrings, ScopedTypeVariables, BangPatterns #-}
    -- |
    -- Module      : Network.TLS.Core
    -- License     : BSD-style
    -- Maintainer  : Vincent Hanquez <vincent@snarc.org>
    -- Stability   : experimental
    -- Portability : unknown
    --
    module Network.TLS.Core
        (
        -- * Internal packet sending and receiving
          sendPacket
        , recvPacket

        -- * Initialisation and Termination of context
        , bye
        , handshake

        -- * Application Layer Protocol Negotiation
        , getNegotiatedProtocol

        -- * Server Name Indication
        , getClientSNI

        -- * High level API
        , sendData
        , recvData
        , recvData'
        , updateKey
        , KeyUpdateRequest(..)
        , requestCertificate
        ) where

    import Network.TLS.Cipher
    import Network.TLS.Context
    import Network.TLS.Crypto
    import Network.TLS.Struct
    import Network.TLS.Struct13
    import Network.TLS.State (getSession)
    import Network.TLS.Parameters
    import Network.TLS.IO
    import Network.TLS.Session
    import Network.TLS.Handshake
    import Network.TLS.Handshake.Common
    import Network.TLS.Handshake.Common13
    import Network.TLS.Handshake.Process
    import Network.TLS.Handshake.State
    import Network.TLS.Handshake.State13
    import Network.TLS.PostHandshake
    import Network.TLS.KeySchedule
    import Network.TLS.Types (Role(..), HostName)
    import Network.TLS.Util (catchException, mapChunks_)
    import Network.TLS.Extension
    import qualified Network.TLS.State as S
    import qualified Data.ByteString as B
    import qualified Data.ByteString.Char8 as C8
    import qualified Data.ByteString.Lazy as L
    import qualified Control.Exception as E

    import Control.Monad.State.Strict

    -- | notify the context that this side wants to close connection.
    -- this is important that it is called before closing the handle, otherwise
    -- the session might not be resumable (for version < TLS1.2).
    --
    -- this doesn't actually close the handle
    bye :: MonadIO m => Context -> m ()
    bye :: Context -> m ()
    bye ctx :: Context
    ctx = IO () -> m ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
        -- Although setEOF is always protected by the read lock, here we don't try
        -- to wrap ctxEOF with it, so that function bye can still be called
        -- concurrently to a blocked recvData.
        Bool
    eof <- Context -> IO Bool
    ctxEOF Context
    ctx
        Bool
    tls13 <- Context -> IO Bool
    forall (m :: * -> *). MonadIO m => Context -> m Bool
    tls13orLater Context
    ctx
        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless Bool
    eof (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Context -> IO () -> IO ()
    forall a. Context -> IO a -> IO a
    withWriteLock Context
    ctx (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            if Bool
    tls13 then
                Context -> Packet13 -> IO ()
    forall (m :: * -> *). MonadIO m => Context -> Packet13 -> m ()
    sendPacket13 Context
    ctx (Packet13 -> IO ()) -> Packet13 -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [(AlertLevel, AlertDescription)] -> Packet13
    Alert13 [(AlertLevel
    AlertLevel_Warning, AlertDescription
    CloseNotify)]
              else
                Context -> Packet -> IO ()
    forall (m :: * -> *). MonadIO m => Context -> Packet -> m ()
    sendPacket Context
    ctx (Packet -> IO ()) -> Packet -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [(AlertLevel, AlertDescription)] -> Packet
    Alert [(AlertLevel
    AlertLevel_Warning, AlertDescription
    CloseNotify)]

    -- | If the ALPN extensions have been used, this will
    -- return get the protocol agreed upon.
    getNegotiatedProtocol :: MonadIO m => Context -> m (Maybe B.ByteString)
    getNegotiatedProtocol :: Context -> m (Maybe ByteString)
    getNegotiatedProtocol ctx :: Context
    ctx = IO (Maybe ByteString) -> m (Maybe ByteString)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Maybe ByteString) -> m (Maybe ByteString))
    -> IO (Maybe ByteString) -> m (Maybe ByteString)
    forall a b. (a -> b) -> a -> b
    $ Context -> TLSSt (Maybe ByteString) -> IO (Maybe ByteString)
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx TLSSt (Maybe ByteString)
    S.getNegotiatedProtocol

    -- | If the Server Name Indication extension has been used, return the
    -- hostname specified by the client.
    getClientSNI :: MonadIO m => Context -> m (Maybe HostName)
    getClientSNI :: Context -> m (Maybe HostName)
    getClientSNI ctx :: Context
    ctx = IO (Maybe HostName) -> m (Maybe HostName)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Maybe HostName) -> m (Maybe HostName))
    -> IO (Maybe HostName) -> m (Maybe HostName)
    forall a b. (a -> b) -> a -> b
    $ Context -> TLSSt (Maybe HostName) -> IO (Maybe HostName)
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx TLSSt (Maybe HostName)
    S.getClientSNI

    -- | sendData sends a bunch of data.
    -- It will automatically chunk data to acceptable packet size
    sendData :: MonadIO m => Context -> L.ByteString -> m ()
    sendData :: Context -> ByteString -> m ()
    sendData ctx :: Context
    ctx dataToSend :: ByteString
    dataToSend = IO () -> m ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
        Bool
    tls13 <- Context -> IO Bool
    forall (m :: * -> *). MonadIO m => Context -> m Bool
    tls13orLater Context
    ctx
        let sendP :: ByteString -> IO ()
    sendP
              | Bool
    tls13     = Context -> Packet13 -> IO ()
    forall (m :: * -> *). MonadIO m => Context -> Packet13 -> m ()
    sendPacket13 Context
    ctx (Packet13 -> IO ())
    -> (ByteString -> Packet13) -> ByteString -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> Packet13
    AppData13
              | Bool
    otherwise = Context -> Packet -> IO ()
    forall (m :: * -> *). MonadIO m => Context -> Packet -> m ()
    sendPacket Context
    ctx (Packet -> IO ()) -> (ByteString -> Packet) -> ByteString -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> Packet
    AppData
        Context -> IO () -> IO ()
    forall a. Context -> IO a -> IO a
    withWriteLock Context
    ctx (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
            Context -> IO ()
    checkValid Context
    ctx
            -- All chunks are protected with the same write lock because we don't
            -- want to interleave writes from other threads in the middle of our
            -- possibly large write.
            (ByteString -> IO ()) -> [ByteString] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Int -> (ByteString -> IO ()) -> ByteString -> IO ()
    forall (m :: * -> *) a.
    Monad m =>
    Int -> (ByteString -> m a) -> ByteString -> m ()
    mapChunks_ 16384 ByteString -> IO ()
    sendP) (ByteString -> [ByteString]
    L.toChunks ByteString
    dataToSend)

    -- | Get data out of Data packet, and automatically renegotiate if a Handshake
    -- ClientHello is received.  An empty result means EOF.
    recvData :: MonadIO m => Context -> m B.ByteString
    recvData :: Context -> m ByteString
    recvData ctx :: Context
    ctx = IO ByteString -> m ByteString
    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
        Bool
    tls13 <- Context -> IO Bool
    forall (m :: * -> *). MonadIO m => Context -> m Bool
    tls13orLater Context
    ctx
        Context -> IO ByteString -> IO ByteString
    forall a. Context -> IO a -> IO a
    withReadLock Context
    ctx (IO ByteString -> IO ByteString) -> IO ByteString -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ do
            Context -> IO ()
    checkValid Context
    ctx
            -- We protect with a read lock both reception and processing of the
            -- packet, because don't want another thread to receive a new packet
            -- before this one has been fully processed.
            --
            -- Even when recvData1/recvData13 loops, we only need to call function
            -- checkValid once.  Since we hold the read lock, no concurrent call
            -- will impact the validity of the context.
            if Bool
    tls13 then Context -> IO ByteString
    recvData13 Context
    ctx else Context -> IO ByteString
    recvData1 Context
    ctx

    recvData1 :: Context -> IO B.ByteString
    recvData1 :: Context -> IO ByteString
    recvData1 ctx :: Context
    ctx = do
        Either TLSError Packet
    pkt <- Context -> IO (Either TLSError Packet)
    forall (m :: * -> *).
    MonadIO m =>
    Context -> m (Either TLSError Packet)
    recvPacket Context
    ctx
        (TLSError -> IO ByteString)
    -> (Packet -> IO ByteString)
    -> Either TLSError Packet
    -> IO ByteString
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either ((TLSError
     -> AlertLevel -> AlertDescription -> HostName -> IO ByteString)
    -> TLSError -> IO ByteString
    forall (m :: * -> *).
    Monad m =>
    (TLSError
     -> AlertLevel -> AlertDescription -> HostName -> m ByteString)
    -> TLSError -> m ByteString
    onError TLSError
    -> AlertLevel -> AlertDescription -> HostName -> IO ByteString
    forall a.
    TLSError -> AlertLevel -> AlertDescription -> HostName -> IO a
    terminate) Packet -> IO ByteString
    process Either TLSError Packet
    pkt
      where process :: Packet -> IO ByteString
    process (Handshake [ch :: Handshake
    ch@ClientHello{}]) =
                Context -> Handshake -> IO ()
    forall (m :: * -> *). MonadIO m => Context -> Handshake -> m ()
    handshakeWith Context
    ctx Handshake
    ch IO () -> IO ByteString -> IO ByteString
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Context -> IO ByteString
    recvData1 Context
    ctx
            process (Handshake [hr :: Handshake
    hr@Handshake
    HelloRequest]) =
                Context -> Handshake -> IO ()
    forall (m :: * -> *). MonadIO m => Context -> Handshake -> m ()
    handshakeWith Context
    ctx Handshake
    hr IO () -> IO ByteString -> IO ByteString
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Context -> IO ByteString
    recvData1 Context
    ctx

            process (Alert [(AlertLevel_Warning, CloseNotify)]) = Context -> IO ()
    tryBye Context
    ctx IO () -> IO () -> IO ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Context -> IO ()
    setEOF Context
    ctx IO () -> IO ByteString -> IO ByteString
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> ByteString -> IO ByteString
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    B.empty
            process (Alert [(AlertLevel_Fatal, desc :: AlertDescription
    desc)]) = do
                Context -> IO ()
    setEOF Context
    ctx
                TLSException -> IO ByteString
    forall e a. Exception e => e -> IO a
    E.throwIO (Bool -> HostName -> TLSError -> TLSException
    Terminated Bool
    True ("received fatal error: " HostName -> HostName -> HostName
    forall a. [a] -> [a] -> [a]
    ++ AlertDescription -> HostName
    forall a. Show a => a -> HostName
    show AlertDescription
    desc) ((HostName, Bool, AlertDescription) -> TLSError
    Error_Protocol ("remote side fatal error", Bool
    True, AlertDescription
    desc)))

            -- when receiving empty appdata, we just retry to get some data.
            process (AppData "") = Context -> IO ByteString
    recvData1 Context
    ctx
            process (AppData x :: ByteString
    x)  = ByteString -> IO ByteString
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    x
            process p :: Packet
    p            = let reason :: HostName
    reason = "unexpected message " HostName -> HostName -> HostName
    forall a. [a] -> [a] -> [a]
    ++ Packet -> HostName
    forall a. Show a => a -> HostName
    show Packet
    p in
                                   TLSError
    -> AlertLevel -> AlertDescription -> HostName -> IO ByteString
    forall a.
    TLSError -> AlertLevel -> AlertDescription -> HostName -> IO a
    terminate (HostName -> TLSError
    Error_Misc HostName
    reason) AlertLevel
    AlertLevel_Fatal AlertDescription
    UnexpectedMessage HostName
    reason

            terminate :: TLSError -> AlertLevel -> AlertDescription -> HostName -> IO a
    terminate = Context
    -> ([(AlertLevel, AlertDescription)] -> IO ())
    -> TLSError
    -> AlertLevel
    -> AlertDescription
    -> HostName
    -> IO a
    forall a.
    Context
    -> ([(AlertLevel, AlertDescription)] -> IO ())
    -> TLSError
    -> AlertLevel
    -> AlertDescription
    -> HostName
    -> IO a
    terminateWithWriteLock Context
    ctx (Context -> Packet -> IO ()
    forall (m :: * -> *). MonadIO m => Context -> Packet -> m ()
    sendPacket Context
    ctx (Packet -> IO ())
    -> ([(AlertLevel, AlertDescription)] -> Packet)
    -> [(AlertLevel, AlertDescription)]
    -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(AlertLevel, AlertDescription)] -> Packet
    Alert)

    recvData13 :: Context -> IO B.ByteString
    recvData13 :: Context -> IO ByteString
    recvData13 ctx :: Context
    ctx = do
        Either TLSError Packet13
    pkt <- Context -> IO (Either TLSError Packet13)
    forall (m :: * -> *).
    MonadIO m =>
    Context -> m (Either TLSError Packet13)
    recvPacket13 Context
    ctx
        (TLSError -> IO ByteString)
    -> (Packet13 -> IO ByteString)
    -> Either TLSError Packet13
    -> IO ByteString
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either ((TLSError
     -> AlertLevel -> AlertDescription -> HostName -> IO ByteString)
    -> TLSError -> IO ByteString
    forall (m :: * -> *).
    Monad m =>
    (TLSError
     -> AlertLevel -> AlertDescription -> HostName -> m ByteString)
    -> TLSError -> m ByteString
    onError TLSError
    -> AlertLevel -> AlertDescription -> HostName -> IO ByteString
    forall a.
    TLSError -> AlertLevel -> AlertDescription -> HostName -> IO a
    terminate) Packet13 -> IO ByteString
    process Either TLSError Packet13
    pkt
      where process :: Packet13 -> IO ByteString
    process (Alert13 [(AlertLevel_Warning, CloseNotify)]) = Context -> IO ()
    tryBye Context
    ctx IO () -> IO () -> IO ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Context -> IO ()
    setEOF Context
    ctx IO () -> IO ByteString -> IO ByteString
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> ByteString -> IO ByteString
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    B.empty
            process (Alert13 [(AlertLevel_Fatal, desc :: AlertDescription
    desc)]) = do
                Context -> IO ()
    setEOF Context
    ctx
                TLSException -> IO ByteString
    forall e a. Exception e => e -> IO a
    E.throwIO (Bool -> HostName -> TLSError -> TLSException
    Terminated Bool
    True ("received fatal error: " HostName -> HostName -> HostName
    forall a. [a] -> [a] -> [a]
    ++ AlertDescription -> HostName
    forall a. Show a => a -> HostName
    show AlertDescription
    desc) ((HostName, Bool, AlertDescription) -> TLSError
    Error_Protocol ("remote side fatal error", Bool
    True, AlertDescription
    desc)))
            process (Handshake13 hs :: [Handshake13]
    hs) = do
                [Handshake13] -> IO ()
    loopHandshake13 [Handshake13]
    hs
                Context -> IO ByteString
    recvData13 Context
    ctx
            -- when receiving empty appdata, we just retry to get some data.
            process (AppData13 "") = Context -> IO ByteString
    recvData13 Context
    ctx
            process (AppData13 x :: ByteString
    x) = do
                let chunkLen :: Int
    chunkLen = ByteString -> Int
    C8.length ByteString
    x
                Established
    established <- Context -> IO Established
    ctxEstablished Context
    ctx
                case Established
    established of
                  EarlyDataAllowed maxSize :: Int
    maxSize
                    | Int
    chunkLen Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    maxSize -> do
                        Context -> Established -> IO ()
    setEstablished Context
    ctx (Established -> IO ()) -> Established -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Int -> Established
    EarlyDataAllowed (Int
    maxSize Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    chunkLen)
                        ByteString -> IO ByteString
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    x
                    | Bool
    otherwise ->
                        let reason :: HostName
    reason = "early data overflow" in
                        TLSError
    -> AlertLevel -> AlertDescription -> HostName -> IO ByteString
    forall a.
    TLSError -> AlertLevel -> AlertDescription -> HostName -> IO a
    terminate (HostName -> TLSError
    Error_Misc HostName
    reason) AlertLevel
    AlertLevel_Fatal AlertDescription
    UnexpectedMessage HostName
    reason
                  EarlyDataNotAllowed n :: Int
    n
                    | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > 0     -> do
                        Context -> Established -> IO ()
    setEstablished Context
    ctx (Established -> IO ()) -> Established -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Int -> Established
    EarlyDataNotAllowed (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - 1)
                        Context -> IO ByteString
    recvData13 Context
    ctx -- ignore "x"
                    | Bool
    otherwise ->
                        let reason :: HostName
    reason = "early data deprotect overflow" in
                        TLSError
    -> AlertLevel -> AlertDescription -> HostName -> IO ByteString
    forall a.
    TLSError -> AlertLevel -> AlertDescription -> HostName -> IO a
    terminate (HostName -> TLSError
    Error_Misc HostName
    reason) AlertLevel
    AlertLevel_Fatal AlertDescription
    UnexpectedMessage HostName
    reason
                  Established         -> ByteString -> IO ByteString
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    x
                  NotEstablished      -> TLSError -> IO ByteString
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwCore (TLSError -> IO ByteString) -> TLSError -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ (HostName, Bool, AlertDescription) -> TLSError
    Error_Protocol ("data at not-established", Bool
    True, AlertDescription
    UnexpectedMessage)
            process ChangeCipherSpec13 = Context -> IO ByteString
    recvData13 Context
    ctx
            process p :: Packet13
    p             = let reason :: HostName
    reason = "unexpected message " HostName -> HostName -> HostName
    forall a. [a] -> [a] -> [a]
    ++ Packet13 -> HostName
    forall a. Show a => a -> HostName
    show Packet13
    p in
                                    TLSError
    -> AlertLevel -> AlertDescription -> HostName -> IO ByteString
    forall a.
    TLSError -> AlertLevel -> AlertDescription -> HostName -> IO a
    terminate (HostName -> TLSError
    Error_Misc HostName
    reason) AlertLevel
    AlertLevel_Fatal AlertDescription
    UnexpectedMessage HostName
    reason

            loopHandshake13 :: [Handshake13] -> IO ()
    loopHandshake13 [] = () -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            loopHandshake13 (ClientHello13{}:_) = do
                let reason :: HostName
    reason = "Client hello is not allowed"
                TLSError -> AlertLevel -> AlertDescription -> HostName -> IO ()
    forall a.
    TLSError -> AlertLevel -> AlertDescription -> HostName -> IO a
    terminate (HostName -> TLSError
    Error_Misc HostName
    reason) AlertLevel
    AlertLevel_Fatal AlertDescription
    UnexpectedMessage HostName
    reason
            -- fixme: some implementations send multiple NST at the same time.
            -- Only the first one is used at this moment.
            loopHandshake13 (NewSessionTicket13 life :: Second
    life add :: Second
    add nonce :: ByteString
    nonce label :: ByteString
    label exts :: [ExtensionRaw]
    exts:hs :: [Handshake13]
    hs) = do
                Role
    role <- Context -> TLSSt Role -> IO Role
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx TLSSt Role
    S.isClientContext
                Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Role
    role Role -> Role -> Bool
    forall a. Eq a => a -> a -> Bool
    == Role
    ClientRole) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                    let reason :: HostName
    reason = "Session ticket is allowed for client only"
                     in TLSError -> AlertLevel -> AlertDescription -> HostName -> IO ()
    forall a.
    TLSError -> AlertLevel -> AlertDescription -> HostName -> IO a
    terminate (HostName -> TLSError
    Error_Misc HostName
    reason) AlertLevel
    AlertLevel_Fatal AlertDescription
    UnexpectedMessage HostName
    reason
                -- This part is similar to handshake code, so protected with
                -- read+write locks (which is also what we use for all calls to the
                -- session manager).
                Context -> IO () -> IO ()
    forall a. Context -> IO a -> IO a
    withWriteLock Context
    ctx (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
                    Just resumptionMasterSecret :: BaseSecret ResumptionSecret
    resumptionMasterSecret <- Context
    -> HandshakeM (Maybe (BaseSecret ResumptionSecret))
    -> IO (Maybe (BaseSecret ResumptionSecret))
    forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
    usingHState Context
    ctx HandshakeM (Maybe (BaseSecret ResumptionSecret))
    getTLS13ResumptionSecret
                    (_, usedCipher :: Cipher
    usedCipher, _) <- Context -> IO (Hash, Cipher, ByteString)
    getTxState Context
    ctx
                    let choice :: CipherChoice
    choice = Version -> Cipher -> CipherChoice
    makeCipherChoice Version
    TLS13 Cipher
    usedCipher
                        psk :: ByteString
    psk = CipherChoice
    -> BaseSecret ResumptionSecret -> ByteString -> ByteString
    derivePSK CipherChoice
    choice BaseSecret ResumptionSecret
    resumptionMasterSecret ByteString
    nonce
                        maxSize :: Int
    maxSize = case ExtensionID -> [ExtensionRaw] -> Maybe ByteString
    extensionLookup ExtensionID
    extensionID_EarlyData [ExtensionRaw]
    exts Maybe ByteString
    -> (ByteString -> Maybe EarlyDataIndication)
    -> Maybe EarlyDataIndication
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= MessageType -> ByteString -> Maybe EarlyDataIndication
    forall a. Extension a => MessageType -> ByteString -> Maybe a
    extensionDecode MessageType
    MsgTNewSessionTicket of
                            Just (EarlyDataIndication (Just ms :: Second
    ms)) -> Second -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Second -> Int) -> Second -> Int
    forall a b. (a -> b) -> a -> b
    $ Second -> Second
    forall a. (Num a, Ord a, FiniteBits a) => a -> a
    safeNonNegative32 Second
    ms
                            _                                    -> 0
                        life7d :: Second
    life7d = Second -> Second -> Second
    forall a. Ord a => a -> a -> a
    min Second
    life 604800  -- 7 days max
                    TLS13TicketInfo
    tinfo <- Second
    -> Either Context Second -> Maybe Millisecond -> IO TLS13TicketInfo
    createTLS13TicketInfo Second
    life7d (Second -> Either Context Second
    forall a b. b -> Either a b
    Right Second
    add) Maybe Millisecond
    forall a. Maybe a
    Nothing
                    SessionData
    sdata <- Context
    -> Cipher -> TLS13TicketInfo -> Int -> ByteString -> IO SessionData
    getSessionData13 Context
    ctx Cipher
    usedCipher TLS13TicketInfo
    tinfo Int
    maxSize ByteString
    psk
                    let !label' :: ByteString
    label' = ByteString -> ByteString
    B.copy ByteString
    label
                    SessionManager -> ByteString -> SessionData -> IO ()
    sessionEstablish (Shared -> SessionManager
    sharedSessionManager (Shared -> SessionManager) -> Shared -> SessionManager
    forall a b. (a -> b) -> a -> b
    $ Context -> Shared
    ctxShared Context
    ctx) ByteString
    label' SessionData
    sdata
                    -- putStrLn $ "NewSessionTicket received: lifetime = " ++ show life ++ " sec"
                [Handshake13] -> IO ()
    loopHandshake13 [Handshake13]
    hs
            loopHandshake13 (KeyUpdate13 mode :: KeyUpdate
    mode:hs :: [Handshake13]
    hs) = do
                [Handshake13] -> IO ()
    forall (t :: * -> *) a. Foldable t => t a -> IO ()
    checkAlignment [Handshake13]
    hs
                Established
    established <- Context -> IO Established
    ctxEstablished Context
    ctx
                -- Though RFC 8446 Sec 4.6.3 does not clearly says,
                -- unidirectional key update is legal.
                -- So, we don't have to check if this key update is corresponding
                -- to key update (update_requested) which we sent.
                if Established
    established Established -> Established -> Bool
    forall a. Eq a => a -> a -> Bool
    == Established
    Established then do
                    Context
    -> (Context -> IO (Hash, Cipher, ByteString))
    -> (Context -> Hash -> Cipher -> ByteString -> IO ())
    -> IO ()
    keyUpdate Context
    ctx Context -> IO (Hash, Cipher, ByteString)
    getRxState Context -> Hash -> Cipher -> ByteString -> IO ()
    setRxState
                    -- Write lock wraps both actions because we don't want another
                    -- packet to be sent by another thread before the Tx state is
                    -- updated.
                    Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (KeyUpdate
    mode KeyUpdate -> KeyUpdate -> Bool
    forall a. Eq a => a -> a -> Bool
    == KeyUpdate
    UpdateRequested) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Context -> IO () -> IO ()
    forall a. Context -> IO a -> IO a
    withWriteLock Context
    ctx (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
                        Context -> Packet13 -> IO ()
    forall (m :: * -> *). MonadIO m => Context -> Packet13 -> m ()
    sendPacket13 Context
    ctx (Packet13 -> IO ()) -> Packet13 -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Handshake13] -> Packet13
    Handshake13 [KeyUpdate -> Handshake13
    KeyUpdate13 KeyUpdate
    UpdateNotRequested]
                        Context
    -> (Context -> IO (Hash, Cipher, ByteString))
    -> (Context -> Hash -> Cipher -> ByteString -> IO ())
    -> IO ()
    keyUpdate Context
    ctx Context -> IO (Hash, Cipher, ByteString)
    getTxState Context -> Hash -> Cipher -> ByteString -> IO ()
    setTxState
                    [Handshake13] -> IO ()
    loopHandshake13 [Handshake13]
    hs
                  else do
                    let reason :: HostName
    reason = "received key update before established"
                    TLSError -> AlertLevel -> AlertDescription -> HostName -> IO ()
    forall a.
    TLSError -> AlertLevel -> AlertDescription -> HostName -> IO a
    terminate (HostName -> TLSError
    Error_Misc HostName
    reason) AlertLevel
    AlertLevel_Fatal AlertDescription
    UnexpectedMessage HostName
    reason
            loopHandshake13 (h :: Handshake13
    h@CertRequest13{}:hs :: [Handshake13]
    hs) =
                Context -> Handshake13 -> IO ()
    forall (m :: * -> *). MonadIO m => Context -> Handshake13 -> m ()
    postHandshakeAuthWith Context
    ctx Handshake13
    h IO () -> IO () -> IO ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> [Handshake13] -> IO ()
    loopHandshake13 [Handshake13]
    hs
            loopHandshake13 (h :: Handshake13
    h@Certificate13{}:hs :: [Handshake13]
    hs) =
                Context -> Handshake13 -> IO ()
    forall (m :: * -> *). MonadIO m => Context -> Handshake13 -> m ()
    postHandshakeAuthWith Context
    ctx Handshake13
    h IO () -> IO () -> IO ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> [Handshake13] -> IO ()
    loopHandshake13 [Handshake13]
    hs
            loopHandshake13 (h :: Handshake13
    h:hs :: [Handshake13]
    hs) = do
                Maybe PendingAction
    mPendingAction <- Context -> IO (Maybe PendingAction)
    popPendingAction Context
    ctx
                case Maybe PendingAction
    mPendingAction of
                    Nothing -> let reason :: HostName
    reason = "unexpected handshake message " HostName -> HostName -> HostName
    forall a. [a] -> [a] -> [a]
    ++ Handshake13 -> HostName
    forall a. Show a => a -> HostName
    show Handshake13
    h in
                               TLSError -> AlertLevel -> AlertDescription -> HostName -> IO ()
    forall a.
    TLSError -> AlertLevel -> AlertDescription -> HostName -> IO a
    terminate (HostName -> TLSError
    Error_Misc HostName
    reason) AlertLevel
    AlertLevel_Fatal AlertDescription
    UnexpectedMessage HostName
    reason
                    Just action :: PendingAction
    action -> do
                        -- Pending actions are executed with read+write locks, just
                        -- like regular handshake code.
                        Context -> IO () -> IO ()
    forall a. Context -> IO a -> IO a
    withWriteLock Context
    ctx (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Context -> IO () -> IO ()
    handleException Context
    ctx (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                            case PendingAction
    action of
                                PendingAction needAligned :: Bool
    needAligned pa :: Handshake13 -> IO ()
    pa -> do
                                    Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    needAligned (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Handshake13] -> IO ()
    forall (t :: * -> *) a. Foldable t => t a -> IO ()
    checkAlignment [Handshake13]
    hs
                                    Context -> Handshake13 -> IO ()
    processHandshake13 Context
    ctx Handshake13
    h IO () -> IO () -> IO ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Handshake13 -> IO ()
    pa Handshake13
    h
                                PendingActionHash needAligned :: Bool
    needAligned pa :: ByteString -> Handshake13 -> IO ()
    pa -> do
                                    Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    needAligned (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Handshake13] -> IO ()
    forall (t :: * -> *) a. Foldable t => t a -> IO ()
    checkAlignment [Handshake13]
    hs
                                    ByteString
    d <- Context -> IO ByteString
    forall (m :: * -> *). MonadIO m => Context -> m ByteString
    transcriptHash Context
    ctx
                                    Context -> Handshake13 -> IO ()
    processHandshake13 Context
    ctx Handshake13
    h
                                    ByteString -> Handshake13 -> IO ()
    pa ByteString
    d Handshake13
    h
                        [Handshake13] -> IO ()
    loopHandshake13 [Handshake13]
    hs

            terminate :: TLSError -> AlertLevel -> AlertDescription -> HostName -> IO a
    terminate = Context
    -> ([(AlertLevel, AlertDescription)] -> IO ())
    -> TLSError
    -> AlertLevel
    -> AlertDescription
    -> HostName
    -> IO a
    forall a.
    Context
    -> ([(AlertLevel, AlertDescription)] -> IO ())
    -> TLSError
    -> AlertLevel
    -> AlertDescription
    -> HostName
    -> IO a
    terminateWithWriteLock Context
    ctx (Context -> Packet13 -> IO ()
    forall (m :: * -> *). MonadIO m => Context -> Packet13 -> m ()
    sendPacket13 Context
    ctx (Packet13 -> IO ())
    -> ([(AlertLevel, AlertDescription)] -> Packet13)
    -> [(AlertLevel, AlertDescription)]
    -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(AlertLevel, AlertDescription)] -> Packet13
    Alert13)

            checkAlignment :: t a -> IO ()
    checkAlignment hs :: t a
    hs = do
                Bool
    complete <- Context -> IO Bool
    isRecvComplete Context
    ctx
                Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Bool
    complete Bool -> Bool -> Bool
    && t a -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null t a
    hs) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                    let reason :: HostName
    reason = "received message not aligned with record boundary"
                     in TLSError -> AlertLevel -> AlertDescription -> HostName -> IO ()
    forall a.
    TLSError -> AlertLevel -> AlertDescription -> HostName -> IO a
    terminate (HostName -> TLSError
    Error_Misc HostName
    reason) AlertLevel
    AlertLevel_Fatal AlertDescription
    UnexpectedMessage HostName
    reason

    -- the other side could have close the connection already, so wrap
    -- this in a try and ignore all exceptions
    tryBye :: Context -> IO ()
    tryBye :: Context -> IO ()
    tryBye ctx :: Context
    ctx = IO () -> (SomeException -> IO ()) -> IO ()
    forall a. IO a -> (SomeException -> IO a) -> IO a
    catchException (Context -> IO ()
    forall (m :: * -> *). MonadIO m => Context -> m ()
    bye Context
    ctx) (\_ -> () -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())

    onError :: Monad m => (TLSError -> AlertLevel -> AlertDescription -> String -> m B.ByteString)
                       -> TLSError -> m B.ByteString
    onError :: (TLSError
     -> AlertLevel -> AlertDescription -> HostName -> m ByteString)
    -> TLSError -> m ByteString
    onError _ Error_EOF = -- Not really an error.
                ByteString -> m ByteString
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    B.empty
    onError terminate :: TLSError
    -> AlertLevel -> AlertDescription -> HostName -> m ByteString
    terminate err :: TLSError
    err@(Error_Protocol (reason :: HostName
    reason,fatal :: Bool
    fatal,desc :: AlertDescription
    desc)) =
        TLSError
    -> AlertLevel -> AlertDescription -> HostName -> m ByteString
    terminate TLSError
    err (if Bool
    fatal then AlertLevel
    AlertLevel_Fatal else AlertLevel
    AlertLevel_Warning) AlertDescription
    desc HostName
    reason
    onError terminate :: TLSError
    -> AlertLevel -> AlertDescription -> HostName -> m ByteString
    terminate err :: TLSError
    err =
        TLSError
    -> AlertLevel -> AlertDescription -> HostName -> m ByteString
    terminate TLSError
    err AlertLevel
    AlertLevel_Fatal AlertDescription
    InternalError (TLSError -> HostName
    forall a. Show a => a -> HostName
    show TLSError
    err)

    terminateWithWriteLock :: Context -> ([(AlertLevel, AlertDescription)] -> IO ())
                           -> TLSError -> AlertLevel -> AlertDescription -> String -> IO a
    terminateWithWriteLock :: Context
    -> ([(AlertLevel, AlertDescription)] -> IO ())
    -> TLSError
    -> AlertLevel
    -> AlertDescription
    -> HostName
    -> IO a
    terminateWithWriteLock ctx :: Context
    ctx send :: [(AlertLevel, AlertDescription)] -> IO ()
    send err :: TLSError
    err level :: AlertLevel
    level desc :: AlertDescription
    desc reason :: HostName
    reason = do
        Session
    session <- Context -> TLSSt Session -> IO Session
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx TLSSt Session
    getSession
        -- Session manager is always invoked with read+write locks, so we merge this
        -- with the alert packet being emitted.
        Context -> IO () -> IO ()
    forall a. Context -> IO a -> IO a
    withWriteLock Context
    ctx (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
            case Session
    session of
                Session Nothing    -> () -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                Session (Just sid :: ByteString
    sid) -> SessionManager -> ByteString -> IO ()
    sessionInvalidate (Shared -> SessionManager
    sharedSessionManager (Shared -> SessionManager) -> Shared -> SessionManager
    forall a b. (a -> b) -> a -> b
    $ Context -> Shared
    ctxShared Context
    ctx) ByteString
    sid
            IO () -> (SomeException -> IO ()) -> IO ()
    forall a. IO a -> (SomeException -> IO a) -> IO a
    catchException ([(AlertLevel, AlertDescription)] -> IO ()
    send [(AlertLevel
    level, AlertDescription
    desc)]) (\_ -> () -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())
        Context -> IO ()
    setEOF Context
    ctx
        TLSException -> IO a
    forall e a. Exception e => e -> IO a
    E.throwIO (Bool -> HostName -> TLSError -> TLSException
    Terminated Bool
    False HostName
    reason TLSError
    err)

    {-# DEPRECATED recvData' "use recvData that returns strict bytestring" #-}
    -- | same as recvData but returns a lazy bytestring.
    recvData' :: MonadIO m => Context -> m L.ByteString
    recvData' :: Context -> m ByteString
    recvData' ctx :: Context
    ctx = [ByteString] -> ByteString
    L.fromChunks ([ByteString] -> ByteString)
    -> (ByteString -> [ByteString]) -> ByteString -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ByteString -> [ByteString] -> [ByteString]
    forall a. a -> [a] -> [a]
    :[]) (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
    recvData Context
    ctx

    keyUpdate :: Context
              -> (Context -> IO (Hash,Cipher,C8.ByteString))
              -> (Context -> Hash -> Cipher -> C8.ByteString -> IO ())
              -> IO ()
    keyUpdate :: Context
    -> (Context -> IO (Hash, Cipher, ByteString))
    -> (Context -> Hash -> Cipher -> ByteString -> IO ())
    -> IO ()
    keyUpdate ctx :: Context
    ctx getState :: Context -> IO (Hash, Cipher, ByteString)
    getState setState :: Context -> Hash -> Cipher -> ByteString -> IO ()
    setState = do
        (usedHash :: Hash
    usedHash, usedCipher :: Cipher
    usedCipher, applicationSecretN :: ByteString
    applicationSecretN) <- Context -> IO (Hash, Cipher, ByteString)
    getState Context
    ctx
        let applicationSecretN1 :: ByteString
    applicationSecretN1 = Hash -> ByteString -> ByteString -> ByteString -> Int -> ByteString
    hkdfExpandLabel Hash
    usedHash ByteString
    applicationSecretN "traffic upd" "" (Int -> ByteString) -> Int -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Hash -> Int
    hashDigestSize Hash
    usedHash
        Context -> Hash -> Cipher -> ByteString -> IO ()
    setState Context
    ctx Hash
    usedHash Cipher
    usedCipher ByteString
    applicationSecretN1

    -- | How to update keys in TLS 1.3
    data KeyUpdateRequest = OneWay -- ^ Unidirectional key update
                          | TwoWay -- ^ Bidirectional key update (normal case)
                          deriving (KeyUpdateRequest -> KeyUpdateRequest -> Bool
    (KeyUpdateRequest -> KeyUpdateRequest -> Bool)
    -> (KeyUpdateRequest -> KeyUpdateRequest -> Bool)
    -> Eq KeyUpdateRequest
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: KeyUpdateRequest -> KeyUpdateRequest -> Bool
    $c/= :: KeyUpdateRequest -> KeyUpdateRequest -> Bool
    == :: KeyUpdateRequest -> KeyUpdateRequest -> Bool
    $c== :: KeyUpdateRequest -> KeyUpdateRequest -> Bool
    Eq, Int -> KeyUpdateRequest -> HostName -> HostName
    [KeyUpdateRequest] -> HostName -> HostName
    KeyUpdateRequest -> HostName
    (Int -> KeyUpdateRequest -> HostName -> HostName)
    -> (KeyUpdateRequest -> HostName)
    -> ([KeyUpdateRequest] -> HostName -> HostName)
    -> Show KeyUpdateRequest
    forall a.
    (Int -> a -> HostName -> HostName)
    -> (a -> HostName) -> ([a] -> HostName -> HostName) -> Show a
    showList :: [KeyUpdateRequest] -> HostName -> HostName
    $cshowList :: [KeyUpdateRequest] -> HostName -> HostName
    show :: KeyUpdateRequest -> HostName
    $cshow :: KeyUpdateRequest -> HostName
    showsPrec :: Int -> KeyUpdateRequest -> HostName -> HostName
    $cshowsPrec :: Int -> KeyUpdateRequest -> HostName -> HostName
    Show)

    -- | Updating appication traffic secrets for TLS 1.3.
    --   If this API is called for TLS 1.3, 'True' is returned.
    --   Otherwise, 'False' is returned.
    updateKey :: MonadIO m => Context -> KeyUpdateRequest -> m Bool
    updateKey :: Context -> KeyUpdateRequest -> m Bool
    updateKey ctx :: Context
    ctx way :: KeyUpdateRequest
    way = IO Bool -> m Bool
    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
        Bool
    tls13 <- Context -> IO Bool
    forall (m :: * -> *). MonadIO m => Context -> m Bool
    tls13orLater Context
    ctx
        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    tls13 (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
            let req :: KeyUpdate
    req = case KeyUpdateRequest
    way of
                    OneWay -> KeyUpdate
    UpdateNotRequested
                    TwoWay -> KeyUpdate
    UpdateRequested
            -- Write lock wraps both actions because we don't want another packet to
            -- be sent by another thread before the Tx state is updated.
            Context -> IO () -> IO ()
    forall a. Context -> IO a -> IO a
    withWriteLock Context
    ctx (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
                Context -> Packet13 -> IO ()
    forall (m :: * -> *). MonadIO m => Context -> Packet13 -> m ()
    sendPacket13 Context
    ctx (Packet13 -> IO ()) -> Packet13 -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Handshake13] -> Packet13
    Handshake13 [KeyUpdate -> Handshake13
    KeyUpdate13 KeyUpdate
    req]
                Context
    -> (Context -> IO (Hash, Cipher, ByteString))
    -> (Context -> Hash -> Cipher -> ByteString -> IO ())
    -> IO ()
    keyUpdate Context
    ctx Context -> IO (Hash, Cipher, ByteString)
    getTxState Context -> Hash -> Cipher -> ByteString -> IO ()
    setTxState
        Bool -> IO Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    tls13