+{-# LANGUAGE
+ BangPatterns
+ , UnicodeSyntax
+ #-}
module Network.HTTP.Lucu.Interaction
( Interaction(..)
, InteractionState(..)
where
import Control.Concurrent.STM
-import Data.ByteString.Base (ByteString, LazyByteString)
-import Data.ByteString.Char8 as C8
-import qualified Data.ByteString.Lazy.Char8 as L8
+import qualified Data.ByteString as Strict (ByteString)
+import qualified Data.ByteString.Lazy as Lazy (ByteString)
+import Data.ByteString.Char8 as C8 hiding (ByteString)
+import qualified Data.ByteString.Lazy.Char8 as L8 hiding (ByteString)
import qualified Data.Sequence as S
import Data.Sequence (Seq)
import Network.Socket
import Network.HTTP.Lucu.HttpVersion
import Network.HTTP.Lucu.Request
import Network.HTTP.Lucu.Response
+import OpenSSL.X509
data Interaction = Interaction {
itrConfig :: !Config
+ , itrLocalPort :: !PortNumber
, itrRemoteAddr :: !SockAddr
+ , itrRemoteCert :: !(Maybe X509)
, itrResourcePath :: !(Maybe [String])
- , itrRequest :: !(TVar (Maybe Request))
+ , itrRequest :: !(TVar (Maybe Request)) -- FIXME: TVar である必要無し
, itrResponse :: !(TVar Response)
- , itrRequestHasBody :: !(TVar Bool)
- , itrRequestIsChunked :: !(TVar Bool)
- , itrExpectedContinue :: !(TVar Bool)
+ , itrRequestHasBody :: !(TVar Bool) -- FIXME: TVar である必要無し
+ , itrRequestIsChunked :: !(TVar Bool) -- FIXME: TVar である必要無し
+ , itrExpectedContinue :: !(TVar Bool) -- FIXME: TVar である必要無し
, itrReqChunkLength :: !(TVar (Maybe Int))
, itrReqChunkRemaining :: !(TVar (Maybe Int))
, itrReqChunkIsOver :: !(TVar Bool)
, itrReqBodyWanted :: !(TVar (Maybe Int))
, itrReqBodyWasteAll :: !(TVar Bool)
- , itrReceivedBody :: !(TVar LazyByteString) -- Resource が受領した部分は削除される
+ , itrReceivedBody :: !(TVar Lazy.ByteString) -- Resource が受領した部分は削除される
, itrWillReceiveBody :: !(TVar Bool)
, itrWillChunkBody :: !(TVar Bool)
, itrWillDiscardBody :: !(TVar Bool)
, itrWillClose :: !(TVar Bool)
- , itrBodyToSend :: !(TVar LazyByteString)
+ , itrBodyToSend :: !(TVar Lazy.ByteString)
, itrBodyIsNull :: !(TVar Bool)
, itrState :: !(TVar InteractionState)
newInteractionQueue = newTVarIO S.empty
-defaultPageContentType :: ByteString
+defaultPageContentType :: Strict.ByteString
defaultPageContentType = C8.pack "application/xhtml+xml"
-newInteraction :: Config -> SockAddr -> Maybe Request -> IO Interaction
-newInteraction conf addr req
- = conf `seq` addr `seq` req `seq`
- do request <- newTVarIO $ req
- responce <- newTVarIO $ Response {
+newInteraction :: Config -> PortNumber -> SockAddr -> Maybe X509 -> Maybe Request -> IO Interaction
+newInteraction !conf !port !addr !cert !req
+ = do request <- newTVarIO req
+ responce <- newTVarIO Response {
resVersion = HttpVersion 1 1
, resStatus = Ok
, resHeaders = toHeaders [(C8.pack "Content-Type", defaultPageContentType)]
wroteContinue <- newTVarIO False
wroteHeader <- newTVarIO False
- return $ Interaction {
+ return Interaction {
itrConfig = conf
+ , itrLocalPort = port
, itrRemoteAddr = addr
+ , itrRemoteCert = cert
, itrResourcePath = Nothing
, itrRequest = request
, itrResponse = responce
writeItr :: Interaction -> (Interaction -> TVar a) -> a -> STM ()
-writeItr itr accessor value
- = itr `seq` accessor `seq` value `seq`
- writeTVar (accessor itr) value
+writeItr !itr !accessor !value
+ = writeTVar (accessor itr) value
readItr :: Interaction -> (Interaction -> TVar a) -> (a -> b) -> STM b
-readItr itr accessor reader
- = itr `seq` accessor `seq` reader `seq`
- readTVar (accessor itr) >>= return . reader
+readItr !itr !accessor !reader
+ = fmap reader $ readTVar (accessor itr)
readItrF :: Functor f => Interaction -> (Interaction -> TVar (f a)) -> (a -> b) -> STM (f b)
-readItrF itr accessor reader
- = itr `seq` accessor `seq` reader `seq`
- readItr itr accessor (fmap reader)
+readItrF !itr !accessor !reader
+ = readItr itr accessor (fmap reader)
{-# SPECIALIZE readItrF :: Interaction -> (Interaction -> TVar (Maybe a)) -> (a -> b) -> STM (Maybe b) #-}
updateItr :: Interaction -> (Interaction -> TVar a) -> (a -> a) -> STM ()
-updateItr itr accessor updator
- = itr `seq` accessor `seq` updator `seq`
- do old <- readItr itr accessor id
+updateItr !itr !accessor !updator
+ = do old <- readItr itr accessor id
writeItr itr accessor (updator old)
updateItrF :: Functor f => Interaction -> (Interaction -> TVar (f a)) -> (a -> a) -> STM ()
-updateItrF itr accessor updator
- = itr `seq` accessor `seq` updator `seq`
- updateItr itr accessor (fmap updator)
+updateItrF !itr !accessor !updator
+ = updateItr itr accessor (fmap updator)
{-# SPECIALIZE updateItrF :: Interaction -> (Interaction -> TVar (Maybe a)) -> (a -> a) -> STM () #-}
\ No newline at end of file