, GeneralizedNewtypeDeriving
, DoAndIfThenElse
, OverloadedStrings
+ , QuasiQuotes
, RecordWildCards
, UnicodeSyntax
#-}
import qualified Data.Text as T
import Data.Time
import qualified Data.Time.HTTP as HTTP
+import Data.Typeable
import Network.HTTP.Lucu.Abortion
import Network.HTTP.Lucu.Authentication
import Network.HTTP.Lucu.Config
import Network.HTTP.Lucu.Resource.Internal
import Network.HTTP.Lucu.Response
import Network.HTTP.Lucu.MIMEParams
-import Network.HTTP.Lucu.MIMEType
+import Network.HTTP.Lucu.MIMEType (MIMEType(..))
+import qualified Network.HTTP.Lucu.MIMEType as MT
+import Network.HTTP.Lucu.MIMEType.TH
import Network.HTTP.Lucu.Utils
import Network.Socket hiding (accept)
import Network.URI hiding (path)
toPairWithFormData (name, value)
= let fd = FormData {
fdFileName = Nothing
- , fdMIMEType = parseMIMEType "text/plain"
+ , fdMIMEType = [mimeType| text/plain |]
, fdContent = Lazy.fromChunks [value]
}
in (name, fd)
Nothing
→ return []
Just accept
- → case P.parseOnly (finishOff mimeTypeList) (A.toByteString accept) of
+ → case P.parseOnly (finishOff MT.mimeTypeList) (A.toByteString accept) of
Right xs → return xs
Left _ → abort $ mkAbortion' BadRequest
$ "Unparsable Accept: " ⊕ A.toText accept
Nothing
→ return Nothing
Just cType
- → case P.parseOnly (finishOff mimeType) (A.toByteString cType) of
+ → case P.parseOnly (finishOff MT.mimeType) (A.toByteString cType) of
Right t → return $ Just t
Left _ → abort $ mkAbortion' BadRequest
$ "Unparsable Content-Type: " ⊕ A.toText cType
let statusForNoneMatch
= if method ≡ GET ∨ method ≡ HEAD then
- NotModified
+ fromStatusCode NotModified
else
- PreconditionFailed
+ fromStatusCode PreconditionFailed
-- If-None-Match があればそれを見る。
ifNoneMatch ← getHeader "If-None-Match"
let statusForIfModSince
= if method ≡ GET ∨ method ≡ HEAD then
- NotModified
+ fromStatusCode NotModified
else
- PreconditionFailed
+ fromStatusCode PreconditionFailed
-- If-Modified-Since があればそれを見る。
ifModSince ← getHeader "If-Modified-Since"
$ A.toText
$ A.fromAsciiBuilder
$ A.toAsciiBuilder "Unsupported media type: "
- ⊕ printMIMEType cType
+ ⊕ MT.printMIMEType cType
where
readWWWFormURLEncoded
= (map toPairWithFormData ∘ parseWWWFormURLEncoded)
-- |@'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 → URI → Resource ()
-redirect code uri
- = do when (code ≡ NotModified ∨ not (isRedirection code))
+redirect ∷ StatusCode sc ⇒ sc → URI → Resource ()
+redirect sc uri
+ = do when (cast sc ≡ Just NotModified ∨ (¬) (isRedirection sc))
$ abort
$ mkAbortion' InternalServerError
$ A.toText
$ A.fromAsciiBuilder
$ A.toAsciiBuilder "Attempted to redirect with status "
- ⊕ printStatusCode code
- setStatus code
+ ⊕ printStatusCode sc
+ setStatus sc
setLocation uri
-- |@'setContentType' mType@ declares the response header
-- mandatory for sending a response body.
setContentType ∷ MIMEType → Resource ()
setContentType
- = setHeader "Content-Type" ∘ A.fromAsciiBuilder ∘ printMIMEType
+ = setHeader "Content-Type" ∘ A.fromAsciiBuilder ∘ MT.printMIMEType
-- |@'setLocation' uri@ declares the response header \"Location\" as
-- @uri@. You usually don't need to call this function directly.