{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
module Network.HTTP2.H2.Types where
import qualified Control.Exception as E
import Data.ByteString.Builder (Builder)
import Data.IORef
import Data.Typeable
import Network.Control
import qualified Network.HTTP.Types as H
import Network.Socket hiding (Stream)
import System.IO.Unsafe
import qualified System.TimeManager as T
import UnliftIO.Concurrent
import UnliftIO.Exception (SomeException)
import UnliftIO.STM
import Imports
import Network.HPACK
import Network.HTTP2.Frame
import Network.HTTP2.H2.File
type Scheme = ByteString
type Authority = ByteString
type Path = ByteString
type InpBody = IO ByteString
data OutBody
= OutBodyNone
|
OutBodyStreaming ((Builder -> IO ()) -> IO () -> IO ())
|
OutBodyStreamingUnmask
((forall x. IO x -> IO x) -> (Builder -> IO ()) -> IO () -> IO ())
| OutBodyBuilder Builder
| OutBodyFile FileSpec
data InpObj = InpObj
{ :: HeaderTable
, InpObj -> Maybe Int
inpObjBodySize :: Maybe Int
, InpObj -> InpBody
inpObjBody :: InpBody
, InpObj -> IORef (Maybe HeaderTable)
inpObjTrailers :: IORef (Maybe HeaderTable)
}
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
data OutObj = OutObj
{ :: [H.Header]
, OutObj -> OutBody
outObjBody :: OutBody
, OutObj -> TrailersMaker
outObjTrailers :: TrailersMaker
}
instance Show OutObj where
show :: OutObj -> String
show (OutObj [Header]
hdr OutBody
_ TrailersMaker
_) = [Header] -> String
forall a. Show a => a -> String
show [Header]
hdr
type TrailersMaker = Maybe ByteString -> IO NextTrailersMaker
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
data NextTrailersMaker
= NextTrailersMaker TrailersMaker
| Trailers [H.Header]
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
Int
Bool
| NoBody HeaderTable
| HasBody HeaderTable
| Body
(TQueue (Either SomeException ByteString))
(Maybe Int)
(IORef Int)
(IORef (Maybe HeaderTable))
data ClosedCode
= Finished
| Killed
| Reset ErrorCode
| 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)
closedCodeToError :: StreamId -> ClosedCode -> HTTP2Error
closedCodeToError :: Int -> ClosedCode -> HTTP2Error
closedCodeToError Int
sid ClosedCode
cc =
case ClosedCode
cc of
ClosedCode
Finished -> HTTP2Error
ConnectionIsClosed
ClosedCode
Killed -> HTTP2Error
ConnectionIsTimeout
Reset ErrorCode
err -> ErrorCode -> Int -> ReasonPhrase -> HTTP2Error
ConnectionErrorIsReceived ErrorCode
err Int
sid ReasonPhrase
"Connection was reset"
ResetByMe SomeException
err -> SomeException -> HTTP2Error
BadThingHappen SomeException
err
data StreamState
= Idle
| Open (Maybe ClosedCode) OpenState
| 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 -> Int
streamNumber :: StreamId
, Stream -> IORef StreamState
streamState :: IORef StreamState
, Stream -> MVar (Either SomeException InpObj)
streamInput :: MVar (Either SomeException InpObj)
, Stream -> TVar TxFlow
streamTxFlow :: TVar TxFlow
, Stream -> IORef RxFlow
streamRxFlow :: IORef RxFlow
}
instance Show Stream where
show :: Stream -> String
show Stream{Int
TVar TxFlow
IORef RxFlow
IORef StreamState
MVar (Either SomeException InpObj)
streamRxFlow :: IORef RxFlow
streamTxFlow :: TVar TxFlow
streamInput :: MVar (Either SomeException InpObj)
streamState :: IORef StreamState
streamNumber :: Int
streamRxFlow :: Stream -> IORef RxFlow
streamTxFlow :: Stream -> TVar TxFlow
streamInput :: Stream -> MVar (Either SomeException InpObj)
streamState :: Stream -> IORef StreamState
streamNumber :: Stream -> Int
..} =
String
"Stream{id="
String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
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
{ 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
| ONext DynaNext TrailersMaker
type DynaNext = Buffer -> BufferSize -> WindowSize -> IO Next
type BytesFilled = Int
data Next
= Next
BytesFilled
Bool
(Maybe DynaNext)
data Control
= CFinish HTTP2Error
| CFrames (Maybe SettingsList) [ByteString]
| CGoaway ByteString (MVar ())
data StreamingChunk
= StreamingFinished (IO ())
| StreamingFlush
| StreamingBuilder Builder
type ReasonPhrase = ShortByteString
data HTTP2Error
= ConnectionIsClosed
| ConnectionIsTimeout
| ConnectionErrorIsReceived ErrorCode StreamId ReasonPhrase
| ConnectionErrorIsSent ErrorCode StreamId ReasonPhrase
| StreamErrorIsReceived ErrorCode StreamId
| StreamErrorIsSent ErrorCode StreamId ReasonPhrase
| BadThingHappen E.SomeException
| GoAwayIsSent
deriving (Int -> HTTP2Error -> ShowS
[HTTP2Error] -> ShowS
HTTP2Error -> String
(Int -> HTTP2Error -> ShowS)
-> (HTTP2Error -> String)
-> ([HTTP2Error] -> ShowS)
-> Show HTTP2Error
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HTTP2Error] -> ShowS
$cshowList :: [HTTP2Error] -> ShowS
show :: HTTP2Error -> String
$cshow :: HTTP2Error -> String
showsPrec :: Int -> HTTP2Error -> ShowS
$cshowsPrec :: Int -> HTTP2Error -> ShowS
Show, Typeable)
instance E.Exception HTTP2Error
checkSettingsList :: SettingsList -> Maybe HTTP2Error
checkSettingsList :: SettingsList -> Maybe HTTP2Error
checkSettingsList SettingsList
settings = case ((SettingsKey, Int) -> Maybe HTTP2Error)
-> SettingsList -> [HTTP2Error]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (SettingsKey, Int) -> 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, Int) -> Maybe HTTP2Error
checkSettingsValue (SettingsKey
SettingsEnablePush, Int
v)
| Int
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 Bool -> Bool -> Bool
&& Int
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1 =
HTTP2Error -> Maybe HTTP2Error
forall a. a -> Maybe a
Just (HTTP2Error -> Maybe HTTP2Error) -> HTTP2Error -> Maybe HTTP2Error
forall a b. (a -> b) -> a -> b
$ ErrorCode -> Int -> ReasonPhrase -> HTTP2Error
ConnectionErrorIsSent ErrorCode
ProtocolError Int
0 ReasonPhrase
"enable push must be 0 or 1"
checkSettingsValue (SettingsKey
SettingsInitialWindowSize, Int
v)
| Int
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxWindowSize =
HTTP2Error -> Maybe HTTP2Error
forall a. a -> Maybe a
Just (HTTP2Error -> Maybe HTTP2Error) -> HTTP2Error -> Maybe HTTP2Error
forall a b. (a -> b) -> a -> b
$
ErrorCode -> Int -> ReasonPhrase -> HTTP2Error
ConnectionErrorIsSent
ErrorCode
FlowControlError
Int
0
ReasonPhrase
"Window size must be less than or equal to 65535"
checkSettingsValue (SettingsKey
SettingsMaxFrameSize, Int
v)
| Int
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
defaultPayloadLength Bool -> Bool -> Bool
|| Int
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxPayloadLength =
HTTP2Error -> Maybe HTTP2Error
forall a. a -> Maybe a
Just (HTTP2Error -> Maybe HTTP2Error) -> HTTP2Error -> Maybe HTTP2Error
forall a b. (a -> b) -> a -> b
$
ErrorCode -> Int -> ReasonPhrase -> HTTP2Error
ConnectionErrorIsSent
ErrorCode
ProtocolError
Int
0
ReasonPhrase
"Max frame size must be in between 16384 and 16777215"
checkSettingsValue (SettingsKey, Int)
_ = Maybe HTTP2Error
forall a. Maybe a
Nothing
data Config = Config
{ Config -> Buffer
confWriteBuffer :: Buffer
, Config -> Int
confBufferSize :: BufferSize
, Config -> ByteString -> IO ()
confSendAll :: ByteString -> IO ()
, Config -> Int -> InpBody
confReadN :: Int -> IO ByteString
, Config -> PositionReadMaker
confPositionReadMaker :: PositionReadMaker
, Config -> Manager
confTimeoutManager :: T.Manager
, Config -> SockAddr
confMySockAddr :: SockAddr
, Config -> SockAddr
confPeerSockAddr :: SockAddr
}