-- 4. The 'Resource' Monad and its thread stops running. The client
-- may or may not be sending us the next request at this point.
--
--- 'Resource' Monad is composed of the following states. The initial
--- state is /Examining Request/ and the final state is /Done/.
+-- 'Resource' Monad takes the following states. The initial state is
+-- /Examining Request/ and the final state is /Done/.
--
-- [/Examining Request/] In this state, a 'Resource' looks at the
-- request header and thinks about an entity for it. If there is a
-- and just throws it away.
--
-- [/Deciding Header/] A 'Resource' makes a decision of status code
--- and response headers. When it transits to the next state, ...
+-- and response header. When it transits to the next state, the
+-- system checks the validness of response header and then write
+-- them to the socket.
--
--- [/Deciding Body/]
+-- [/Deciding Body/] In this state, a 'Resource' asks the system to
+-- write some response body to the socket. When it transits to the
+-- next state without writing any response body, the system
+-- completes it depending on the status code.
--
--- [/Done/]
+-- [/Done/] Everything is over. A 'Resource' can do nothing for the
+-- HTTP interaction anymore.
+--
+-- Note that the state transition is one-way: for instance, it is an
+-- error to try to read a request body after writing some
+-- response. This limitation is for efficiency. We don't want to read
+-- the entire request before starting 'Resource', nor we don't want to
+-- postpone writing the entire response till the end of 'Resource'
+-- computation.
+module Network.HTTP.Lucu.Resource
+ (
+ -- * Monad
+ Resource
--- 一方通行であること、その理由
+ -- * Actions
--- FIXME: 續きを書く
-
-module Network.HTTP.Lucu.Resource
- ( Resource
+ -- ** Getting request header
+ -- |These actions can be computed regardless of the current state,
+ -- and they don't change the state.
, getConfig
, getRequest
, getMethod
, getAccept
, getContentType
+ -- ** Finding an entity
+
+ -- |These actions can be computed only in the /Examining Request/
+ -- state. After the computation, the 'Resource' transits to
+ -- /Getting Body/ state.
, foundEntity
, foundETag
, foundTimeStamp
, foundNoEntity
+ -- ** Getting a request body
+
+ -- |Computation of these actions changes the state to /Getting
+ -- Body/.
, input
, inputChunk
, inputBS
, inputForm
, defaultLimit
+ -- ** Setting response headers
+
+ -- |Computation of these actions changes the state to /Deciding
+ -- Header/.
, setStatus
, setHeader
, redirect
, setLastModified
, setContentType
+ -- ** Writing a response body
+
+ -- |Computation of these actions changes the state to /Deciding
+ -- Body/.
, output
, outputChunk
, outputBS
import Network.URI
import System.Time
-
+-- |The 'Resource' monad. /Interaction/ is an internal state thus it
+-- is not exposed to users. This monad implements 'MonadIO' so it can
+-- do any IO actions.
type Resource a = ReaderT Interaction IO a
-
+-- |Get the 'Network.HTTP.Lucu.Config.Config' value which is used for
+-- the httpd.
getConfig :: Resource Config
getConfig = do itr <- ask
return $ itrConfig itr
-
+-- |Get the 'Network.HTTP.Lucu.Request.Request' value which represents
+-- the request header. In general you don't have to use this action.
getRequest :: Resource Request
getRequest = do itr <- ask
return $ fromJust $ itrRequest itr
-
+-- |Get the 'Network.HTTP.Lucu.Request.Method' value of the request.
getMethod :: Resource Method
getMethod = do req <- getRequest
return $ reqMethod req
-
+-- |Get the URI of the request.
getRequestURI :: Resource URI
getRequestURI = do req <- getRequest
return $ reqURI req
-
+-- |Get the path of this 'Resource' (to be exact,
+-- 'Network.HTTP.Lucu.Resource.Tree.ResourceDef') in the
+-- 'Network.HTTP.Lucu.Resource.Tree.ResTree'. The result of this
+-- action is the exact path in the tree even if the
+-- 'Network.HTTP.Lucu.Resource.Tree.ResourceDef' is greedy.
+--
+-- Example:
+--
+-- > main = let tree = mkResTree [ (["foo"], resFoo) ]
+-- > in runHttpd defaultConfig tree
+-- >
+-- > resFoo = ResourceDef {
+-- > resIsGreedy = True
+-- > , resGet = Just $ do requestURI <- getRequestURI
+-- > resourcePath <- getResourcePath
+-- > pathInfo <- getPathInfo
+-- > -- uriPath requestURI == "/foo/bar/baz"
+-- > -- resourcePath == ["foo"]
+-- > -- pathInfo == ["bar", "baz"]
+-- > ...
+-- > , ...
+-- > }
getResourcePath :: Resource [String]
getResourcePath = do itr <- ask
return $ fromJust $ itrResourcePath itr
+-- |This is an analogy of CGI PATH_INFO. Its result is always @[]@ if
+-- the 'Network.HTTP.Lucu.Resource.Tree.ResourceDef' is not
+-- greedy. See 'getResourcePath'.
getPathInfo :: Resource [String]
getPathInfo = do rsrcPath <- getResourcePath
reqURI <- getRequestURI
-- rsrcPath の長さの分だけ削除すれば良い。
return $ drop (length rsrcPath) reqPath
-
+-- |Get a value of given request header. Comparison of header name is
+-- case-insensitive. Note that this action is not intended to be used
+-- so frequently: there should be an action like 'getContentType' for
+-- every common headers.
getHeader :: String -> Resource (Maybe String)
getHeader name = do itr <- ask
return $ H.getHeader name $ fromJust $ itrRequest itr
-
+-- |Get a list of 'Network.HTTP.Lucu.MIMEType.MIMEType' enumerated on
+-- header \"Accept\".
getAccept :: Resource [MIMEType]
getAccept = do accept <- getHeader "Accept"
if accept == Nothing then
(Success xs, _) -> return xs
_ -> return []
-
+-- |Get the header \"Content-Type\" as
+-- 'Network.HTTP.Lucu.MIMEType.MIMEType'.
getContentType :: Resource (Maybe MIMEType)
getContentType = do cType <- getHeader "Content-Type"
if cType == Nothing then
projects / Lucu.git / commitdiff