From 0aa4f6d758fc12fba468f7cd399bbcc48f693d1e Mon Sep 17 00:00:00 2001 From: PHO Date: Fri, 21 Oct 2011 22:54:25 +0900 Subject: [PATCH] Doc fix Ditz-issue: 8959dadc07db1bd363283dee401073f6e48dc7fa --- Lucu.cabal | 17 +-- Network/HTTP/Lucu.hs | 35 +++--- Network/HTTP/Lucu/Abortion.hs | 1 - .../{Authorization.hs => Authentication.hs} | 5 +- Network/HTTP/Lucu/Httpd.hs | 109 ++++++++---------- Network/HTTP/Lucu/Resource.hs | 2 +- Network/HTTP/Lucu/SocketLike.hs | 25 ++-- 7 files changed, 91 insertions(+), 103 deletions(-) rename Network/HTTP/Lucu/{Authorization.hs => Authentication.hs} (96%) diff --git a/Lucu.cabal b/Lucu.cabal index 95d2095..c041872 100644 --- a/Lucu.cabal +++ b/Lucu.cabal @@ -1,13 +1,16 @@ Name: Lucu Synopsis: HTTP Daemonic Library Description: + Lucu is an HTTP daemonic library. It can be embedded in any - Haskell program and runs in an independent thread. Lucu is - not a replacement for Apache or lighttpd. It is intended to be - used to create an efficient web-based RESTful application - without messing around FastCGI. It is also intended to be run - behind a reverse-proxy so it doesn't have some facilities like - logging, client filtering or such like. + Haskell program and runs in an independent thread. + + Lucu is not a replacement for Apache nor lighttpd. It is + intended to be used to build an efficient web-based RESTful + application. It is also intended to be run behind a + reverse-proxy so it doesn't have some facilities like logging, + client filtering or such like. + Version: 1.0 License: PublicDomain License-File: COPYING @@ -73,7 +76,7 @@ Library Exposed-Modules: Network.HTTP.Lucu Network.HTTP.Lucu.Abortion - Network.HTTP.Lucu.Authorization + Network.HTTP.Lucu.Authentication Network.HTTP.Lucu.Config Network.HTTP.Lucu.ETag Network.HTTP.Lucu.HttpVersion diff --git a/Network/HTTP/Lucu.hs b/Network/HTTP/Lucu.hs index d47854f..efae41a 100644 --- a/Network/HTTP/Lucu.hs +++ b/Network/HTTP/Lucu.hs @@ -6,49 +6,47 @@ -- [/Full support of HTTP\/1.1/] Lucu supports request pipelining, -- chunked I\/O, ETag comparison and \"100 Continue\". -- --- [/Performance/] Lucu doesn't fork\/exec to handle requests like --- CGI. It just spawns a new thread. Inter-process communication is --- done with STM. +-- [/Performance/] Lucu is carefully designed to gain a good +-- performance. -- --- [/Affinity for RESTafarians/] Lucu is a carefully designed --- web server for RESTful applications. +-- [/Affinity for RESTafarians/] Lucu is specifically designed to be +-- suitable for RESTful applications. -- -- [/SSL connections/] Lucu can handle HTTP connections over SSL -- layer. -- -- Lucu is not a replacement for Apache or lighttpd. It is intended to --- be used to create an efficient web-based RESTful application --- without messing around FastCGI. It is also intended to be run --- behind a reverse-proxy so it doesn't have the following (otherwise --- essential) facilities: +-- be used to build an efficient web-based RESTful application. It is +-- also intended to be run behind a reverse-proxy so it doesn't have +-- the following (otherwise essential) facilities: -- --- [/Logging/] Lucu doesn't log any requests from any clients. +-- [/Logging/] Lucu doesn't write logs of any requests from any +-- clients. -- -- [/Client Filtering/] Lucu always accepts any clients. No IP -- filter is implemented. -- -- [/Bandwidth Limitting/] Lucu doesn't limit bandwidth it consumes. -- --- [/Protection Against Wicked Clients/] Lucu is fragile against --- wicked clients. No attacker should be able to cause a +-- [/Protection Against Wicked Clients/] Lucu is somewhat fragile +-- against wicked clients. No attacker should be able to cause a -- buffer-overflow but can possibly DoS it. -- module Network.HTTP.Lucu ( -- * Entry Point runHttpd - -- * Configuration + -- * 'Config'uration , module Network.HTTP.Lucu.Config -- * Resource Tree , ResTree , mkResTree - -- * Resource Monad + -- * 'Resource' Monad , module Network.HTTP.Lucu.Resource -- ** Things to be used in the Resource monad - -- *** Status Code , StatusCode(..) @@ -68,18 +66,17 @@ module Network.HTTP.Lucu , mkMIMEType , parseMIMEType - -- *** Authorization + -- *** Authentication , AuthChallenge(..) , AuthCredential(..) - -- * Utility - + -- * Utilities -- ** Static file handling , module Network.HTTP.Lucu.StaticFile ) where import Network.HTTP.Lucu.Abortion -import Network.HTTP.Lucu.Authorization +import Network.HTTP.Lucu.Authentication import Network.HTTP.Lucu.Config import Network.HTTP.Lucu.ETag import Network.HTTP.Lucu.Httpd diff --git a/Network/HTTP/Lucu/Abortion.hs b/Network/HTTP/Lucu/Abortion.hs index 6c2d14d..62677e8 100644 --- a/Network/HTTP/Lucu/Abortion.hs +++ b/Network/HTTP/Lucu/Abortion.hs @@ -4,7 +4,6 @@ , TypeOperators , UnicodeSyntax #-} - -- |Aborting the computation of 'Network.HTTP.Lucu.Resource.Resource' -- in any 'Prelude.IO' monads or arrows. module Network.HTTP.Lucu.Abortion diff --git a/Network/HTTP/Lucu/Authorization.hs b/Network/HTTP/Lucu/Authentication.hs similarity index 96% rename from Network/HTTP/Lucu/Authorization.hs rename to Network/HTTP/Lucu/Authentication.hs index 789b5d1..7479188 100644 --- a/Network/HTTP/Lucu/Authorization.hs +++ b/Network/HTTP/Lucu/Authentication.hs @@ -2,9 +2,8 @@ OverloadedStrings , UnicodeSyntax #-} - --- |Manipulation of WWW authorization. -module Network.HTTP.Lucu.Authorization +-- |Manipulation of WWW authentication. +module Network.HTTP.Lucu.Authentication ( AuthChallenge(..) , AuthCredential(..) , Realm diff --git a/Network/HTTP/Lucu/Httpd.hs b/Network/HTTP/Lucu/Httpd.hs index d180202..2dca512 100644 --- a/Network/HTTP/Lucu/Httpd.hs +++ b/Network/HTTP/Lucu/Httpd.hs @@ -1,36 +1,38 @@ +{-# LANGUAGE + UnicodeSyntax + #-} -- |The entry point of Lucu httpd. module Network.HTTP.Lucu.Httpd ( FallbackHandler , runHttpd ) where - -import Control.Concurrent -import Control.Exception -import Control.Monad -import Data.Maybe -import Network.BSD -import Network.Socket -import Network.HTTP.Lucu.Config -import Network.HTTP.Lucu.Interaction -import Network.HTTP.Lucu.RequestReader -import Network.HTTP.Lucu.Resource.Tree -import Network.HTTP.Lucu.ResponseWriter -import Network.HTTP.Lucu.SocketLike as SL -import System.Posix.Signals +import Control.Concurrent +import Control.Exception +import Control.Monad +import Control.Monad.Unicode +import Data.Maybe +import Network.BSD +import Network.Socket +import Network.HTTP.Lucu.Config +import Network.HTTP.Lucu.Interaction +import Network.HTTP.Lucu.RequestReader +import Network.HTTP.Lucu.Resource.Tree +import Network.HTTP.Lucu.ResponseWriter +import Network.HTTP.Lucu.SocketLike as SL +import System.Posix.Signals -- |This is the entry point of Lucu httpd. It listens to a socket and --- waits for clients. Computation of 'runHttpd' never stops by itself --- so the only way to stop it is to raise an exception in the thread --- computing it. +-- waits for clients. 'runHttpd' never stops by itself so the only way +-- to stop it is to raise an exception in the thread running it. -- -- Note that 'runHttpd' automatically makes SIGPIPE be ignored by --- computing @'System.Posix.Signals.installHandler' --- 'System.Posix.Signals.sigPIPE' 'System.Posix.Signals.Ignore' --- 'Prelude.Nothing'@. This can hardly cause a problem but it may do. +-- calling @'installHandler' 'sigPIPE' 'Ignore' 'Nothing'@. This can +-- hardly cause a problem though. -- -- Example: -- +-- > {-# LANGUAGE OverloadedStrings #-} -- > module Main where -- > import Network.HTTP.Lucu -- > @@ -41,81 +43,72 @@ import System.Posix.Signals -- > runHttpd config resourcees [] -- > -- > helloWorld :: ResourceDef --- > helloWorld = ResourceDef { --- > resUsesNativeThread = False --- > , resIsGreedy = False --- > , resGet --- > = Just $ do setContentType $ read "text/plain" --- > output "Hello, world!" --- > , resHead = Nothing --- > , resPost = Nothing --- > , resPut = Nothing --- > , resDelete = Nothing +-- > helloWorld = emptyResource { +-- > resGet +-- > = Just $ do setContentType $ mkMIMEType "text" "plain" +-- > putChunk "Hello, world!" -- > } -runHttpd :: Config -> ResTree -> [FallbackHandler] -> IO () +runHttpd ∷ Config → ResTree → [FallbackHandler] → IO () runHttpd cnf tree fbs = withSocketsDo $ - do _ <- installHandler sigPIPE Ignore Nothing - + do void $ installHandler sigPIPE Ignore Nothing let launchers = catMaybes - [ do scnf <- cnfSSLConfig cnf - addr <- cnfServerV4Addr cnf - return ( do so <- listenOn AF_INET addr (sslServerPort scnf) + [ do scnf ← cnfSSLConfig cnf + addr ← cnfServerV4Addr cnf + return ( do so ← listenOn AF_INET addr (sslServerPort scnf) launchListener (sslContext scnf, so) ) - , do scnf <- cnfSSLConfig cnf - addr <- cnfServerV6Addr cnf - return ( do so <- listenOn AF_INET6 addr (sslServerPort scnf) + , do scnf ← cnfSSLConfig cnf + addr ← cnfServerV6Addr cnf + return ( do so ← listenOn AF_INET6 addr (sslServerPort scnf) launchListener (sslContext scnf, so) ) - , do addr <- cnfServerV4Addr cnf - return ( launchListener =<< listenOn AF_INET addr (cnfServerPort cnf) + , do addr ← cnfServerV4Addr cnf + return ( launchListener =≪ listenOn AF_INET addr (cnfServerPort cnf) ) - , do addr <- cnfServerV6Addr cnf - return ( launchListener =<< listenOn AF_INET6 addr (cnfServerPort cnf) + , do addr ← cnfServerV6Addr cnf + return ( launchListener =≪ listenOn AF_INET6 addr (cnfServerPort cnf) ) ] - sequence_ launchers waitForever where - launchListener :: SocketLike s => s -> IO () + launchListener ∷ SocketLike s ⇒ s → IO () launchListener so - = do p <- SL.socketPort so + = do p ← SL.socketPort so -- FIXME: Don't throw away the thread ID as we can't -- kill it later then. [1] - _ <- forkIO $ httpLoop p so - return () + void $ forkIO $ httpLoop p so - listenOn :: Family -> HostName -> ServiceName -> IO Socket + listenOn ∷ Family → HostName → ServiceName → IO Socket listenOn fam host srv - = do proto <- getProtocolNumber "tcp" + = do proto ← getProtocolNumber "tcp" let hints = defaultHints { addrFlags = [AI_PASSIVE] , addrFamily = fam , addrSocketType = Stream , addrProtocol = proto } - addrs <- getAddrInfo (Just hints) (Just host) (Just srv) + addrs ← getAddrInfo (Just hints) (Just host) (Just srv) let addr = head addrs bracketOnError (socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)) sClose - (\ sock -> + (\ sock → do setSocketOption sock ReuseAddr 1 bindSocket sock (addrAddress addr) listen sock maxListenQueue return sock ) - httpLoop :: SocketLike s => PortNumber -> s -> IO () + httpLoop ∷ SocketLike s ⇒ PortNumber → s → IO () httpLoop port so - = do (h, addr) <- SL.accept so - tQueue <- newInteractionQueue - readerTID <- forkIO $ requestReader cnf tree fbs h port addr tQueue - _writerTID <- forkIO $ responseWriter cnf h tQueue readerTID + = do (h, addr) ← SL.accept so + tQueue ← newInteractionQueue + readerTID ← forkIO $ requestReader cnf tree fbs h port addr tQueue + _writerTID ← forkIO $ responseWriter cnf h tQueue readerTID httpLoop port so - waitForever :: IO () + waitForever ∷ IO () waitForever = forever (threadDelay 1000000) diff --git a/Network/HTTP/Lucu/Resource.hs b/Network/HTTP/Lucu/Resource.hs index 3a9890a..085b677 100644 --- a/Network/HTTP/Lucu/Resource.hs +++ b/Network/HTTP/Lucu/Resource.hs @@ -160,7 +160,7 @@ import qualified Data.Text.Encoding as T import Data.Time import qualified Data.Time.HTTP as HTTP import Network.HTTP.Lucu.Abortion -import Network.HTTP.Lucu.Authorization +import Network.HTTP.Lucu.Authentication import Network.HTTP.Lucu.Config import Network.HTTP.Lucu.ContentCoding import Network.HTTP.Lucu.ETag diff --git a/Network/HTTP/Lucu/SocketLike.hs b/Network/HTTP/Lucu/SocketLike.hs index 915f323..dd9c34b 100644 --- a/Network/HTTP/Lucu/SocketLike.hs +++ b/Network/HTTP/Lucu/SocketLike.hs @@ -8,37 +8,34 @@ module Network.HTTP.Lucu.SocketLike ( SocketLike(..) ) where - import qualified Network.Socket as So -import Network.HTTP.Lucu.HandleLike +import Network.HTTP.Lucu.HandleLike import qualified OpenSSL.Session as SSL +import Prelude.Unicode import qualified System.IO as I - -class (HandleLike (Handle s)) => SocketLike s where - type Handle s :: * - accept :: s -> IO (Handle s, So.SockAddr) - socketPort :: s -> IO So.PortNumber - +class (HandleLike (Handle s)) ⇒ SocketLike s where + type Handle s ∷ ★ + accept ∷ s → IO (Handle s, So.SockAddr) + socketPort ∷ s → IO So.PortNumber instance SocketLike So.Socket where type Handle So.Socket = I.Handle accept soSelf - = do (soPeer, addr) <- So.accept soSelf - hPeer <- So.socketToHandle soPeer I.ReadWriteMode + = do (soPeer, addr) ← So.accept soSelf + hPeer ← So.socketToHandle soPeer I.ReadWriteMode return (hPeer, addr) socketPort = So.socketPort - instance SocketLike (SSL.SSLContext, So.Socket) where type Handle (SSL.SSLContext, So.Socket) = SSL.SSL accept (ctx, soSelf) - = do (soPeer, addr) <- So.accept soSelf - ssl <- SSL.connection ctx soPeer + = do (soPeer, addr) ← So.accept soSelf + ssl ← SSL.connection ctx soPeer SSL.accept ssl return (ssl, addr) - socketPort = So.socketPort . snd \ No newline at end of file + socketPort = So.socketPort ∘ snd -- 2.40.0