, UnicodeSyntax
#-}
-- |This is the Resource Monad; monadic actions to define a behavior
--- of resource. The 'Resource' Monad is a kind of 'IO' Monad thus it
+-- of resource. The 'Rsrc' Monad is a kind of 'IO' Monad thus it
-- implements 'MonadIO' class, and it is a state machine as well.
--
-- Request Processing Flow:
-- 1. A client issues an HTTP request.
--
-- 2. If the URI of it matches to any resource, the corresponding
--- 'Resource' Monad starts running on a newly spawned thread.
+-- 'Rsrc' Monad starts running on a newly spawned thread.
--
--- 3. The 'Resource' Monad looks at request headers, find (or not
--- find) an entity, receive the request body (if any), send
--- response headers, and then send a response body. This process
--- will be discussed later.
+-- 3. The 'Rsrc' Monad looks at request headers, find (or not find)
+-- an entity, receive the request body (if any), send response
+-- headers, and then send a response body. This process will be
+-- discussed later.
--
--- 4. The 'Resource' Monad and its thread stops running. The client
--- may or may not be sending us the next request at this point.
+-- 4. The 'Rsrc' Monad and its thread stops running. The client may
+-- or may not be sending us the next request at this point.
--
--- 'Resource' Monad takes the following states. The initial state is
+-- 'Rsrc' 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
+-- [/Examining Request/] In this state, a 'Rsrc' looks at the
-- request header fields and thinks about the corresponding entity
--- for it. If there is a suitable entity, the 'Resource' tells the
+-- for it. If there is a suitable entity, the 'Rsrc' tells the
-- system an entity tag and its last modification time
-- ('foundEntity'). If it found no entity, it tells the system so
-- ('foundNoEntity'). In case it is impossible to decide the
-- existence of entity, which is a typical case for POST requests,
--- 'Resource' does nothing in this state.
+-- 'Rsrc' does nothing in this state.
--
--- [/Receiving Body/] A 'Resource' asks the system to receive a
--- request body from the client. Before actually reading from the
--- socket, the system sends \"100 Continue\" to the client if need
--- be. When a 'Resource' transits to the next state without
--- receiving all or part of a request body, the system automatically
--- discards it.
+-- [/Receiving Body/] A 'Rsrc' asks the system to receive a request
+-- body from the client. Before actually reading from the socket,
+-- the system sends \"100 Continue\" to the client if need be. When
+-- a 'Rsrc' transits to the next state without receiving all or part
+-- of a request body, the system automatically discards it.
--
--- [/Deciding Header/] A 'Resource' makes a decision of response
--- status code and header fields. When it transits to the next
--- state, the system validates and completes the header fields and
--- then sends them to the client.
+-- [/Deciding Header/] A 'Rsrc' makes a decision of response status
+-- code and header fields. When it transits to the next state, the
+-- system validates and completes the header fields and then sends
+-- them to the client.
--
--- [/Sending 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
--- automatically completes it depending on the status code. (To be
--- exact, such completion only occurs when the 'Resource' transits
--- to this state without even declaring the \"Content-Type\" header
--- field. See: 'setContentType')
+-- [/Sending Body/] In this state, a 'Rsrc' 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 automatically
+-- completes it depending on the status code. (To be exact, such
+-- completion only occurs when the 'Rsrc' transits to this state
+-- without even declaring the \"Content-Type\" header field. See:
+-- 'setContentType')
--
--- [/Done/] Everything is over. A 'Resource' can do nothing for the
--- HTTP interaction anymore.
+-- [/Done/] Everything is over. A 'Rsrc' 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'
+-- the entire request before starting 'Rsrc', nor we don't want to
+-- postpone writing the entire response till the end of 'Rsrc'
-- computation.
module Network.HTTP.Lucu.Resource
(
-- * Types
- Resource
- , ResourceDef(..)
- , emptyResource
+ Resource(..)
+ , Rsrc
, FormData(..)
-- * Getting request header
-- |These functions can be called regardless of the current state,
- -- and they don't change the state of 'Resource'.
+ -- and they don't change the state of 'Rsrc'.
, getConfig
, getRemoteAddr
, getRemoteAddr'
-- * Finding an entity
-- |These functions can be called only in the /Examining Request/
- -- state. They make the 'Resource' transit to the /Receiving Body/
+ -- state. They make the 'Rsrc' transit to the /Receiving Body/
-- state.
, foundEntity
, foundETag
, foundNoEntity'
-- * Receiving a request body
- -- |These functions make the 'Resource' transit to the /Receiving
+ -- |These functions make the 'Rsrc' transit to the /Receiving
-- Body/ state.
, getChunk
, getChunks
-- * Sending a response body
- -- |These functions make the 'Resource' transit to the
- -- /Sending Body/ state.
+ -- |These functions make the 'Rsrc' transit to the /Sending Body/
+ -- state.
, putChunk
, putChunks
, putBuilder
import Control.Monad.Unicode
import Data.Ascii (Ascii, CIAscii)
import qualified Data.Ascii as A
+import Data.Attempt
import qualified Data.Attoparsec.Char8 as P
import Data.ByteString (ByteString)
import qualified Data.ByteString as Strict
import qualified Data.ByteString.Lazy as Lazy
import Data.Collections
+import Data.Convertible.Base
+import Data.Convertible.Instances.Text ()
+import Data.Convertible.Utils
import Data.List (intersperse, sort)
import Data.Maybe
import Data.Monoid
import Data.Monoid.Unicode
+import Data.Proxy
+import Data.Tagged
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time
-import qualified Data.Time.HTTP as HTTP
+import Data.Time.Format.HTTP
import Network.HTTP.Lucu.Abortion
import Network.HTTP.Lucu.Authentication
import Network.HTTP.Lucu.Config
-- |Get the string representation of the address of remote host. If
-- you want a 'SockAddr' instead of 'HostName', use 'getRemoteAddr'.
-getRemoteAddr' ∷ Resource HostName
+getRemoteAddr' ∷ Rsrc HostName
getRemoteAddr' = liftIO ∘ toNM =≪ getRemoteAddr
where
toNM ∷ SockAddr → IO HostName
toNM = (fromJust ∘ fst <$>) ∘ getNameInfo [NI_NUMERICHOST] True False
-- |Resolve an address to the remote host.
-getRemoteHost ∷ Resource (Maybe HostName)
+getRemoteHost ∷ Rsrc (Maybe HostName)
getRemoteHost = liftIO ∘ getHN =≪ getRemoteAddr
where
getHN ∷ SockAddr → IO (Maybe HostName)
getHN = (fst <$>) ∘ getNameInfo [] True False
-- |Get the 'Method' value of the request.
-getMethod ∷ Resource Method
+getMethod ∷ Rsrc Method
getMethod = reqMethod <$> getRequest
-- |Get the URI of the request.
-getRequestURI ∷ Resource URI
+getRequestURI ∷ Rsrc URI
getRequestURI = reqURI <$> getRequest
-- |Get the HTTP version of the request.
-getRequestVersion ∷ Resource HttpVersion
+getRequestVersion ∷ Rsrc HttpVersion
getRequestVersion = reqVersion <$> getRequest
-- |This is an analogy of CGI PATH_INFO. 'getPathInfo' always returns
--- @[]@ if the corresponding
--- 'Network.HTTP.Lucu.Resource.Tree.ResourceDef' is not greedy. See:
--- 'getResourcePath'
+-- @[]@ if the corresponding 'Resource' is not greedy. See
+-- 'getResourcePath'.
--
-- Note that the returned path components are URI-decoded.
-getPathInfo ∷ Resource [Strict.ByteString]
+getPathInfo ∷ Rsrc [Strict.ByteString]
getPathInfo = do rsrcPath ← getResourcePath
- reqPath ← splitPathInfo <$> getRequestURI
+ reqPath ← uriPathSegments <$> getRequestURI
return $ drop (length rsrcPath) reqPath
-- |Assume the query part of request URI as
-- application\/x-www-form-urlencoded, and parse it into pairs of
-- @(name, formData)@. This function doesn't read the request
-- body.
-getQueryForm ∷ Resource [(Strict.ByteString, FormData)]
+getQueryForm ∷ Rsrc [(Strict.ByteString, FormData)]
getQueryForm = parse' <$> getRequestURI
where
parse' = map toPairWithFormData ∘
parseWWWFormURLEncoded ∘
- fromJust ∘
- A.fromChars ∘
+ convertUnsafe ∘
drop 1 ∘
uriQuery
-- @name@. Comparison of header name is case-insensitive. Note that
-- this function is not intended to be used so frequently: there
-- should be functions like 'getContentType' for every common headers.
-getHeader ∷ CIAscii → Resource (Maybe Ascii)
+getHeader ∷ CIAscii → Rsrc (Maybe Ascii)
getHeader name
= H.getHeader name <$> getRequest
-- |Return the list of 'MIMEType' enumerated on the value of request
-- header \"Accept\", or @[]@ if absent.
-getAccept ∷ Resource [MIMEType]
+getAccept ∷ Rsrc [MIMEType]
getAccept
= do acceptM ← getHeader "Accept"
case acceptM of
Nothing
→ return []
Just accept
- → case P.parseOnly (finishOff MT.mimeTypeList) (A.toByteString accept) of
+ → case P.parseOnly (finishOff MT.mimeTypeList) (cs accept) of
Right xs → return xs
Left _ → abort $ mkAbortion' BadRequest
- $ "Unparsable Accept: " ⊕ A.toText accept
+ $ "Unparsable Accept: " ⊕ cs accept
-- |Return the list of @(contentCoding, qvalue)@ enumerated on the
-- value of request header \"Accept-Encoding\". The list is sorted in
-- descending order by qvalue.
-getAcceptEncoding ∷ Resource [(CIAscii, Maybe Double)]
+getAcceptEncoding ∷ Rsrc [(CIAscii, Maybe Double)]
getAcceptEncoding
= do accEncM ← getHeader "Accept-Encoding"
case accEncM of
-- identity のみが許される。
return [("identity", Nothing)]
else
- case P.parseOnly (finishOff acceptEncodingList) (A.toByteString ae) of
+ case P.parseOnly (finishOff acceptEncodingList) (cs ae) of
Right xs → return $ map toTuple $ reverse $ sort xs
Left _ → abort $ mkAbortion' BadRequest
- $ "Unparsable Accept-Encoding: " ⊕ A.toText ae
+ $ "Unparsable Accept-Encoding: " ⊕ cs ae
where
toTuple (AcceptEncoding {..})
= (aeEncoding, aeQValue)
-- |Return 'True' iff a given content-coding is acceptable by the
-- client.
-isEncodingAcceptable ∷ CIAscii → Resource Bool
+isEncodingAcceptable ∷ CIAscii → Rsrc Bool
isEncodingAcceptable encoding = any doesMatch <$> getAcceptEncoding
where
doesMatch ∷ (CIAscii, Maybe Double) → Bool
doesMatch (e, q) = (e ≡ "*" ∨ e ≡ encoding) ∧ q ≢ Just 0
-- |Return the value of request header \"Content-Type\" as 'MIMEType'.
-getContentType ∷ Resource (Maybe MIMEType)
+getContentType ∷ Rsrc (Maybe MIMEType)
getContentType
= do cTypeM ← getHeader "Content-Type"
case cTypeM of
Nothing
→ return Nothing
Just cType
- → case P.parseOnly (finishOff MT.mimeType) (A.toByteString cType) of
+ → case P.parseOnly (finishOff MT.mimeType) (cs cType) of
Right t → return $ Just t
Left _ → abort $ mkAbortion' BadRequest
- $ "Unparsable Content-Type: " ⊕ A.toText cType
+ $ "Unparsable Content-Type: " ⊕ cs cType
-- |Return the value of request header \"Authorization\" as
-- 'AuthCredential'.
-getAuthorization ∷ Resource (Maybe AuthCredential)
+getAuthorization ∷ Rsrc (Maybe AuthCredential)
getAuthorization
= do authM ← getHeader "Authorization"
case authM of
Nothing
→ return Nothing
Just auth
- → case P.parseOnly (finishOff authCredential) (A.toByteString auth) of
+ → case P.parseOnly (finishOff authCredential) (cs auth) of
Right ac → return $ Just ac
Left _ → return Nothing
--- |Tell the system that the 'Resource' found an entity for the
--- request URI. If this is a GET or HEAD request, a found entity means
--- a datum to be replied. If this is a PUT or DELETE request, it means
--- a datum which was stored for the URI until now. For POST requests
--- it raises an error.
+-- |Tell the system that the 'Rsrc' found an entity for the request
+-- URI. If this is a GET or HEAD request, a found entity means a datum
+-- to be replied. If this is a PUT or DELETE request, it means a datum
+-- which was stored for the URI until now. For POST requests it raises
+-- an error.
--
-- 'foundEntity' performs \"If-Match\" test or \"If-None-Match\" test
-- whenever possible, and if those tests fail, it immediately aborts
-- If the request method is either GET or HEAD, 'foundEntity'
-- automatically puts \"ETag\" and \"Last-Modified\" headers into the
-- response.
-foundEntity ∷ ETag → UTCTime → Resource ()
+foundEntity ∷ ETag → UTCTime → Rsrc ()
foundEntity tag timeStamp
= do driftTo ExaminingRequest
method ← getMethod
when (method ≡ GET ∨ method ≡ HEAD)
- $ setHeader "Last-Modified" (HTTP.toAscii timeStamp)
+ $ setHeader "Last-Modified"
+ $ flip proxy http
+ $ cs timeStamp
when (method ≡ POST)
$ abort
$ mkAbortion' InternalServerError
driftTo ReceivingBody
--- |Tell the system that the 'Resource' found an entity for the
--- request URI. The only difference from 'foundEntity' is that
--- 'foundETag' doesn't (nor can't) put \"Last-Modified\" header into
--- the response.
+-- |Tell the system that the 'Rsrc' found an entity for the request
+-- URI. The only difference from 'foundEntity' is that 'foundETag'
+-- doesn't (nor can't) put \"Last-Modified\" header into the response.
--
-- Using this function is discouraged. You should use 'foundEntity'
-- whenever possible.
-foundETag ∷ ETag → Resource ()
+foundETag ∷ ETag → Rsrc ()
foundETag tag
= do driftTo ExaminingRequest
method ← getMethod
when (method ≡ GET ∨ method ≡ HEAD)
$ setHeader "ETag"
- $ A.fromAsciiBuilder
- $ printETag tag
+ $ cs tag
when (method ≡ POST)
$ abort
$ mkAbortion' InternalServerError
→ if value ≡ "*" then
return ()
else
- case P.parseOnly (finishOff eTagList) (A.toByteString value) of
+ case P.parseOnly (finishOff eTagList) (cs value) of
Right tags
-- tags の中に一致するものが無ければ
-- PreconditionFailed で終了。
→ when ((¬) (any (≡ tag) tags))
$ abort
$ mkAbortion' PreconditionFailed
- $ "The entity tag doesn't match: " ⊕ A.toText value
+ $ "The entity tag doesn't match: " ⊕ cs value
Left _
→ abort $ mkAbortion' BadRequest
- $ "Unparsable If-Match: " ⊕ A.toText value
+ $ "Unparsable If-Match: " ⊕ cs value
let statusForNoneMatch
= if method ≡ GET ∨ method ≡ HEAD then
abort $ mkAbortion' statusForNoneMatch
$ "The entity tag matches: *"
else
- case P.parseOnly (finishOff eTagList) (A.toByteString value) of
+ case P.parseOnly (finishOff eTagList) (cs value) of
Right tags
→ when (any (≡ tag) tags)
$ abort
$ mkAbortion' statusForNoneMatch
- $ "The entity tag matches: " ⊕ A.toText value
+ $ "The entity tag matches: " ⊕ cs value
Left _
→ abort $ mkAbortion' BadRequest
- $ "Unparsable If-None-Match: " ⊕ A.toText value
+ $ "Unparsable If-None-Match: " ⊕ cs value
driftTo ReceivingBody
--- |Tell the system that the 'Resource' found an entity for the
+-- |Tell the system that the 'Rsrc' found an entity for the
-- request URI. The only difference from 'foundEntity' is that
-- 'foundTimeStamp' performs \"If-Modified-Since\" test or
-- \"If-Unmodified-Since\" test instead of \"If-Match\" test or
--
-- Using this function is discouraged. You should use 'foundEntity'
-- whenever possible.
-foundTimeStamp ∷ UTCTime → Resource ()
+foundTimeStamp ∷ UTCTime → Rsrc ()
foundTimeStamp timeStamp
= do driftTo ExaminingRequest
method ← getMethod
when (method ≡ GET ∨ method ≡ HEAD)
- $ setHeader "Last-Modified" (HTTP.toAscii timeStamp)
+ $ setHeader "Last-Modified"
+ $ flip proxy http
+ $ cs timeStamp
when (method ≡ POST)
$ abort
$ mkAbortion' InternalServerError
ifModSince ← getHeader "If-Modified-Since"
case ifModSince of
- Just str → case HTTP.fromAscii str of
- Right lastTime
+ Just str → case fromAttempt $ ca (Tagged str ∷ Tagged HTTP Ascii) of
+ Just lastTime
→ when (timeStamp ≤ lastTime)
$ abort
$ mkAbortion' statusForIfModSince
- $ "The entity has not been modified since " ⊕ A.toText str
- Left e
+ $ "The entity has not been modified since " ⊕ cs str
+ Nothing
→ abort $ mkAbortion' BadRequest
- $ "Malformed If-Modified-Since: " ⊕ T.pack e
+ $ "Malformed If-Modified-Since: " ⊕ cs str
Nothing → return ()
ifUnmodSince ← getHeader "If-Unmodified-Since"
case ifUnmodSince of
- Just str → case HTTP.fromAscii str of
- Right lastTime
+ Just str → case fromAttempt $ ca (Tagged str ∷ Tagged HTTP Ascii) of
+ Just lastTime
→ when (timeStamp > lastTime)
$ abort
$ mkAbortion' PreconditionFailed
- $ "The entity has not been modified since " ⊕ A.toText str
- Left e
+ $ "The entity has not been modified since " ⊕ cs str
+ Nothing
→ abort $ mkAbortion' BadRequest
- $ "Malformed If-Unmodified-Since: " ⊕ T.pack e
+ $ "Malformed If-Unmodified-Since: " ⊕ cs str
Nothing → return ()
driftTo ReceivingBody
--- |@'foundNoEntity' mStr@ tells the system that the 'Resource' found
--- no entity for the request URI. @mStr@ is an optional error message
--- to be replied to the client.
+-- |@'foundNoEntity' mStr@ tells the system that the 'Rsrc' found no
+-- entity for the request URI. @mStr@ is an optional error message to
+-- be replied to the client.
--
-- If the request method is PUT, 'foundNoEntity' performs \"If-Match\"
-- test and when that fails it aborts with status \"412 Precondition
-- Failed\". If the request method is GET, HEAD, POST or DELETE,
-- 'foundNoEntity' always aborts with status \"404 Not Found\".
-foundNoEntity ∷ Maybe Text → Resource ()
+foundNoEntity ∷ Maybe Text → Rsrc ()
foundNoEntity msgM
= do driftTo ExaminingRequest
driftTo ReceivingBody
-- |'foundNoEntity'' is the same as @'foundNoEntity' 'Nothing'@.
-foundNoEntity' ∷ Resource ()
+foundNoEntity' ∷ Rsrc ()
{-# INLINE foundNoEntity' #-}
foundNoEntity' = foundNoEntity Nothing
-- |@'getChunks' limit@ attemts to read the entire request body up to
--- @limit@ bytes, and then make the 'Resource' transit to the
--- /Deciding Header/ state. When the actual size of the body is larger
--- than @limit@ bytes, 'getChunks' immediately aborts with status
--- \"413 Request Entity Too Large\". When the request has no body, it
+-- @limit@ bytes, and then make the 'Rsrc' transit to the /Deciding
+-- Header/ state. When the actual size of the body is larger than
+-- @limit@ bytes, 'getChunks' immediately aborts with status \"413
+-- Request Entity Too Large\". When the request has no body, it
-- returns an empty string.
--
-- When the @limit@ is 'Nothing', 'getChunks' uses the default
-- 'getChunks' returns a lazy 'Lazy.ByteString' but it's not really
-- lazy: reading from the socket just happens at the computation of
-- 'getChunks', not at the evaluation of the 'Lazy.ByteString'.
-getChunks ∷ Maybe Int → Resource Lazy.ByteString
+getChunks ∷ Maybe Int → Rsrc Lazy.ByteString
getChunks (Just n)
| n < 0 = fail ("getChunks: limit must not be negative: " ⧺ show n)
| n ≡ 0 = return (∅)
getChunks Nothing
= getConfig ≫= getChunks ∘ Just ∘ cnfMaxEntityLength
-getChunks' ∷ Int → Resource Lazy.ByteString
+getChunks' ∷ Int → Rsrc Lazy.ByteString
getChunks' limit = go limit (∅)
where
- go ∷ Int → Builder → Resource Lazy.ByteString
+ go ∷ Int → Builder → Rsrc Lazy.ByteString
go 0 _ = do chunk ← getChunk 1
if Strict.null chunk then
return (∅)
--
-- Note that there are currently a few limitations on parsing
-- @multipart/form-data@. See: 'parseMultipartFormData'
-getForm ∷ Maybe Int → Resource [(Strict.ByteString, FormData)]
+getForm ∷ Maybe Int → Rsrc [(Strict.ByteString, FormData)]
getForm limit
= do cTypeM ← getContentType
case cTypeM of
→ readMultipartFormData params
Just cType
→ abort $ mkAbortion' UnsupportedMediaType
- $ A.toText
- $ A.fromAsciiBuilder
- $ A.toAsciiBuilder "Unsupported media type: "
- ⊕ MT.printMIMEType cType
+ $ cs
+ $ ("Unsupported media type: " ∷ Ascii)
+ ⊕ cs cType
where
readWWWFormURLEncoded
= (map toPairWithFormData ∘ parseWWWFormURLEncoded)
(bsToAscii =≪ getChunks limit)
bsToAscii bs
- = case A.fromByteString (Strict.concat (Lazy.toChunks bs)) of
- Just a → return a
- Nothing → abort $ mkAbortion' BadRequest "Malformed x-www-form-urlencoded"
+ = case convertAttemptVia ((⊥) ∷ ByteString) bs of
+ Success a → return a
+ Failure e → abort $ mkAbortion' BadRequest $ cs (show e)
readMultipartFormData m
= case lookup "boundary" m of
→ abort $ mkAbortion' BadRequest "Missing boundary of multipart/form-data"
Just boundary
→ do src ← getChunks limit
- b ← case A.fromText boundary of
- Just b → return b
- Nothing → abort $ mkAbortion' BadRequest
- $ "Malformed boundary: " ⊕ boundary
+ b ← case ca boundary of
+ Success b → return b
+ Failure _ → abort $ mkAbortion' BadRequest
+ $ "Malformed boundary: " ⊕ boundary
case parseMultipartFormData b src of
- Right xs → return $ map (first A.toByteString) xs
+ Right xs → return $ map (first cs) xs
Left err → abort $ mkAbortion' BadRequest $ T.pack err
-- |@'redirect' code uri@ declares the response status as @code@ and
-- \"Location\" header field as @uri@. The @code@ must satisfy
-- 'isRedirection' or it raises an error.
-redirect ∷ StatusCode sc ⇒ sc → URI → Resource ()
+redirect ∷ StatusCode sc ⇒ sc → URI → Rsrc ()
redirect sc uri
= do when (sc ≈ NotModified ∨ (¬) (isRedirection sc))
$ abort
$ mkAbortion' InternalServerError
- $ A.toText
- $ A.fromAsciiBuilder
- $ A.toAsciiBuilder "Attempted to redirect with status "
- ⊕ printStatusCode sc
+ $ cs
+ $ ("Attempted to redirect with status " ∷ Ascii)
+ ⊕ cs (fromStatusCode sc)
setStatus sc
setLocation uri
-- |@'setContentType' mType@ declares the response header
-- \"Content-Type\" as @mType@. Declaring \"Content-Type\" is
-- mandatory for sending a response body.
-setContentType ∷ MIMEType → Resource ()
-setContentType
- = setHeader "Content-Type" ∘ A.fromAsciiBuilder ∘ MT.printMIMEType
+setContentType ∷ MIMEType → Rsrc ()
+setContentType = setHeader "Content-Type" ∘ cs
-- |@'setLocation' uri@ declares the response header \"Location\" as
-- @uri@. You usually don't need to call this function directly.
-setLocation ∷ URI → Resource ()
+setLocation ∷ URI → Rsrc ()
setLocation uri
= case A.fromChars uriStr of
Just a → setHeader "Location" a
-- |@'setContentEncoding' codings@ declares the response header
-- \"Content-Encoding\" as @codings@.
-setContentEncoding ∷ [CIAscii] → Resource ()
+setContentEncoding ∷ [CIAscii] → Rsrc ()
setContentEncoding codings
= do ver ← getRequestVersion
tr ← case ver of
-- |@'setWWWAuthenticate' challenge@ declares the response header
-- \"WWW-Authenticate\" as @challenge@.
-setWWWAuthenticate ∷ AuthChallenge → Resource ()
-setWWWAuthenticate = setHeader "WWW-Authenticate" ∘ printAuthChallenge
+setWWWAuthenticate ∷ AuthChallenge → Rsrc ()
+setWWWAuthenticate = setHeader "WWW-Authenticate" ∘ cs
-- |Write a chunk in 'Strict.ByteString' to the response body. You
-- must first declare the response header \"Content-Type\" before
--- applying this function. See: 'setContentType'
-putChunk ∷ Strict.ByteString → Resource ()
+-- applying this function. See 'setContentType'.
+putChunk ∷ Strict.ByteString → Rsrc ()
putChunk = putBuilder ∘ BB.fromByteString
-- |Write a chunk in lazy 'Lazy.ByteString' to the response body. It
-- can be safely applied to an infinitely long 'Lazy.ByteString'.
--
-- Note that you must first declare the response header
--- \"Content-Type\" before applying this function. See:
--- 'setContentType'
-putChunks ∷ Lazy.ByteString → Resource ()
+-- \"Content-Type\" before applying this function. See
+-- 'setContentType'.
+putChunks ∷ Lazy.ByteString → Rsrc ()
putChunks = putBuilder ∘ BB.fromLazyByteString