    {-# LANGUAGE DeriveAnyClass #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE RecordWildCards #-}

    module Network.HTTP2.H2.Types where

    import Control.Concurrent
    import Control.Concurrent.STM
    import Control.Exception (
        Exception,
        SomeAsyncException (..),
        SomeException (..),
     )
    import qualified Control.Exception as E
    import Data.IORef
    import Network.Control
    import Network.HTTP.Semantics.Client
    import Network.HTTP.Semantics.IO
    import Network.Socket hiding (Stream)
    import System.IO.Unsafe
    import qualified System.TimeManager as T

    import Imports
    import Network.HPACK
    import Network.HTTP2.Frame

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

    {-

    == Stream state

    The stream state is stored in the 'streamState' field (an @IORef@) of a
    'Stream'. The main place where the stream state is updated is in
    'controlOrStream', which does something like this:

    > state0 <- readStreamState strm
    > state1 <- stream .. state0 ..
    > processState .. state1 ..

    where 'processState' updates the @IORef@, based on 'state1' (the state computed
    by 'stream') and the /current/ state of the stream; for simplicity, we will
    assume here that this must equal 'state0' (it might not, if a concurrent thread
    changed the stream state).

    The diagram below summarizes the stream state transitions on the client side,
    omitting error cases (which result in exceptions being thrown). Each transition
    is labelled with the relevant case in either the function 'stream' or the
    function 'processState'.

    >                        [Open JustOpened]
    >                               |
    >                               |
    >                            HEADERS
    >                               |
    >                               | (stream1)
    >                               |
    >                          END_HEADERS?
    >                               |
    >                        ______/ \______
    >                       /   yes   no    \
    >                      |                |
    >                      |         [Open Continued] <--\
    >                      |                |            |
    >                      |           CONTINUATION      |
    >                      |                |            |
    >                      |                | (stream5)  |
    >                      |                |            |
    >                      |           END_HEADERS?      |
    >                      |                |            |
    >                      v           yes / \ no        |
    >                 END_STREAM? <-------/   \-----------/
    >                      |                   (process3)
    >                      |
    >            _________/ \_________
    >           /      yes   no       \
    >           |                     |
    >      [Open NoBody]        [Open HasBody]
    >           |                     |
    >           | (process1)          | (process2)
    >           |                     |
    >  [HalfClosedRemote] <--\   [Open Body] <----------------------\
    >           |             |        |                             |
    >           |             |        +---------------\             |
    >       RST_STREAM        |        |               |             |
    >           |             |     HEADERS           DATA           |
    >           | (stream6)   |        |               |             |
    >           |             |        | (stream2)     | (stream4)   |
    >           | (process5)  |        |               |             |
    >           |             |   END_STREAM?      END_STREAM?       |
    >        [Closed]         |        |               |             |
    >                         |        | yes      yes / \ no         |
    >                         \--------+-------------/   \-----------/
    >                          (process4)                 (process6)

    Notes:

    - The 'HalfClosedLocal' state is not used on the client side.
    - Indeed, unless an exception is thrown, even the 'Closed' stream state is not
      used in the client; when the @IORef@ is collected, it is typically in
      'HalfClosedRemote' state.

    -}

    data OpenState
        = JustOpened
        | Continued
            [HeaderBlockFragment]
            Int -- Total size
            Int -- The number of continuation frames
            Bool -- End of stream
        | NoBody TokenHeaderTable
        | HasBody TokenHeaderTable
        | Body
            (TQueue (Either SomeException (ByteString, Bool)))
            (Maybe Int) -- received Content-Length
            -- compared the body length for error checking
            (IORef Int) -- actual body length
            (IORef (Maybe TokenHeaderTable)) -- trailers

    data ClosedCode
        = Finished
        | Killed
        | Reset ErrorCode
        | ResetByMe SomeException
        deriving (SettingsValue -> ClosedCode -> ShowS
    [ClosedCode] -> ShowS
    ClosedCode -> String
    (SettingsValue -> ClosedCode -> ShowS)
    -> (ClosedCode -> String)
    -> ([ClosedCode] -> ShowS)
    -> Show ClosedCode
    forall a.
    (SettingsValue -> a -> ShowS)
    -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: SettingsValue -> ClosedCode -> ShowS
    showsPrec :: SettingsValue -> ClosedCode -> ShowS
    $cshow :: ClosedCode -> String
    show :: ClosedCode -> String
    $cshowList :: [ClosedCode] -> ShowS
    showList :: [ClosedCode] -> ShowS
    Show)

    -- | Used for streams which are cancelled by calling
    -- 'Network.HTTP.Semantics.outBodyCancel'.
    data CancelledStream = CancelledStream
        deriving (SettingsValue -> CancelledStream -> ShowS
    [CancelledStream] -> ShowS
    CancelledStream -> String
    (SettingsValue -> CancelledStream -> ShowS)
    -> (CancelledStream -> String)
    -> ([CancelledStream] -> ShowS)
    -> Show CancelledStream
    forall a.
    (SettingsValue -> a -> ShowS)
    -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: SettingsValue -> CancelledStream -> ShowS
    showsPrec :: SettingsValue -> CancelledStream -> ShowS
    $cshow :: CancelledStream -> String
    show :: CancelledStream -> String
    $cshowList :: [CancelledStream] -> ShowS
    showList :: [CancelledStream] -> ShowS
    Show, Show CancelledStream
    Typeable CancelledStream
    (Typeable CancelledStream, Show CancelledStream) =>
    (CancelledStream -> SomeException)
    -> (SomeException -> Maybe CancelledStream)
    -> (CancelledStream -> String)
    -> (CancelledStream -> Bool)
    -> Exception CancelledStream
    SomeException -> Maybe CancelledStream
    CancelledStream -> Bool
    CancelledStream -> String
    CancelledStream -> SomeException
    forall e.
    (Typeable e, Show e) =>
    (e -> SomeException)
    -> (SomeException -> Maybe e)
    -> (e -> String)
    -> (e -> Bool)
    -> Exception e
    $ctoException :: CancelledStream -> SomeException
    toException :: CancelledStream -> SomeException
    $cfromException :: SomeException -> Maybe CancelledStream
    fromException :: SomeException -> Maybe CancelledStream
    $cdisplayException :: CancelledStream -> String
    displayException :: CancelledStream -> String
    $cbacktraceDesired :: CancelledStream -> Bool
    backtraceDesired :: CancelledStream -> Bool
    E.Exception)

    closedCodeToError :: StreamId -> ClosedCode -> HTTP2Error
    closedCodeToError :: SettingsValue -> ClosedCode -> HTTP2Error
    closedCodeToError SettingsValue
    sid ClosedCode
    cc =
        case ClosedCode
    cc of
            ClosedCode
    Finished -> HTTP2Error
    ConnectionIsClosed
            ClosedCode
    Killed -> HTTP2Error
    ConnectionIsTimeout
            Reset ErrorCode
    err -> ErrorCode -> SettingsValue -> ReasonPhrase -> HTTP2Error
    ConnectionErrorIsReceived ErrorCode
    err SettingsValue
    sid ReasonPhrase
    "Connection was reset"
            ResetByMe SomeException
    err -> SomeException -> HTTP2Error
    BadThingHappen SomeException
    err

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

    data StreamState
        = Idle
        | Open (Maybe ClosedCode) OpenState -- HalfClosedLocal if Just
        | HalfClosedRemote
        | Closed ClosedCode
        | Reserved

    instance Show StreamState where
        show :: StreamState -> String
    show StreamState
    Idle = String
    "Idle"
        show (Open Maybe ClosedCode
    Nothing OpenState
    _) = String
    "Open"
        show (Open (Just ClosedCode
    e) OpenState
    _) = String
    "HalfClosedLocal: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ClosedCode -> String
    forall a. Show a => a -> String
    show ClosedCode
    e
        show StreamState
    HalfClosedRemote = String
    "HalfClosedRemote"
        show (Closed ClosedCode
    e) = String
    "Closed: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ClosedCode -> String
    forall a. Show a => a -> String
    show ClosedCode
    e
        show StreamState
    Reserved = String
    "Reserved"

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

    type RxQ = TQueue (Either E.SomeException (ByteString, Bool))

    data Stream = Stream
        { Stream -> SettingsValue
    streamNumber :: StreamId
        , Stream -> IORef StreamState
    streamState :: IORef StreamState
        , Stream -> MVar (Either SomeException InpObj)
    streamInput :: MVar (Either SomeException InpObj) -- Client only
        , Stream -> TVar TxFlow
    streamTxFlow :: TVar TxFlow
        , Stream -> IORef RxFlow
    streamRxFlow :: IORef RxFlow
        , Stream -> IORef (Maybe RxQ)
    streamRxQ :: IORef (Maybe RxQ)
        }

    instance Show Stream where
        show :: Stream -> String
    show Stream{SettingsValue
    TVar TxFlow
    MVar (Either SomeException InpObj)
    IORef (Maybe RxQ)
    IORef RxFlow
    IORef StreamState
    streamNumber :: Stream -> SettingsValue
    streamState :: Stream -> IORef StreamState
    streamInput :: Stream -> MVar (Either SomeException InpObj)
    streamTxFlow :: Stream -> TVar TxFlow
    streamRxFlow :: Stream -> IORef RxFlow
    streamRxQ :: Stream -> IORef (Maybe RxQ)
    streamNumber :: SettingsValue
    streamState :: IORef StreamState
    streamInput :: MVar (Either SomeException InpObj)
    streamTxFlow :: TVar TxFlow
    streamRxFlow :: IORef RxFlow
    streamRxQ :: IORef (Maybe RxQ)
    ..} =
            String
    "Stream{id="
                String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ SettingsValue -> String
    forall a. Show a => a -> String
    show SettingsValue
    streamNumber
                String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ",state="
                String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ StreamState -> String
    forall a. Show a => a -> String
    show (IO StreamState -> StreamState
    forall a. IO a -> a
    unsafePerformIO (IORef StreamState -> IO StreamState
    forall a. IORef a -> IO a
    readIORef IORef StreamState
    streamState))
                String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "}"

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

    data Output = Output
        { Output -> Stream
    outputStream :: Stream
        , Output -> OutputType
    outputType :: OutputType
        , Output -> Maybe Output -> IO ()
    outputSync :: Maybe Output -> IO ()
        }

    data OutputType
        = OHeader [Header] (Maybe DynaNext) TrailersMaker
        | OPush TokenHeaderList StreamId -- associated stream id from client
        | ONext DynaNext TrailersMaker

    data Sync = Done | Cont Output

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

    data Control = CFrames (Maybe SettingsList) [ByteString]

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

    type ReasonPhrase = ShortByteString

    -- | The connection error or the stream error.
    --   Stream errors are treated as connection errors since
    --   there are no good recovery ways.
    --   `ErrorCode` in connection errors should be the highest stream identifier
    --   but in this implementation it identifies the stream that
    --   caused this error.
    data HTTP2Error
        = ConnectionIsClosed -- NoError
        | ConnectionIsTimeout
        | ConnectionErrorIsReceived ErrorCode StreamId ReasonPhrase
        | ConnectionErrorIsSent ErrorCode StreamId ReasonPhrase
        | StreamErrorIsReceived ErrorCode StreamId
        | StreamErrorIsSent ErrorCode StreamId ReasonPhrase
        | BadThingHappen E.SomeException
        deriving (SettingsValue -> HTTP2Error -> ShowS
    [HTTP2Error] -> ShowS
    HTTP2Error -> String
    (SettingsValue -> HTTP2Error -> ShowS)
    -> (HTTP2Error -> String)
    -> ([HTTP2Error] -> ShowS)
    -> Show HTTP2Error
    forall a.
    (SettingsValue -> a -> ShowS)
    -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: SettingsValue -> HTTP2Error -> ShowS
    showsPrec :: SettingsValue -> HTTP2Error -> ShowS
    $cshow :: HTTP2Error -> String
    show :: HTTP2Error -> String
    $cshowList :: [HTTP2Error] -> ShowS
    showList :: [HTTP2Error] -> ShowS
    Show)

    instance E.Exception HTTP2Error

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

    -- | Checking 'SettingsList' and reporting an error if any.
    --
    -- >>> checkSettingsList [(SettingsEnablePush,2)]
    -- Just (ConnectionErrorIsSent ProtocolError 0 "enable push must be 0 or 1")
    checkSettingsList :: SettingsList -> Maybe HTTP2Error
    checkSettingsList :: SettingsList -> Maybe HTTP2Error
    checkSettingsList SettingsList
    settings = case ((SettingsKey, SettingsValue) -> Maybe HTTP2Error)
    -> SettingsList -> [HTTP2Error]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (SettingsKey, SettingsValue) -> Maybe HTTP2Error
    checkSettingsValue SettingsList
    settings of
        [] -> Maybe HTTP2Error
    forall a. Maybe a
    Nothing
        (HTTP2Error
    x : [HTTP2Error]
    _) -> HTTP2Error -> Maybe HTTP2Error
    forall a. a -> Maybe a
    Just HTTP2Error
    x

    checkSettingsValue :: (SettingsKey, SettingsValue) -> Maybe HTTP2Error
    checkSettingsValue :: (SettingsKey, SettingsValue) -> Maybe HTTP2Error
    checkSettingsValue (SettingsKey
    SettingsEnablePush, SettingsValue
    v)
        | SettingsValue
    v SettingsValue -> SettingsValue -> Bool
    forall a. Eq a => a -> a -> Bool
    /= SettingsValue
    0 Bool -> Bool -> Bool
    && SettingsValue
    v SettingsValue -> SettingsValue -> Bool
    forall a. Eq a => a -> a -> Bool
    /= SettingsValue
    1 =
            HTTP2Error -> Maybe HTTP2Error
    forall a. a -> Maybe a
    Just (HTTP2Error -> Maybe HTTP2Error) -> HTTP2Error -> Maybe HTTP2Error
    forall a b. (a -> b) -> a -> b
    $ ErrorCode -> SettingsValue -> ReasonPhrase -> HTTP2Error
    ConnectionErrorIsSent ErrorCode
    ProtocolError SettingsValue
    0 ReasonPhrase
    "enable push must be 0 or 1"
    checkSettingsValue (SettingsKey
    SettingsInitialWindowSize, SettingsValue
    v)
        | SettingsValue
    v SettingsValue -> SettingsValue -> Bool
    forall a. Ord a => a -> a -> Bool
    > SettingsValue
    maxWindowSize =
            HTTP2Error -> Maybe HTTP2Error
    forall a. a -> Maybe a
    Just (HTTP2Error -> Maybe HTTP2Error) -> HTTP2Error -> Maybe HTTP2Error
    forall a b. (a -> b) -> a -> b
    $
                ErrorCode -> SettingsValue -> ReasonPhrase -> HTTP2Error
    ConnectionErrorIsSent
                    ErrorCode
    FlowControlError
                    SettingsValue
    0
                    ReasonPhrase
    "Window size must be less than or equal to 65535"
    checkSettingsValue (SettingsKey
    SettingsMaxFrameSize, SettingsValue
    v)
        | SettingsValue
    v SettingsValue -> SettingsValue -> Bool
    forall a. Ord a => a -> a -> Bool
    < SettingsValue
    defaultPayloadLength Bool -> Bool -> Bool
    || SettingsValue
    v SettingsValue -> SettingsValue -> Bool
    forall a. Ord a => a -> a -> Bool
    > SettingsValue
    maxPayloadLength =
            HTTP2Error -> Maybe HTTP2Error
    forall a. a -> Maybe a
    Just (HTTP2Error -> Maybe HTTP2Error) -> HTTP2Error -> Maybe HTTP2Error
    forall a b. (a -> b) -> a -> b
    $
                ErrorCode -> SettingsValue -> ReasonPhrase -> HTTP2Error
    ConnectionErrorIsSent
                    ErrorCode
    ProtocolError
                    SettingsValue
    0
                    ReasonPhrase
    "Max frame size must be in between 16384 and 16777215"
    checkSettingsValue (SettingsKey, SettingsValue)
    _ = Maybe HTTP2Error
    forall a. Maybe a
    Nothing

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

    -- | HTTP/2 configuration.
    data Config = Config
        { Config -> Buffer
    confWriteBuffer :: Buffer
        -- ^ This is used only by frameSender.
        -- This MUST be freed after frameSender is terminated.
        , Config -> SettingsValue
    confBufferSize :: BufferSize
        -- ^ The size of the write buffer.
        --   We assume that the read buffer is the same size.
        --   So, this value is announced via SETTINGS_MAX_FRAME_SIZE
        --   to the peer.
        , Config -> ByteString -> IO ()
    confSendAll :: ByteString -> IO ()
        , Config -> SettingsValue -> IO ByteString
    confReadN :: Int -> IO ByteString
        , Config -> PositionReadMaker
    confPositionReadMaker :: PositionReadMaker
        , Config -> Manager
    confTimeoutManager :: T.Manager
        , Config -> SockAddr
    confMySockAddr :: SockAddr
        -- ^ This is copied into 'Aux', if exist, on server.
        , Config -> SockAddr
    confPeerSockAddr :: SockAddr
        -- ^ This is copied into 'Aux', if exist, on server.
        }

    isAsyncException :: Exception e => e -> Bool
    isAsyncException :: forall e. Exception e => e -> Bool
    isAsyncException e
    e =
        case SomeException -> Maybe SomeAsyncException
    forall e. Exception e => SomeException -> Maybe e
    E.fromException (e -> SomeException
    forall e. Exception e => e -> SomeException
    E.toException e
    e) of
            Just (SomeAsyncException e
    _) -> Bool
    True
            Maybe SomeAsyncException
    Nothing -> Bool
    False