From 9668dc27a02b59d7bfb1e9e40af3d2619700ad69 Mon Sep 17 00:00:00 2001 From: PHO Date: Tue, 25 Oct 2011 00:48:12 +0900 Subject: [PATCH] Haddock overhaul Ditz-issue: 8959dadc07db1bd363283dee401073f6e48dc7fa --- Lucu.cabal | 2 +- Network/HTTP/Lucu.hs | 13 +++--- Network/HTTP/Lucu/Authentication.hs | 20 ++++----- Network/HTTP/Lucu/Config.hs | 59 +++++++++++++------------- Network/HTTP/Lucu/ETag.hs | 17 +++++--- Network/HTTP/Lucu/HttpVersion.hs | 28 ++++++------ Network/HTTP/Lucu/MIMEType.hs | 13 +++--- Network/HTTP/Lucu/MIMEType/Guess.hs | 12 +++--- Network/HTTP/Lucu/Parser/Http.hs | 19 +++++---- Network/HTTP/Lucu/RFC2231.hs | 6 ++- Network/HTTP/Lucu/Request.hs | 5 ++- Network/HTTP/Lucu/Resource.hs | 37 +++++++++------- Network/HTTP/Lucu/Resource/Internal.hs | 11 +++-- Network/HTTP/Lucu/Response.hs | 7 +-- Network/HTTP/Lucu/StaticFile.hs | 2 +- 15 files changed, 134 insertions(+), 117 deletions(-) diff --git a/Lucu.cabal b/Lucu.cabal index 28b9741..cd69066 100644 --- a/Lucu.cabal +++ b/Lucu.cabal @@ -7,7 +7,7 @@ Description: It's not a replacement for Apache nor lighttpd. It is intended to be used to build an efficient web-based RESTful application which runs behind a reverse-proxy so it doesn't have some - functionalities like logging, client filtering or such like. + functionalities like logging, client filtering and such. Version: 1.0 License: PublicDomain diff --git a/Network/HTTP/Lucu.hs b/Network/HTTP/Lucu.hs index e5d9276..901ae00 100644 --- a/Network/HTTP/Lucu.hs +++ b/Network/HTTP/Lucu.hs @@ -12,9 +12,9 @@ -- Socket Layer. -- -- Lucu is not a replacement for Apache or 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 --- the following (otherwise essential) functionalities: +-- be used to build an efficient web-based RESTful application which +-- runs behind a reverse-proxy so it doesn't have the following +-- (otherwise essential) functionalities: -- -- [/Logging/] Lucu doesn't write logs of any requests from any -- clients. @@ -46,11 +46,8 @@ module Network.HTTP.Lucu -- *** Status Code , StatusCode(..) - -- *** Abortion - , Abortion - , mkAbortion - , mkAbortion' - , abort + -- *** 'Abortion' + , module Network.HTTP.Lucu.Abortion -- *** ETag , ETag(..) diff --git a/Network/HTTP/Lucu/Authentication.hs b/Network/HTTP/Lucu/Authentication.hs index 7479188..3f8d762 100644 --- a/Network/HTTP/Lucu/Authentication.hs +++ b/Network/HTTP/Lucu/Authentication.hs @@ -2,7 +2,7 @@ OverloadedStrings , UnicodeSyntax #-} --- |Manipulation of WWW authentication. +-- |HTTP Authentication module Network.HTTP.Lucu.Authentication ( AuthChallenge(..) , AuthCredential(..) @@ -14,6 +14,7 @@ module Network.HTTP.Lucu.Authentication , authCredentialP ) where +import Control.Monad import Data.Ascii (Ascii) import qualified Data.Ascii as A import Data.Attoparsec.Char8 @@ -24,14 +25,14 @@ import Network.HTTP.Lucu.Parser.Http import Network.HTTP.Lucu.Utils import Prelude.Unicode --- |Authorization challenge to be sent to client with --- \"WWW-Authenticate\" header. See +-- |Authentication challenge to be sent to clients with +-- \"WWW-Authenticate\" header field. See -- 'Network.HTTP.Lucu.Resource.setWWWAuthenticate'. data AuthChallenge = BasicAuthChallenge !Realm deriving (Eq) --- |'Realm' is just a string which must not contain any non-ASCII letters. +-- |'Realm' is just an 'Ascii' string. type Realm = Ascii -- |Authorization credential to be sent by client with @@ -41,12 +42,10 @@ data AuthCredential = BasicAuthCredential !UserID !Password deriving (Show, Eq) --- |'UserID' is just a string which must not contain colon and any --- non-ASCII letters. -type UserID = Ascii +-- |'UserID' is just an 'Ascii' string containing no colons (\':\'). +type UserID = Ascii --- |'Password' is just a string which must not contain any non-ASCII --- letters. +-- |'Password' is just an 'Ascii' string. type Password = Ascii -- |Convert an 'AuthChallenge' to 'Ascii'. @@ -55,9 +54,10 @@ printAuthChallenge (BasicAuthChallenge realm) = A.fromAsciiBuilder $ A.toAsciiBuilder "Basic realm=" ⊕ quoteStr realm +-- |'Parser' for an 'AuthCredential'. authCredentialP ∷ Parser AuthCredential authCredentialP - = do _ ← string "Basic" + = do void $ string "Basic" skipMany1 lws b64 ← takeWhile1 base64 case C8.break (≡ ':') (B64.decodeLenient b64) of diff --git a/Network/HTTP/Lucu/Config.hs b/Network/HTTP/Lucu/Config.hs index cdeef3b..68bc365 100644 --- a/Network/HTTP/Lucu/Config.hs +++ b/Network/HTTP/Lucu/Config.hs @@ -2,7 +2,7 @@ OverloadedStrings , UnicodeSyntax #-} --- |Configurations for the Lucu httpd like a port to listen. +-- |Configurations for the Lucu httpd. module Network.HTTP.Lucu.Config ( Config(..) , SSLConfig(..) @@ -19,18 +19,18 @@ import Network.HTTP.Lucu.MIMEType.DefaultExtensionMap import OpenSSL.Session import System.IO.Unsafe --- |Configuration record for the Lucu httpd. You need to use --- 'defaultConfig' or setup your own configuration to run the httpd. +-- |Configuration record for to run the httpd. data Config = Config { - -- |A string which will be sent to clients as \"Server\" field. + -- |A banner string to be sent to clients with \"Server\" response + -- header field. cnfServerSoftware ∷ !Ascii -- |The host name of the server. This value will be used in -- built-in pages like \"404 Not Found\". , cnfServerHost ∷ !Text - -- |A port number (or service name) to listen to HTTP clients. + -- |A port number (or a service name) to listen to HTTP clients. , cnfServerPort ∷ !ServiceName -- |Local IPv4 address to listen to both HTTP and HTTPS @@ -41,55 +41,54 @@ data Config = Config { -- |Local IPv6 address to listen to both HTTP and HTTPS -- clients. Set this to @('Just' "::")@ if you want to accept any -- IPv6 connections. Set this to 'Nothing' to disable IPv6. Note - -- that there is currently no way to assign separate ports to IPv4 - -- and IPv6 server sockets. + -- that there is currently no ways to assign separate ports to + -- IPv4 and IPv6 server sockets (but I don't think that will be a + -- problem.) , cnfServerV6Addr ∷ !(Maybe HostName) -- |Configuration for HTTPS connections. Set this 'Nothing' to -- disable HTTPS. , cnfSSLConfig ∷ !(Maybe SSLConfig) - -- |The maximum number of requests to accept in one connection - -- simultaneously. If a client exceeds this limitation, its last + -- |The maximum number of requests to simultaneously accept in one + -- connection. If a client exceeds this limitation, its last -- request won't be processed until a response for its earliest -- pending request is sent back to the client. , cnfMaxPipelineDepth ∷ !Int - -- |The maximum length of request entity to accept in bytes. Note - -- that this is nothing but a default value which is used when - -- 'Network.HTTP.Lucu.Resource.getForm' and such like are applied - -- to 'Network.HTTP.Lucu.Resource.defaultLimit', so there is no - -- guarantee that this value always constrains all the requests. + -- |The maximum length of request entity to accept in octets. Note + -- that this is nothing but a default value used by + -- 'Network.HTTP.Lucu.Resource.getForm' and such when they are + -- applied to 'Network.HTTP.Lucu.Resource.defaultLimit', so there + -- is no guarantee that this value always constrains all the + -- requests. , cnfMaxEntityLength ∷ !Int - -- | Whether to dump too late abortion to the stderr or not. See + -- |Whether to dump too late abortions to the stderr or not. See -- 'Network.HTTP.Lucu.Abortion.abort'. , cnfDumpTooLateAbortionToStderr ∷ !Bool - -- |A mapping from extension to MIME Type. This value is used by - -- 'Network.HTTP.Lucu.StaticFile.staticFile' to guess the MIME - -- Type of static files. Note that MIME Types are currently - -- guessed only by file name. + -- |A mapping table from file extensions to MIME Types. This value + -- is used by 'Network.HTTP.Lucu.StaticFile.staticFile' to guess + -- the MIME Type of static files. Note that MIME Types are + -- currently guessed only by file name. -- - -- Guessing by file magic is indeed a wonderful idea but that is - -- not implemented (yet). But, don't you think it's better a file - -- system got a MIME Type as a part of inode? Or it might be a - -- good idea to use GnomeVFS - -- () - -- instead of vanilla FS. + -- Guessing by file magic might be a good idea but that's not + -- implemented (yet). , cnfExtToMIMEType ∷ !ExtMap } -- |Configuration record for HTTPS connections. data SSLConfig = SSLConfig { - -- |A port ID to listen to HTTPS clients. Local addresses - -- (both for IPv4 and IPv6) will be derived from the parent - -- 'Config'. + -- |A port number (or a service name) to listen to HTTPS + -- clients. Local addresses (both for IPv4 and IPv6) will be + -- derived from the parent 'Config'. sslServerPort ∷ !ServiceName - -- |An SSL context for accepting connections. - , sslContext ∷ !SSLContext + -- |An SSL context for accepting connections. You must set it + -- up yourself with at least a server certification. + , sslContext ∷ !SSLContext } -- |The default configuration. Generally you can use this value as-is, diff --git a/Network/HTTP/Lucu/ETag.hs b/Network/HTTP/Lucu/ETag.hs index f7ef838..d4a157f 100644 --- a/Network/HTTP/Lucu/ETag.hs +++ b/Network/HTTP/Lucu/ETag.hs @@ -2,7 +2,7 @@ OverloadedStrings , UnicodeSyntax #-} --- |Manipulation of entity tags. +-- |Entity tags module Network.HTTP.Lucu.ETag ( ETag(..) , parseETag @@ -24,17 +24,18 @@ import Network.HTTP.Lucu.Parser.Http hiding (token) import Network.HTTP.Lucu.Utils import Prelude.Unicode --- |An entity tag is made of a weakness flag and a opaque string. +-- |An entity tag consists of a weakness flag and an opaque string. data ETag = ETag { -- |The weakness flag. Weak tags looks like W\/\"blahblah\" and - -- strong tags are like \"blahblah\". + -- strong tags are like \"blahblah\". See: + -- etagIsWeak ∷ !Bool -- |An opaque string. Only characters from 0x20 (sp) to 0x7e (~) -- are allowed. , etagToken ∷ !Ascii } deriving (Eq, Show) --- |Convert an 'ETag' to 'AsciiBuilder'. +-- |Convert an 'ETag' to an 'AsciiBuilder'. printETag ∷ ETag → AsciiBuilder {-# INLINEABLE printETag #-} printETag et @@ -61,24 +62,26 @@ parseETag str endOfInput return et --- |This is equivalent to @'ETag' 'Prelude.False'@. If you want to --- generate an ETag from a file, try using +-- |This is equivalent to @'ETag' 'False'@. If you want to generate an +-- ETag from a file, try using -- 'Network.HTTP.Lucu.StaticFile.generateETagFromFile'. strongETag ∷ Ascii → ETag {-# INLINE strongETag #-} strongETag = ETag False --- |This is equivalent to @'ETag' 'Prelude.True'@. +-- |This is equivalent to @'ETag' 'True'@. weakETag ∷ Ascii → ETag {-# INLINE weakETag #-} weakETag = ETag True +-- |'Parser' for an 'ETag'. eTagP ∷ Parser ETag {-# INLINEABLE eTagP #-} eTagP = do isWeak ← option False (string "W/" *> return True) str ← quotedStr return $ ETag isWeak str +-- |'Parser' for a list of 'ETag's. eTagListP ∷ Parser [ETag] {-# INLINEABLE eTagListP #-} eTagListP = do xs ← listOf eTagP diff --git a/Network/HTTP/Lucu/HttpVersion.hs b/Network/HTTP/Lucu/HttpVersion.hs index 9ad1c0a..2029a7f 100644 --- a/Network/HTTP/Lucu/HttpVersion.hs +++ b/Network/HTTP/Lucu/HttpVersion.hs @@ -2,11 +2,12 @@ OverloadedStrings , UnicodeSyntax #-} --- |Manipulation of HTTP version string. +-- |HTTP version number module Network.HTTP.Lucu.HttpVersion ( HttpVersion(..) - , httpVersionP , printHttpVersion + + , httpVersionP ) where import qualified Blaze.Text.Int as BT @@ -18,7 +19,7 @@ import Data.Attoparsec.Char8 import Data.Monoid.Unicode import Prelude hiding (min) --- |@'HttpVersion' major minor@ represents \"HTTP\/major.minor\". +-- |An HTTP version consists of major and minor versions. data HttpVersion = HttpVersion !Int !Int deriving (Eq, Show) @@ -31,24 +32,25 @@ instance Ord HttpVersion where | minA < minB = LT | otherwise = EQ -httpVersionP ∷ Parser HttpVersion -httpVersionP = string "HTTP/" - *> - choice [ string "1.1" *> pure (HttpVersion 1 1) - , string "1.0" *> pure (HttpVersion 1 0) - , HttpVersion <$> decimal ⊛ (char '.' *> decimal) - ] - -- |Convert an 'HttpVersion' to 'AsciiBuilder'. printHttpVersion ∷ HttpVersion → AsciiBuilder printHttpVersion v = case v of - -- 頻出するので高速化 + -- Optimisation for special cases. HttpVersion 1 0 → A.toAsciiBuilder "HTTP/1.0" HttpVersion 1 1 → A.toAsciiBuilder "HTTP/1.1" - -- 一般の場合 + -- General cases. HttpVersion maj min → A.toAsciiBuilder "HTTP/" ⊕ A.unsafeFromBuilder (BT.integral maj) ⊕ A.toAsciiBuilder "." ⊕ A.unsafeFromBuilder (BT.integral min) + +-- |'Parser' for an 'HttpVersion'. +httpVersionP ∷ Parser HttpVersion +httpVersionP = string "HTTP/" + *> + choice [ string "1.1" *> pure (HttpVersion 1 1) + , string "1.0" *> pure (HttpVersion 1 0) + , HttpVersion <$> decimal ⊛ (char '.' *> decimal) + ] diff --git a/Network/HTTP/Lucu/MIMEType.hs b/Network/HTTP/Lucu/MIMEType.hs index 36cdf0f..4b509bf 100644 --- a/Network/HTTP/Lucu/MIMEType.hs +++ b/Network/HTTP/Lucu/MIMEType.hs @@ -3,7 +3,7 @@ , UnicodeSyntax #-} --- |Manipulation of MIME Types. +-- |MIME Types module Network.HTTP.Lucu.MIMEType ( MIMEType(..) , mkMIMEType @@ -27,8 +27,8 @@ import Network.HTTP.Lucu.RFC2231 import Prelude hiding (min) import Prelude.Unicode --- |@'MIMEType' \"major\" \"minor\" [(\"name\", \"value\")]@ --- represents \"major\/minor; name=value\". +-- |@'MIMEType' \"major\" \"minor\" [(\"name\", \"value\"), ...]@ +-- represents \"major\/minor; name=value; ...\". data MIMEType = MIMEType { mtMajor ∷ !CIAscii , mtMinor ∷ !CIAscii @@ -38,13 +38,14 @@ data MIMEType = MIMEType { instance Show MIMEType where show = A.toString ∘ A.fromAsciiBuilder ∘ printMIMEType --- |Construct a 'MIMEType' without any parameters. +-- |@'mkMIMEType' major minor@ returns a 'MIMEType' with the given +-- @major@ and @minor@ types but without any parameters. mkMIMEType ∷ CIAscii → CIAscii → MIMEType {-# INLINE mkMIMEType #-} mkMIMEType maj min = MIMEType maj min (∅) --- |Convert a 'MIMEType' to 'AsciiBuilder'. +-- |Convert a 'MIMEType' to an 'AsciiBuilder'. printMIMEType ∷ MIMEType → AsciiBuilder {-# INLINEABLE printMIMEType #-} printMIMEType (MIMEType maj min params) @@ -68,6 +69,7 @@ parseMIMEType str endOfInput return t +-- |'Parser' for an 'MIMEType'. mimeTypeP ∷ Parser MIMEType {-# INLINEABLE mimeTypeP #-} mimeTypeP = do maj ← A.toCIAscii <$> token @@ -76,6 +78,7 @@ mimeTypeP = do maj ← A.toCIAscii <$> token params ← paramsP return $ MIMEType maj min params +-- |'Parser' for a list of 'MIMEType's. mimeTypeListP ∷ Parser [MIMEType] {-# INLINE mimeTypeListP #-} mimeTypeListP = listOf mimeTypeP diff --git a/Network/HTTP/Lucu/MIMEType/Guess.hs b/Network/HTTP/Lucu/MIMEType/Guess.hs index eabc06f..f0f93b1 100644 --- a/Network/HTTP/Lucu/MIMEType/Guess.hs +++ b/Network/HTTP/Lucu/MIMEType/Guess.hs @@ -1,8 +1,8 @@ {-# LANGUAGE UnicodeSyntax #-} --- |MIME Type guessing by a file extension. This is a poor man's way --- of guessing MIME Types. It is simple and fast. +-- |Guessing MIME Types by file extensions. It's not always accurate +-- but simple and fast. -- -- In general you don't have to use this module directly. module Network.HTTP.Lucu.MIMEType.Guess @@ -33,10 +33,10 @@ import Network.HTTP.Lucu.MIMEType import Prelude.Unicode import System.FilePath --- |'Map' from extension to 'MIMEType'. +-- |A 'Map' from file extensions to 'MIMEType's. type ExtMap = Map Text MIMEType --- |Guess the MIME Type of file. +-- |Guess the MIME Type of a file. guessTypeByFileName ∷ ExtMap → FilePath → Maybe MIMEType guessTypeByFileName extMap fpath = case takeExtension fpath of @@ -112,8 +112,8 @@ compile = go (∅) ∘ concat ∘ map tr -- -- * A definition of module named @moduleName@. -- --- * @variableName :: 'ExtMap'@ whose content is a serialization of --- @extMap@. +-- * @variableName :: 'ExtMap'@ whose content is the serialised +-- @extMap@. -- -- The module "Network.HTTP.Lucu.MIMEType.DefaultExtensionMap" is -- surely generated using this function. diff --git a/Network/HTTP/Lucu/Parser/Http.hs b/Network/HTTP/Lucu/Parser/Http.hs index 4153dcb..e3fbf35 100644 --- a/Network/HTTP/Lucu/Parser/Http.hs +++ b/Network/HTTP/Lucu/Parser/Http.hs @@ -47,7 +47,7 @@ import qualified Data.Sequence as S import Data.Sequence.Unicode hiding ((∅)) import Prelude.Unicode --- |@'isCtl' c@ is 'Prelude.False' iff @0x20 <= c < 0x7F@. +-- |@'isCtl' c@ returns 'False' iff @0x20 <= c < 0x7F@. isCtl ∷ Char → Bool {-# INLINE isCtl #-} isCtl c @@ -60,7 +60,7 @@ isText ∷ Char → Bool {-# INLINE isText #-} isText = (¬) ∘ isCtl --- |@'isSeparator' c@ is 'Prelude.True' iff c is one of HTTP +-- |@'isSeparator' c@ returns 'True' iff c is one of the HTTP -- separators. isSeparator ∷ Char → Bool {-# INLINE isSeparator #-} @@ -69,12 +69,12 @@ isSeparator = flip FS.memberChar set {-# NOINLINE set #-} set = FS.charClass "()<>@,;:\\\"/[]?={}\x20\x09" --- |@'isChar' c@ is 'Prelude.True' iff @c <= 0x7f@. +-- |@'isChar' c@ returns 'True' iff @c <= 0x7f@. isChar ∷ Char → Bool {-# INLINE isChar #-} isChar = (≤ '\x7F') --- |@'isToken' c@ is equivalent to @not ('isCtl' c || 'isSeparator' +-- |@'isToken' c@ is equivalent to @not ('isCtl' c '||' 'isSeparator' -- c)@ isToken ∷ Char → Bool {-# INLINE isToken #-} @@ -89,7 +89,7 @@ listOf p = do skipMany lws _ ← char ',' skipMany lws --- |'token' is similar to @'takeWhile1' 'isToken'@ +-- |'token' is almost the same as @'takeWhile1' 'isToken'@ token ∷ Parser Ascii {-# INLINE token #-} token = A.unsafeFromByteString <$> takeWhile1 isToken @@ -118,7 +118,7 @@ isSPHT '\x20' = True isSPHT '\x09' = True isSPHT _ = False --- |@'separators'@ is similar to @'takeWhile1' 'isSeparator'@. +-- |@'separators'@ is almost the same as @'takeWhile1' 'isSeparator'@. separators ∷ Parser Ascii {-# INLINE separators #-} separators = A.unsafeFromByteString <$> takeWhile1 isSeparator @@ -158,8 +158,8 @@ qvalue = do x ← char '0' return (y:ys) return $ read (x:xs) --- |@'atMost' n v@ is like @'P.many' v@ but applies the given action --- at most @n@ times. +-- |@'atMost' n v@ is like @'P.many' v@ but accumulates @v@ at most +-- @n@ times. atMost ∷ Alternative f ⇒ Int → f a → f [a] {-# INLINE atMost #-} atMost 0 _ = pure [] @@ -167,7 +167,6 @@ atMost n v = ( (:) <$> v ⊛ atMost (n-1) v ) <|> pure [] - data CharAccumState = CharAccumState { casChunks ∷ !(S.Seq BS.ByteString) @@ -210,6 +209,8 @@ finish cas in str +-- |@'manyCharsTill' p end@ takes as many characters untill @p@ +-- succeeds. manyCharsTill ∷ ∀m b. (Monad m, Alternative m) ⇒ m Char → m b diff --git a/Network/HTTP/Lucu/RFC2231.hs b/Network/HTTP/Lucu/RFC2231.hs index 1302e59..ee929ad 100644 --- a/Network/HTTP/Lucu/RFC2231.hs +++ b/Network/HTTP/Lucu/RFC2231.hs @@ -7,7 +7,9 @@ #-} -- |Provide functionalities to encode/decode MIME parameter values in -- character sets other than US-ASCII. See: --- http://www.faqs.org/rfcs/rfc2231.html +-- +-- +-- You usually don't have to use this module directly. module Network.HTTP.Lucu.RFC2231 ( printParams , paramsP @@ -42,6 +44,7 @@ import Prelude hiding (concat, mapM, takeWhile) import Prelude.Unicode import System.IO.Unsafe +-- |Convert parameter values to an 'AsciiBuilder'. printParams ∷ Map CIAscii Text → AsciiBuilder printParams params | M.null params = (∅) @@ -112,6 +115,7 @@ section ∷ ExtendedParam → Integer section (InitialEncodedParam {..}) = 0 section ep = epSection ep +-- |'Parser' for parameter values. paramsP ∷ Parser (Map CIAscii Text) paramsP = decodeParams =≪ P.many (try paramP) diff --git a/Network/HTTP/Lucu/Request.hs b/Network/HTTP/Lucu/Request.hs index 66511e2..853907a 100644 --- a/Network/HTTP/Lucu/Request.hs +++ b/Network/HTTP/Lucu/Request.hs @@ -25,7 +25,7 @@ import Network.URI import Prelude.Unicode -- |This is the definition of HTTP request methods, which shouldn't --- require any description. +-- require any descriptions. data Method = OPTIONS | GET | HEAD @@ -37,7 +37,7 @@ data Method = OPTIONS | ExtensionMethod !Ascii deriving (Eq, Show) --- |This is the definition of HTTP reqest. +-- |This is the definition of an HTTP reqest. data Request = Request { reqMethod ∷ !Method @@ -61,6 +61,7 @@ reqMustHaveBody (reqMethod → m) | m ≡ PUT = True | otherwise = False +-- |'Parser' for a 'Request'. requestP ∷ Parser Request requestP = do skipMany crlf (method, uri, version) ← requestLineP diff --git a/Network/HTTP/Lucu/Resource.hs b/Network/HTTP/Lucu/Resource.hs index 314e1f5..d61f2f4 100644 --- a/Network/HTTP/Lucu/Resource.hs +++ b/Network/HTTP/Lucu/Resource.hs @@ -28,8 +28,8 @@ -- /Examining Request/ and the final state is /Done/. -- -- [/Examining Request/] In this state, a 'Resource' looks at the --- request header fields and thinks about a corresponding entity for --- it. If there is a suitable entity, the 'Resource' tells the +-- request header fields and thinks about the corresponding entity +-- for it. If there is a suitable entity, the 'Resource' tells the -- system an entity tag and its last modification time -- ('foundEntity'). If it found no entity, it tells the system so -- ('foundNoEntity'). In case it is impossible to decide the @@ -41,11 +41,11 @@ -- socket, the system sends \"100 Continue\" to the client if need -- be. When a 'Resource' transits to the next state without -- receiving all or part of a request body, the system automatically --- receives and discards it. +-- discards it. -- --- [/Deciding Header/] A 'Resource' makes a decision of status code --- and response header fields. When it transits to the next state, --- the system validates and completes the response header fields and +-- [/Deciding Header/] A 'Resource' makes a decision of response +-- status code and header fields. When it transits to the next +-- state, the system validates and completes the header fields and -- then sends them to the client. -- -- [/Sending Body/] In this state, a 'Resource' asks the system to @@ -103,6 +103,7 @@ module Network.HTTP.Lucu.Resource , foundETag , foundTimeStamp , foundNoEntity + , foundNoEntity' -- * Receiving a request body -- |These functions make the 'Resource' transit to the /Receiving @@ -127,8 +128,9 @@ module Network.HTTP.Lucu.Resource , deleteHeader -- * Sending a response body - -- |These functions make the 'Resource' transit to the /Sending - -- Body/ state. + + -- |These functions make the 'Resource' transit to the + -- /Sending Body/ state. , putChunk , putChunks , putBuilder @@ -239,7 +241,7 @@ toPairWithFormData (name, value) -- |@'getHeader' name@ returns the value of the request header field -- @name@. Comparison of header name is case-insensitive. Note that -- this function is not intended to be used so frequently: there --- should be actions like 'getContentType' for every common headers. +-- should be functions like 'getContentType' for every common headers. getHeader ∷ CIAscii → Resource (Maybe Ascii) getHeader name = H.getHeader name <$> getRequest @@ -297,7 +299,8 @@ getAcceptEncoding toTuple (AcceptEncoding {..}) = (aeEncoding, aeQValue) --- |Return 'True' iff a given content-coding is acceptable. +-- |Return 'True' iff a given content-coding is acceptable by the +-- client. isEncodingAcceptable ∷ CIAscii → Resource Bool isEncodingAcceptable encoding = any doesMatch <$> getAcceptEncoding where @@ -519,6 +522,11 @@ foundNoEntity msgM driftTo ReceivingBody +-- |'foundNoEntity'' is the same as @'foundNoEntity' 'Nothing'@. +foundNoEntity' ∷ Resource () +{-# INLINE foundNoEntity' #-} +foundNoEntity' = foundNoEntity Nothing + -- |@'getChunks' limit@ attemts to read the entire request body up to -- @limit@ bytes, and then make the 'Resource' transit to the @@ -530,8 +538,8 @@ foundNoEntity msgM -- When the @limit@ is 'Nothing', 'getChunks' uses the default -- limitation value ('cnfMaxEntityLength') instead. -- --- 'getChunks' returns a 'Lazy.ByteString' but it's not really lazy: --- reading from the socket just happens at the computation of +-- 'getChunks' returns a lazy 'Lazy.ByteString' but it's not really +-- lazy: reading from the socket just happens at the computation of -- 'getChunks', not at the evaluation of the 'Lazy.ByteString'. getChunks ∷ Maybe Int → Resource Lazy.ByteString getChunks (Just n) @@ -681,9 +689,8 @@ setWWWAuthenticate = setHeader "WWW-Authenticate" ∘ printAuthChallenge putChunk ∷ Strict.ByteString → Resource () putChunk = putBuilder ∘ BB.fromByteString --- |Write a chunk in 'Lazy.ByteString' to the response body. It is --- safe to apply this function to an infinitely long --- 'Lazy.ByteString'. +-- |Write a chunk in lazy 'Lazy.ByteString' to the response body. It +-- can be safely applied to an infinitely long 'Lazy.ByteString'. -- -- Note that you must first declare the response header -- \"Content-Type\" before applying this function. See diff --git a/Network/HTTP/Lucu/Resource/Internal.hs b/Network/HTTP/Lucu/Resource/Internal.hs index a1ad956..e8aa3ef 100644 --- a/Network/HTTP/Lucu/Resource/Internal.hs +++ b/Network/HTTP/Lucu/Resource/Internal.hs @@ -90,9 +90,9 @@ data ResourceDef = ResourceDef { -- resource path. If 'resGet' is Nothing, the system responds -- \"405 Method Not Allowed\" for GET requests. -- - -- It also runs for HEAD request if the 'resHead' is Nothing. In - -- this case 'output' and such like don't actually write a - -- response body. + -- It also runs for HEAD request if the 'resHead' is 'Nothing'. In + -- that case 'putChunk' and such don't actually write a response + -- body. , resGet ∷ !(Maybe (Resource ())) -- |A 'Resource' to be run when a HEAD request comes for the -- resource path. If 'resHead' is Nothing, the system runs @@ -257,7 +257,7 @@ getRequest = niRequest <$> getInteraction -- > main = let tree = mkResTree [ (["foo"], resFoo) ] -- > in runHttpd defaultConfig tree [] -- > --- > resFoo = ResourceDef { +-- > resFoo = emptyResource { -- > resIsGreedy = True -- > , resGet = Just $ do requestURI <- getRequestURI -- > resourcePath <- getResourcePath @@ -266,7 +266,6 @@ getRequest = niRequest <$> getInteraction -- > -- resourcePath == ["foo"] -- > -- pathInfo == ["bar", "baz"] -- > ... --- > , ... -- > } getResourcePath ∷ Resource [Strict.ByteString] getResourcePath = niResourcePath <$> getInteraction @@ -362,7 +361,7 @@ deleteHeader name writeTVar niResponseHasCType False -- |Run a 'Builder' to construct a chunk, and write it to the response --- body. It is safe to apply this function to a 'Builder' producing an +-- body. It can be safely applied to a 'Builder' producing an -- infinitely long stream of octets. -- -- Note that you must first declare the response header diff --git a/Network/HTTP/Lucu/Response.hs b/Network/HTTP/Lucu/Response.hs index e2b76fa..5c25b54 100644 --- a/Network/HTTP/Lucu/Response.hs +++ b/Network/HTTP/Lucu/Response.hs @@ -37,8 +37,8 @@ import Network.HTTP.Lucu.Utils import Prelude.Unicode -- |This is the definition of HTTP status code. --- 'Network.HTTP.Lucu.Resource.setStatus' accepts these named statuses --- so you don't have to memorize, for instance, that \"Gateway +-- 'Network.HTTP.Lucu.Resource.setStatus' accepts these named status +-- codes so you don't have to memorize, for instance, that \"Gateway -- Timeout\" is 504. data StatusCode = Continue | SwitchingProtocols @@ -92,7 +92,7 @@ data StatusCode = Continue | InsufficientStorage deriving (Eq, Show, Typeable) --- |Convert a 'StatusCode' to 'AsciiBuilder'. +-- |Convert a 'StatusCode' to an 'AsciiBuilder'. printStatusCode ∷ StatusCode → AsciiBuilder {-# INLINEABLE printStatusCode #-} printStatusCode (statusCode → (# num, msg #)) @@ -101,6 +101,7 @@ printStatusCode (statusCode → (# num, msg #)) A.toAsciiBuilder msg ) +-- |This is the definition of an HTTP response. data Response = Response { resVersion ∷ !HttpVersion , resStatus ∷ !StatusCode diff --git a/Network/HTTP/Lucu/StaticFile.hs b/Network/HTTP/Lucu/StaticFile.hs index d79fc4f..f0e9bd8 100644 --- a/Network/HTTP/Lucu/StaticFile.hs +++ b/Network/HTTP/Lucu/StaticFile.hs @@ -52,7 +52,7 @@ handleStaticFile ∷ Bool → FilePath → Resource () handleStaticFile sendContent path = do exists ← liftIO $ fileExist path unless exists - $ foundNoEntity Nothing + foundNoEntity' readable ← liftIO $ fileAccess path True False False unless readable -- 2.40.0