X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FResource%2FInternal.hs;h=7398f93e045cff87dd51b1241e23b0da70bcd3ca;hb=f093019cb10a88fee13b8c99d05b60f895ceb01f;hp=e5c38e78c1b3ae466cad9b0e62a69f3d47f5ee50;hpb=ddf98ebb585d1243e4982977c75c244f45bb3bf2;p=Lucu.git diff --git a/Network/HTTP/Lucu/Resource/Internal.hs b/Network/HTTP/Lucu/Resource/Internal.hs index e5c38e7..7398f93 100644 --- a/Network/HTTP/Lucu/Resource/Internal.hs +++ b/Network/HTTP/Lucu/Resource/Internal.hs @@ -42,16 +42,16 @@ import Control.Monad.Fix import Control.Monad.IO.Class import Control.Monad.Reader (ReaderT, runReaderT, ask) import Control.Monad.Unicode -import Data.Ascii (Ascii, CIAscii) -import qualified Data.Ascii as A +import Data.Ascii (Ascii, CIAscii, AsciiBuilder) import Data.ByteString (ByteString) import qualified Data.ByteString as BS import Data.Collections +import Data.Convertible.Base +import Data.Convertible.Instances.Text () import Data.List (intersperse, nub) import Data.Maybe import Data.Monoid import Data.Monoid.Unicode -import qualified Data.Text as T import Network.HTTP.Lucu.Abortion import Network.HTTP.Lucu.Abortion.Internal import Network.HTTP.Lucu.Config @@ -61,6 +61,7 @@ import Network.HTTP.Lucu.Interaction import Network.HTTP.Lucu.Postprocess import Network.HTTP.Lucu.Request import Network.HTTP.Lucu.Response +import Network.HTTP.Lucu.Response.StatusCode import Network.HTTP.Lucu.Utils import Network.Socket #if defined(HAVE_SSL) @@ -180,14 +181,14 @@ spawnRsrc (Resource {..}) ni@(NI {..}) notAllowed ∷ Rsrc () notAllowed = do setStatus MethodNotAllowed setHeader "Allow" - $ A.fromAsciiBuilder + $ cs $ mconcat - $ intersperse (A.toAsciiBuilder ", ") - $ map A.toAsciiBuilder allowedMethods + $ intersperse (cs (", " ∷ Ascii) ∷ AsciiBuilder) + $ map cs allowedMethods allowedMethods ∷ [Ascii] - allowedMethods = nub $ concat [ methods resGet ["GET"] - , methods resHead ["GET", "HEAD"] + allowedMethods = nub $ concat [ methods resGet ["GET", "HEAD"] + , methods resHead ["HEAD"] , methods resPost ["POST"] , methods resPut ["PUT"] , methods resDelete ["DELETE"] @@ -202,7 +203,7 @@ spawnRsrc (Resource {..}) ni@(NI {..}) toAbortion e = case fromException e of Just abortion → abortion - Nothing → mkAbortion' InternalServerError $ T.pack $ show e + Nothing → mkAbortion' InternalServerError $ cs $ show e processException ∷ SomeException → IO () processException exc @@ -302,7 +303,7 @@ getChunk' n | n < 0 = fail ("getChunk: n must not be negative: " ⧺ show n) | n ≡ 0 = return (∅) | otherwise = do req ← getRequest - if reqMustHaveBody req then + if reqHasBody req then askForInput =≪ getInteraction else driftTo DecidingHeader *> return (∅)