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

module Network.HTTP2.H2.Types where

import Data.IORef
import Data.Typeable
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 UnliftIO.Concurrent
import UnliftIO.Exception (SomeException)
import qualified UnliftIO.Exception as E
import UnliftIO.STM

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

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"

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

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
    }

instance Show Stream where
    show :: Stream -> String
show Stream{SettingsValue
MVar (Either SomeException InpObj)
TVar TxFlow
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
streamNumber :: SettingsValue
streamState :: IORef StreamState
streamInput :: MVar (Either SomeException InpObj)
streamTxFlow :: TVar TxFlow
streamRxFlow :: IORef RxFlow
..} =
        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 Input a = Input a InpObj

data Output a = Output
    { forall a. Output a -> a
outputStream :: a
    , forall a. Output a -> OutObj
outputObject :: OutObj
    , forall a. Output a -> OutputType
outputType :: OutputType
    , forall a. Output a -> Maybe (TBQueue StreamingChunk)
outputStrmQ :: Maybe (TBQueue StreamingChunk)
    , forall a. Output a -> IO ()
outputSentinel :: IO ()
    }

data OutputType
    = OObj
    | OWait (IO ())
    | OPush TokenHeaderList StreamId -- associated stream id from client
    | ONext DynaNext TrailersMaker

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

data Control
    = CFinish HTTP2Error
    | CFrames (Maybe SettingsList) [ByteString]
    | CGoaway ByteString (MVar ())

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

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
    | GoAwayIsSent
    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, Typeable)

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