import Data.Ascii (Ascii, CIAscii, AsciiBuilder)
import Data.Attempt
import qualified Data.Attoparsec.Char8 as P
+import Data.Attoparsec.Parsable
import Data.ByteString (ByteString)
import qualified Data.ByteString as Strict
import qualified Data.ByteString.Lazy as Lazy
import Network.HTTP.Lucu.Request
import Network.HTTP.Lucu.Resource.Internal
import Network.HTTP.Lucu.Response
-import Network.HTTP.Lucu.MIMEType (MIMEType(..))
-import qualified Network.HTTP.Lucu.MIMEType as MT
-import Network.HTTP.Lucu.MIMEType.TH
+import Network.HTTP.Lucu.MIMEType
import Network.HTTP.Lucu.Utils
import Network.Socket hiding (accept)
import Network.URI hiding (path)
Nothing
→ return []
Just accept
- → case P.parseOnly (finishOff MT.mimeTypeList) (cs accept) of
+ → case P.parseOnly (finishOff parser) (cs accept) of
Right xs → return xs
Left _ → abort $ mkAbortion' BadRequest
$ "Unparsable Accept: " ⊕ cs accept
-- identity のみが許される。
return [("identity", Nothing)]
else
- case P.parseOnly (finishOff acceptEncodingList) (cs ae) of
+ case P.parseOnly (finishOff parser) (cs ae) of
Right xs → return $ map toTuple $ reverse $ sort xs
Left _ → abort $ mkAbortion' BadRequest
$ "Unparsable Accept-Encoding: " ⊕ cs ae
Nothing
→ return Nothing
Just cType
- → case P.parseOnly (finishOff MT.mimeType) (cs cType) of
+ → case P.parseOnly (finishOff parser) (cs cType) of
Right t → return $ Just t
Left _ → abort $ mkAbortion' BadRequest
$ "Unparsable Content-Type: " ⊕ cs cType
Nothing
→ return Nothing
Just auth
- → case P.parseOnly (finishOff authCredential) (cs auth) of
+ → case P.parseOnly (finishOff parser) (cs auth) of
Right ac → return $ Just ac
Left _ → return Nothing
→ if value ≡ "*" then
return ()
else
- case P.parseOnly (finishOff eTagList) (cs value) of
+ case P.parseOnly (finishOff parser) (cs value) of
Right tags
-- tags の中に一致するものが無ければ
-- PreconditionFailed で終了。
- → when ((¬) (any (≡ tag) tags))
+ → when ((¬) (any (≡ tag) (tags ∷ [ETag])))
$ abort
$ mkAbortion' PreconditionFailed
$ "The entity tag doesn't match: " ⊕ cs value
abort $ mkAbortion' statusForNoneMatch
$ "The entity tag matches: *"
else
- case P.parseOnly (finishOff eTagList) (cs value) of
+ case P.parseOnly (finishOff parser) (cs value) of
Right tags
- → when (any (≡ tag) tags)
+ → when (any (≡ tag) (tags ∷ [ETag]))
$ abort
$ mkAbortion' statusForNoneMatch
$ "The entity tag matches: " ⊕ cs value