1{-# LANGUAGE OverloadedStrings #-} 2 3module Network.HTTP2.Arch.Types where 4 5import Control.Concurrent 6import Control.Concurrent.STM 7import Control.Exception (SomeException) 8import Data.ByteString.Builder (Builder) 9import Data.IORef 10import Data.IntMap.Strict (IntMap) 11import qualified Network.HTTP.Types as H 12 13import Imports 14import Network.HPACK 15import Network.HTTP2.Arch.File 16import Network.HTTP2.Frame 17 18---------------------------------------------------------------- 19 20-- | "http" or "https". 21type Scheme = ByteString 22 23-- | For so-called "Host:" header. 24type Authority = ByteString 25 26-- | Path. 27type Path = ByteString 28 29---------------------------------------------------------------- 30 31type InpBody = IO ByteString 32 33data OutBody = OutBodyNone 34 -- | Streaming body takes a write action and a flush action. 35 | OutBodyStreaming ((Builder -> IO ()) -> IO () -> IO ()) 36 | OutBodyBuilder Builder 37 | OutBodyFile FileSpec 38 39-- | Input object 40data InpObj = InpObj { 41 inpObjHeaders :: HeaderTable -- ^ Accessor for headers. 42 , inpObjBodySize :: Maybe Int -- ^ Accessor for body length specified in content-length:. 43 , inpObjBody :: InpBody -- ^ Accessor for body. 44 , inpObjTrailers :: IORef (Maybe HeaderTable) -- ^ Accessor for trailers. 45 } 46 47instance Show InpObj where 48 show (InpObj (thl,_) _ _body _tref) = show thl 49 50-- | Output object 51data OutObj = OutObj { 52 outObjHeaders :: [H.Header] -- ^ Accessor for header. 53 , outObjBody :: OutBody -- ^ Accessor for outObj body. 54 , outObjTrailers :: TrailersMaker -- ^ Accessor for trailers maker. 55 } 56 57instance Show OutObj where 58 show (OutObj hdr _ _) = show hdr 59 60-- | Trailers maker. A chunks of the response body is passed 61-- with 'Just'. The maker should update internal state 62-- with the 'ByteString' and return the next trailers maker. 63-- When response body reaches its end, 64-- 'Nothing' is passed and the maker should generate 65-- trailers. An example: 66-- 67-- > {-# LANGUAGE BangPatterns #-} 68-- > import Data.ByteString (ByteString) 69-- > import qualified Data.ByteString.Char8 as C8 70-- > import Crypto.Hash (Context, SHA1) -- cryptonite 71-- > import qualified Crypto.Hash as CH 72-- > 73-- > -- Strictness is important for Context. 74-- > trailersMaker :: Context SHA1 -> Maybe ByteString -> IO NextTrailersMaker 75-- > trailersMaker ctx Nothing = return $ Trailers [("X-SHA1", sha1)] 76-- > where 77-- > !sha1 = C8.pack $ show $ CH.hashFinalize ctx 78-- > trailersMaker ctx (Just bs) = return $ NextTrailersMaker $ trailersMaker ctx' 79-- > where 80-- > !ctx' = CH.hashUpdate ctx bs 81-- 82-- Usage example: 83-- 84-- > let h2rsp = responseFile ... 85-- > maker = trailersMaker (CH.hashInit :: Context SHA1) 86-- > h2rsp' = setResponseTrailersMaker h2rsp maker 87-- 88type TrailersMaker = Maybe ByteString -> IO NextTrailersMaker 89 90-- | TrailersMake to create no trailers. 91defaultTrailersMaker :: TrailersMaker 92defaultTrailersMaker Nothing = return $ Trailers [] 93defaultTrailersMaker _ = return $ NextTrailersMaker defaultTrailersMaker 94 95-- | Either the next trailers maker or final trailers. 96data NextTrailersMaker = NextTrailersMaker TrailersMaker 97 | Trailers [H.Header] 98 99---------------------------------------------------------------- 100 101-- | File specification. 102data FileSpec = FileSpec FilePath FileOffset ByteCount deriving (Eq, Show) 103 104---------------------------------------------------------------- 105 106data OpenState = 107 JustOpened 108 | Continued [HeaderBlockFragment] 109 Int -- Total size 110 Int -- The number of continuation frames 111 Bool -- End of stream 112 | NoBody HeaderTable 113 | HasBody HeaderTable 114 | Body (TQueue ByteString) 115 (Maybe Int) -- received Content-Length 116 -- compared the body length for error checking 117 (IORef Int) -- actual body length 118 (IORef (Maybe HeaderTable)) -- trailers 119 120data ClosedCode = Finished 121 | Killed 122 | Reset ErrorCodeId 123 | ResetByMe SomeException 124 deriving Show 125 126---------------------------------------------------------------- 127 128data StreamState = 129 Idle 130 | Open OpenState 131 | HalfClosedRemote 132 | HalfClosedLocal ClosedCode 133 | Closed ClosedCode 134 | Reserved 135 136instance Show StreamState where 137 show Idle = "Idle" 138 show Open{} = "Open" 139 show HalfClosedRemote = "HalfClosedRemote" 140 show (HalfClosedLocal e) = "HalfClosedLocal: " ++ show e 141 show (Closed e) = "Closed: " ++ show e 142 show Reserved = "Reserved" 143 144---------------------------------------------------------------- 145 146data Stream = Stream { 147 streamNumber :: StreamId 148 , streamState :: IORef StreamState 149 , streamWindow :: TVar WindowSize 150 , streamInput :: MVar InpObj -- Client only 151 } 152 153instance Show Stream where 154 show s = show (streamNumber s) 155 156---------------------------------------------------------------- 157 158newtype StreamTable = StreamTable (IORef (IntMap Stream)) 159 160---------------------------------------------------------------- 161 162data Input a = Input a InpObj 163 164data Output a = Output { 165 outputStream :: a 166 , outputObject :: OutObj 167 , outputType :: OutputType 168 , outputStrmQ :: Maybe (TBQueue StreamingChunk) 169 , outputSentinel :: IO () 170 } 171 172data OutputType = OObj 173 | OWait (IO ()) 174 | OPush TokenHeaderList StreamId -- associated stream id from client 175 | ONext DynaNext TrailersMaker 176 177---------------------------------------------------------------- 178 179type DynaNext = Buffer -> BufferSize -> WindowSize -> IO Next 180 181type BytesFilled = Int 182 183data Next = Next BytesFilled (Maybe DynaNext) 184 185---------------------------------------------------------------- 186 187data Control = CFinish 188 | CGoaway ByteString 189 | CFrame ByteString 190 | CSettings ByteString SettingsList 191 | CSettings0 ByteString ByteString SettingsList 192 193---------------------------------------------------------------- 194 195data StreamingChunk = StreamingFinished 196 | StreamingFlush 197 | StreamingBuilder Builder 198