{-# LANGUAGE OverloadedStrings #-}

module Network.HTTP2.Arch.Types where

import Control.Concurrent
import Control.Concurrent.STM
import Control.Exception (SomeException)
import Data.ByteString.Builder (Builder)
import Data.IORef
import Data.IntMap.Strict (IntMap)
import qualified Network.HTTP.Types as H

import Imports
import Network.HPACK
import Network.HTTP2.Arch.File
import Network.HTTP2.Frame

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

-- | "http" or "https".
type Scheme = ByteString

-- | For so-called "Host:" header.
type Authority = ByteString

-- | Path.
type Path = ByteString

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

type InpBody = IO ByteString

data OutBody = OutBodyNone
             -- | Streaming body takes a write action and a flush action.
             | OutBodyStreaming ((Builder -> IO ()) -> IO () -> IO ())
             | OutBodyBuilder Builder
             | OutBodyFile FileSpec

-- | Input object
data InpObj = InpObj {
    InpObj -> HeaderTable
inpObjHeaders  :: HeaderTable   -- ^ Accessor for headers.
  , InpObj -> Maybe Int
inpObjBodySize :: Maybe Int     -- ^ Accessor for body length specified in content-length:.
  , InpObj -> InpBody
inpObjBody     :: InpBody       -- ^ Accessor for body.
  , InpObj -> IORef (Maybe HeaderTable)
inpObjTrailers :: IORef (Maybe HeaderTable) -- ^ Accessor for trailers.
  }

instance Show InpObj where
    show :: InpObj -> String
show (InpObj (TokenHeaderList
thl,ValueTable
_) Maybe Int
_ InpBody
_body IORef (Maybe HeaderTable)
_tref) = TokenHeaderList -> String
forall a. Show a => a -> String
show TokenHeaderList
thl

-- | Output object
data OutObj = OutObj {
    OutObj -> [Header]
outObjHeaders  :: [H.Header]    -- ^ Accessor for header.
  , OutObj -> OutBody
outObjBody     :: OutBody       -- ^ Accessor for outObj body.
  , OutObj -> TrailersMaker
outObjTrailers :: TrailersMaker -- ^ Accessor for trailers maker.
  }

instance Show OutObj where
    show :: OutObj -> String
show (OutObj [Header]
hdr OutBody
_ TrailersMaker
_) = [Header] -> String
forall a. Show a => a -> String
show [Header]
hdr

-- | Trailers maker. A chunks of the response body is passed
--   with 'Just'. The maker should update internal state
--   with the 'ByteString' and return the next trailers maker.
--   When response body reaches its end,
--   'Nothing' is passed and the maker should generate
--   trailers. An example:
--
--   > {-# LANGUAGE BangPatterns #-}
--   > import Data.ByteString (ByteString)
--   > import qualified Data.ByteString.Char8 as C8
--   > import Crypto.Hash (Context, SHA1) -- cryptonite
--   > import qualified Crypto.Hash as CH
--   >
--   > -- Strictness is important for Context.
--   > trailersMaker :: Context SHA1 -> Maybe ByteString -> IO NextTrailersMaker
--   > trailersMaker ctx Nothing = return $ Trailers [("X-SHA1", sha1)]
--   >   where
--   >     !sha1 = C8.pack $ show $ CH.hashFinalize ctx
--   > trailersMaker ctx (Just bs) = return $ NextTrailersMaker $ trailersMaker ctx'
--   >   where
--   >     !ctx' = CH.hashUpdate ctx bs
--
--   Usage example:
--
--   > let h2rsp = responseFile ...
--   >     maker = trailersMaker (CH.hashInit :: Context SHA1)
--   >     h2rsp' = setResponseTrailersMaker h2rsp maker
--
type TrailersMaker = Maybe ByteString -> IO NextTrailersMaker

-- | TrailersMake to create no trailers.
defaultTrailersMaker :: TrailersMaker
defaultTrailersMaker :: TrailersMaker
defaultTrailersMaker Maybe ByteString
Nothing = NextTrailersMaker -> IO NextTrailersMaker
forall (m :: * -> *) a. Monad m => a -> m a
return (NextTrailersMaker -> IO NextTrailersMaker)
-> NextTrailersMaker -> IO NextTrailersMaker
forall a b. (a -> b) -> a -> b
$ [Header] -> NextTrailersMaker
Trailers []
defaultTrailersMaker Maybe ByteString
_       = NextTrailersMaker -> IO NextTrailersMaker
forall (m :: * -> *) a. Monad m => a -> m a
return (NextTrailersMaker -> IO NextTrailersMaker)
-> NextTrailersMaker -> IO NextTrailersMaker
forall a b. (a -> b) -> a -> b
$ TrailersMaker -> NextTrailersMaker
NextTrailersMaker TrailersMaker
defaultTrailersMaker

-- | Either the next trailers maker or final trailers.
data NextTrailersMaker = NextTrailersMaker TrailersMaker
                       | Trailers [H.Header]

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

-- | File specification.
data FileSpec = FileSpec FilePath FileOffset ByteCount deriving (FileSpec -> FileSpec -> Bool
(FileSpec -> FileSpec -> Bool)
-> (FileSpec -> FileSpec -> Bool) -> Eq FileSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileSpec -> FileSpec -> Bool
$c/= :: FileSpec -> FileSpec -> Bool
== :: FileSpec -> FileSpec -> Bool
$c== :: FileSpec -> FileSpec -> Bool
Eq, Int -> FileSpec -> ShowS
[FileSpec] -> ShowS
FileSpec -> String
(Int -> FileSpec -> ShowS)
-> (FileSpec -> String) -> ([FileSpec] -> ShowS) -> Show FileSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileSpec] -> ShowS
$cshowList :: [FileSpec] -> ShowS
show :: FileSpec -> String
$cshow :: FileSpec -> String
showsPrec :: Int -> FileSpec -> ShowS
$cshowsPrec :: Int -> FileSpec -> ShowS
Show)

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

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

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

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

data StreamState =
    Idle
  | Open OpenState
  | HalfClosedRemote
  | HalfClosedLocal ClosedCode
  | Closed ClosedCode
  | Reserved

instance Show StreamState where
    show :: StreamState -> String
show StreamState
Idle                = String
"Idle"
    show Open{}              = String
"Open"
    show StreamState
HalfClosedRemote    = String
"HalfClosedRemote"
    show (HalfClosedLocal ClosedCode
e) = String
"HalfClosedLocal: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ClosedCode -> String
forall a. Show a => a -> String
show ClosedCode
e
    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 -> Int
streamNumber     :: StreamId
  , Stream -> IORef StreamState
streamState      :: IORef StreamState
  , Stream -> TVar Int
streamWindow     :: TVar WindowSize
  , Stream -> MVar InpObj
streamInput      :: MVar InpObj -- Client only
  }

instance Show Stream where
  show :: Stream -> String
show Stream
s = Int -> String
forall a. Show a => a -> String
show (Stream -> Int
streamNumber Stream
s)

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

newtype StreamTable = StreamTable (IORef (IntMap Stream))

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

data Input a = Input a InpObj

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

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

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

type DynaNext = Buffer -> BufferSize -> WindowSize -> IO Next

type BytesFilled = Int

data Next = Next BytesFilled (Maybe DynaNext)

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

data Control = CFinish
             | CGoaway    ByteString
             | CFrame     ByteString
             | CSettings  ByteString SettingsList
             | CSettings0 ByteString ByteString SettingsList

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

data StreamingChunk = StreamingFinished
                    | StreamingFlush
                    | StreamingBuilder Builder