import Control.Concurrent.STM
import Control.Exception
import Control.Monad hiding (mapM_)
+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
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)
= Rsrc {
unRsrc ∷ ReaderT NormalInteraction IO a
}
- deriving (Applicative, Functor, Monad, MonadIO)
+ deriving (Applicative, Functor, Monad, MonadFix, MonadIO)
runRsrc ∷ Rsrc a → NormalInteraction → IO a
runRsrc = runReaderT ∘ unRsrc
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"]
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
-- main :: 'IO' ()
-- main = let tree :: 'Network.HTTP.Lucu.ResourceTree'
-- tree = 'fromList' [ (["foo"], 'Network.HTTP.Lucu.greedy' resFoo) ]
--- in 'Network.HTTP.Lucu.runHttpd' 'defaultConfig' $ 'Network.HTTP.Lucu.resourceMap' tree
+-- in 'Network.withSocketsDo' '.' 'Network.HTTP.Lucu.runHttpd' 'defaultConfig' $ 'Network.HTTP.Lucu.resourceMap' tree
--
-- resFoo :: 'Resource'
-- resFoo = 'singleton'
| 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 (∅)