6 module Network.HTTP.Lucu.Interaction
10 , ReceiveBodyRequest(..)
17 import Blaze.ByteString.Builder (Builder)
18 import Control.Concurrent.STM
19 import qualified Data.ByteString as Strict
20 import Data.Monoid.Unicode
21 import Data.Sequence (Seq)
22 import qualified Data.Sequence as S
24 import Network.HTTP.Lucu.Config
25 import Network.HTTP.Lucu.HttpVersion
26 import Network.HTTP.Lucu.Preprocess
27 import Network.HTTP.Lucu.Request
28 import Network.HTTP.Lucu.Response
31 data Interaction = Interaction {
33 , itrLocalPort ∷ !PortNumber
34 , itrRemoteAddr ∷ !SockAddr
35 , itrRemoteCert ∷ !(Maybe X509)
36 , itrResourcePath ∷ !(Maybe [Strict.ByteString])
37 , itrRequest ∷ !(Maybe Request)
39 , itrExpectedContinue ∷ !(Maybe Bool)
40 , itrReqBodyLength ∷ !(Maybe RequestBodyLength)
42 , itrReceiveBodyReq ∷ !(TMVar ReceiveBodyRequest)
43 , itrReceivedBody ∷ !(TMVar Strict.ByteString)
45 , itrResponse ∷ !(TVar Response)
46 , itrWillChunkBody ∷ !(TVar Bool)
47 , itrWillDiscardBody ∷ !(TVar Bool)
48 , itrWillClose ∷ !(TVar Bool)
49 , itrResponseHasCType ∷ !(TVar Bool)
50 , itrBodyToSend ∷ !(TMVar Builder)
52 , itrState ∷ !(TVar InteractionState)
55 -- |The interaction state of Resource monad. 'ExaminingRequest' is the
63 deriving (Show, Eq, Ord, Enum)
65 type InteractionQueue = TVar (Seq Interaction)
67 data ReceiveBodyRequest
68 = ReceiveBody !Int -- ^ Maximum number of octets to receive.
72 newInteractionQueue ∷ IO InteractionQueue
73 newInteractionQueue = newTVarIO S.empty
75 newInteraction ∷ Config
79 → Either StatusCode Request
81 newInteraction conf@(Config {..}) port addr cert request
82 = do let ar = preprocess cnfServerHost port request
84 resVersion = HttpVersion 1 1
85 , resStatus = arInitialStatus ar
89 receiveBodyReq ← newEmptyTMVarIO
90 receivedBody ← newEmptyTMVarIO
92 response ← newTVarIO res
93 willChunkBody ← newTVarIO False
94 willDiscardBody ← newTVarIO (arWillDiscardBody ar)
95 willClose ← newTVarIO (arWillClose ar)
96 bodyToSend ← newEmptyTMVarIO
97 responseHasCType ← newTVarIO False
99 state ← newTVarIO ExaminingRequest
103 , itrLocalPort = port
104 , itrRemoteAddr = addr
105 , itrRemoteCert = cert
106 , itrResourcePath = Nothing
107 , itrRequest = arRequest ar
109 , itrExpectedContinue = arExpectedContinue ar
110 , itrReqBodyLength = arReqBodyLength ar
112 , itrReceiveBodyReq = receiveBodyReq
113 , itrReceivedBody = receivedBody
115 , itrResponse = response
116 , itrWillChunkBody = willChunkBody
117 , itrWillDiscardBody = willDiscardBody
118 , itrWillClose = willClose
119 , itrResponseHasCType = responseHasCType
120 , itrBodyToSend = bodyToSend
125 setResponseStatus ∷ Interaction → StatusCode → STM ()
126 setResponseStatus (Interaction {..}) sc
127 = do res ← readTVar itrResponse
131 writeTVar itrResponse res'