+-- #hide
module Network.HTTP.Lucu.Interaction
( Interaction(..)
, InteractionState(..)
, InteractionQueue
- , newInteractionQueue -- IO InteractionQueue
- , newInteraction -- Config -> HostName -> Maybe Request -> IO Interaction
-
- , writeItr -- Interaction -> (Interaction -> TVar a) -> a -> STM ()
- , readItr -- Interaction -> (Interaction -> TVar a) -> (a -> b) -> STM b
- , readItrF -- (Functor f) => Interaction -> (Interaction -> TVar (f a)) -> (a -> b) -> STM (f b)
- , updateItr -- Interaction -> (Interaction -> TVar a) -> (a -> a) -> STM ()
- , updateItrF -- (Functor f) => Interaction -> (Interaction -> TVar (f a)) -> (a -> a) -> STM ()
+ , newInteractionQueue
+ , newInteraction
+ , defaultPageContentType
+
+ , writeItr
+ , readItr
+ , readItrF
+ , updateItr
+ , updateItrF
)
where
import Data.ByteString.Lazy.Char8 (ByteString)
import qualified Data.Sequence as S
import Data.Sequence (Seq)
-import Network
+import Network.Socket
import Network.HTTP.Lucu.Config
+import Network.HTTP.Lucu.HttpVersion
import Network.HTTP.Lucu.Request
import Network.HTTP.Lucu.Response
data Interaction = Interaction {
itrConfig :: Config
- , itrRemoteHost :: HostName
+ , itrRemoteAddr :: SockAddr
, itrResourcePath :: Maybe [String]
- , itrRequest :: Maybe Request
- , itrResponse :: TVar (Maybe Response)
+ , itrRequest :: TVar (Maybe Request)
+ , itrResponse :: TVar Response
-- FIXME: この三つは本來 TVar であるべきでないので、唯の Bool にす
-- るに越した事は無いが、それは重要でない。そんな golf で自分の貴重
newInteractionQueue = newTVarIO S.empty
-newInteraction :: Config -> HostName -> Maybe Request -> IO Interaction
-newInteraction conf host req
- = do responce <- newTVarIO Nothing
+defaultPageContentType :: String
+defaultPageContentType = "application/xhtml+xml"
+
+
+newInteraction :: Config -> SockAddr -> Maybe Request -> IO Interaction
+newInteraction conf addr req
+ = do request <- newTVarIO $ req
+ responce <- newTVarIO $ Response {
+ resVersion = HttpVersion 1 1
+ , resStatus = Ok
+ , resHeaders = [("Content-Type", defaultPageContentType)]
+ }
requestHasBody <- newTVarIO False
requestIsChunked <- newTVarIO False
return $ Interaction {
itrConfig = conf
- , itrRemoteHost = host
+ , itrRemoteAddr = addr
, itrResourcePath = Nothing
- , itrRequest = req
+ , itrRequest = request
, itrResponse = responce
, itrRequestHasBody = requestHasBody