From: PHO Date: Wed, 30 Nov 2011 15:47:59 +0000 (+0900) Subject: docs X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=commitdiff_plain;h=fffa098;p=Lucu.git docs Ditz-issue: e0312227f40a0fa92d4c5d69a64dad473f54389a --- diff --git a/Network/HTTP/Lucu/Abortion.hs b/Network/HTTP/Lucu/Abortion.hs index 7b69fb5..db32c1d 100644 --- a/Network/HTTP/Lucu/Abortion.hs +++ b/Network/HTTP/Lucu/Abortion.hs @@ -2,8 +2,8 @@ FlexibleContexts , UnicodeSyntax #-} --- |Aborting the computation of 'Network.HTTP.Lucu.Resource.Resource' --- in any 'Prelude.IO' monads or arrows. +-- |Aborting the computation of 'Network.HTTP.Lucu.Rsrc' in any 'IO' +-- monads. module Network.HTTP.Lucu.Abortion ( Abortion , mkAbortion @@ -49,7 +49,7 @@ mkAbortion' sc msg } -- |Throw an 'Abortion' in a 'MonadIO', including the very --- 'Network.HTTP.Lucu.Resource.Resource' monad. +-- 'Network.HTTP.Lucu.Rsrc' monad. abort ∷ MonadIO m ⇒ Abortion → m a {-# INLINE abort #-} abort = liftIO ∘ throwIO diff --git a/Network/HTTP/Lucu/Abortion/Internal.hs b/Network/HTTP/Lucu/Abortion/Internal.hs index 573dff0..69d7a9e 100644 --- a/Network/HTTP/Lucu/Abortion/Internal.hs +++ b/Network/HTTP/Lucu/Abortion/Internal.hs @@ -26,12 +26,12 @@ import Text.XML.HXT.Arrow.XmlArrow import Text.XML.HXT.Arrow.XmlState -- |'Abortion' is an 'Exception' that aborts the execution of --- 'Network.HTTP.Lucu.Resource.Resource' monad with a 'StatusCode', --- additional response headers, and an optional message text. +-- 'Network.HTTP.Lucu.Rsrc' monad with a 'StatusCode', additional +-- response headers, and an optional message text. -- --- 1. If the 'Network.HTTP.Lucu.Resource.Resource' is in the /Deciding --- Header/ or any precedent states, throwing an 'Abortion' affects --- the HTTP response to be sent to the client. +-- 1. If the 'Network.HTTP.Lucu.Rsrc' is in the /Deciding Header/ or +-- any precedent states, throwing an 'Abortion' affects the HTTP +-- response to be sent to the client. -- -- 2. Otherwise it's too late to overwrite the HTTP response so the -- only possible thing the system can do is to dump the exception @@ -41,9 +41,11 @@ import Text.XML.HXT.Arrow.XmlState -- 'isError' so you can abuse this exception for redirections as well -- as error reporting e.g. -- --- > abort $ mkAbortion MovedPermanently --- > [("Location", "http://example.net/")] --- > "It has been moved to example.net" +-- @ +-- 'Network.HTTP.Lucu.abort' '$' 'Network.HTTP.Lucu.mkAbortion' 'MovedPermanently' +-- [(\"Location\", \"http://example.net/\")] +-- ('Just' \"It's been moved to example.net.\") +-- @ data Abortion = Abortion { aboStatus ∷ !SomeStatusCode , aboHeaders ∷ !Headers diff --git a/Network/HTTP/Lucu/Authentication.hs b/Network/HTTP/Lucu/Authentication.hs index 495c931..29ae0e9 100644 --- a/Network/HTTP/Lucu/Authentication.hs +++ b/Network/HTTP/Lucu/Authentication.hs @@ -27,7 +27,7 @@ import Prelude.Unicode -- |Authentication challenge to be sent to clients with -- \"WWW-Authenticate\" header field. See --- 'Network.HTTP.Lucu.Resource.setWWWAuthenticate'. +-- 'Network.HTTP.Lucu.setWWWAuthenticate'. data AuthChallenge = BasicAuthChallenge !Realm deriving (Eq) @@ -36,8 +36,7 @@ data AuthChallenge type Realm = Ascii -- |Authorization credential to be sent by client with --- \"Authorization\" header. See --- 'Network.HTTP.Lucu.Resource.getAuthorization'. +-- \"Authorization\" header. See 'Network.HTTP.Lucu.getAuthorization'. data AuthCredential = BasicAuthCredential !UserID !Password deriving (Show, Eq) diff --git a/Network/HTTP/Lucu/Config.hs b/Network/HTTP/Lucu/Config.hs index 80845bd..7a2d81f 100644 --- a/Network/HTTP/Lucu/Config.hs +++ b/Network/HTTP/Lucu/Config.hs @@ -120,3 +120,4 @@ defaultConfig = Config { , cnfDumpTooLateAbortionToStderr = True , cnfExtToMIMEType = defaultExtensionMap } +-- FIXME: use data-default. diff --git a/Network/HTTP/Lucu/Dispatcher/Internal.hs b/Network/HTTP/Lucu/Dispatcher/Internal.hs index 80effa7..6e088df 100644 --- a/Network/HTTP/Lucu/Dispatcher/Internal.hs +++ b/Network/HTTP/Lucu/Dispatcher/Internal.hs @@ -79,8 +79,8 @@ class ResourceMapper α where -- |Container type for the 'ResourceMapper' type class. data ResourceMap = ∀α. ResourceMapper α ⇒ RMap α --- |'ResourceTree' is an opaque structure which is a map from resource --- path to 'Resource'. +-- |'ResourceTree' is an opaque structure which a map from resource +-- 'Path' to 'ResourceNode'. -- -- @ -- 'fromList' [ ([] , 'nonGreedy' '$' 'Network.HTTP.Lucu.StaticFile.staticFile' \"\/usr\/include\/stdio.h\" ) -- \/ @@ -96,7 +96,8 @@ data ResourceMap = ∀α. ResourceMapper α ⇒ RMap α newtype ResourceTree = Tree (M.Map Path ResourceNode) deriving Monoid --- |FIXME: doc +-- |A node of 'Resource' located somewhere in a 'ResourceTree'. Such +-- nodes are either 'greedy' or 'nonGreedy'. data ResourceNode = Greedy { nResource ∷ !Resource } | NonGreedy { nResource ∷ !Resource } @@ -106,12 +107,13 @@ data ResourceNode -- Say a client is trying to access \"\/aaa\/bbb\/ccc\' while there is -- no resource node at the path. If there are greedy resource nodes at -- \"\/aaa\/bbb\", \"\/aaa\" or \"/\" they will be chosen instead as a --- fallback. Greedy resource nodes are searched in depth-first order. +-- fallback. Greedy resource nodes are searched in depth-first +-- order, just like CGI scripts. greedy ∷ Resource → ResourceNode {-# INLINE CONLIKE greedy #-} greedy = Greedy --- |FIXME: doc +-- |Make a normal, non-greedy resource node. nonGreedy ∷ Resource → ResourceNode {-# INLINE CONLIKE nonGreedy #-} nonGreedy = NonGreedy diff --git a/Network/HTTP/Lucu/Resource.hs b/Network/HTTP/Lucu/Resource.hs index 0ff5081..652c5f7 100644 --- a/Network/HTTP/Lucu/Resource.hs +++ b/Network/HTTP/Lucu/Resource.hs @@ -212,9 +212,8 @@ getRequestVersion ∷ Rsrc HttpVersion getRequestVersion = reqVersion <$> getRequest -- |This is an analogy of CGI PATH_INFO. 'getPathInfo' always returns --- @[]@ if the corresponding --- 'Network.HTTP.Lucu.Resource.Tree.Resource' is not greedy. See: --- 'getResourcePath' +-- @[]@ if the corresponding 'Resource' is not greedy. See +-- 'getResourcePath'. -- -- Note that the returned path components are URI-decoded. getPathInfo ∷ Rsrc [Strict.ByteString] @@ -667,7 +666,7 @@ setWWWAuthenticate = setHeader "WWW-Authenticate" ∘ printAuthChallenge -- |Write a chunk in 'Strict.ByteString' to the response body. You -- must first declare the response header \"Content-Type\" before --- applying this function. See: 'setContentType' +-- applying this function. See 'setContentType'. putChunk ∷ Strict.ByteString → Rsrc () putChunk = putBuilder ∘ BB.fromByteString @@ -675,7 +674,7 @@ putChunk = putBuilder ∘ BB.fromByteString -- 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: --- 'setContentType' +-- \"Content-Type\" before applying this function. See +-- 'setContentType'. putChunks ∷ Lazy.ByteString → Rsrc () putChunks = putBuilder ∘ BB.fromLazyByteString diff --git a/Network/HTTP/Lucu/Resource/Internal.hs b/Network/HTTP/Lucu/Resource/Internal.hs index f6d17b6..f5b54a9 100644 --- a/Network/HTTP/Lucu/Resource/Internal.hs +++ b/Network/HTTP/Lucu/Resource/Internal.hs @@ -261,25 +261,30 @@ getRequest ∷ Rsrc Request getRequest = niRequest <$> getInteraction -- |Get the path of this 'Rsrc' (to be exact, 'Resource') in the --- 'Network.HTTP.Lucu.Resource.Tree.ResTree'. The result of this +-- corresponding 'Network.HTTP.Lucu.ResourceTree'. The result of this -- action is the exact path in the tree even when the 'Resource' is --- greedy. +-- 'Network.HTTP.Lucu.greedy'. -- -- Example: -- --- > main = let tree = mkResTree [ (["foo"], resFoo) ] --- > in runHttpd defaultConfig tree [] --- > --- > resFoo = emptyResource { --- > resIsGreedy = True --- > , resGet = Just $ do requestURI <- getRequestURI --- > resourcePath <- getResourcePath --- > pathInfo <- getPathInfo --- > -- uriPath requestURI == "/foo/bar/baz" --- > -- resourcePath == ["foo"] --- > -- pathInfo == ["bar", "baz"] --- > ... --- > } +-- @ +-- 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 +-- +-- resFoo :: 'Resource' +-- resFoo = 'singleton' +-- ( 'GET' +-- , do requestURI <- 'getRequestURI' +-- resourcePath <- 'getResourcePath' +-- pathInfo <- 'getPathInfo' +-- -- 'Network.URI.uriPath' requestURI '==' \"/foo/bar/baz\" +-- -- resourcePath == ["foo"] +-- -- pathInfo == ["bar", "baz"] +-- ... +-- ) +-- @ getResourcePath ∷ Rsrc Path getResourcePath = niResourcePath <$> getInteraction @@ -330,7 +335,7 @@ setStatus sc -- |@'setHeader' name value@ declares the value of the response header -- @name@ as @value@. Note that this function is not intended to be -- used so frequently: there should be specialised functions like --- 'setContentType' for every common headers. +-- 'Network.HTTP.Lucu.setContentType' for every common headers. -- -- Some important headers (especially \"Content-Length\" and -- \"Transfer-Encoding\") may be silently dropped or overwritten by @@ -375,8 +380,8 @@ deleteHeader name = liftIO ∘ atomically ∘ go =≪ getInteraction -- infinitely long stream of octets. -- -- Note that you must first declare the response header --- \"Content-Type\" before applying this function. See: --- 'setContentType' +-- \"Content-Type\" before applying this function. See +-- 'Network.HTTP.Lucu.setContentType'. putBuilder ∷ Builder → Rsrc () putBuilder b = liftIO ∘ atomically ∘ go =≪ getInteraction where diff --git a/Network/HTTP/Lucu/Response.hs b/Network/HTTP/Lucu/Response.hs index 826cc0e..c18819f 100644 --- a/Network/HTTP/Lucu/Response.hs +++ b/Network/HTTP/Lucu/Response.hs @@ -92,32 +92,32 @@ printResponse (Response {..}) A.toAsciiBuilder "\x0D\x0A" ⊕ printHeaders resHeaders --- |@'isInformational' sc@ returns 'True' iff @sc < 200@. +-- |@'isInformational' sc@ returns 'True' iff @sc '<' 200@. isInformational ∷ StatusCode sc ⇒ sc → Bool {-# INLINE isInformational #-} isInformational = satisfy (< 200) --- |@'isSuccessful' sc@ returns 'True' iff @200 <= sc < 300@. +-- |@'isSuccessful' sc@ returns 'True' iff @200 '<=' sc '<' 300@. isSuccessful ∷ StatusCode sc ⇒ sc → Bool {-# INLINE isSuccessful #-} isSuccessful = satisfy (\ n → n ≥ 200 ∧ n < 300) --- |@'isRedirection' sc@ returns 'True' iff @300 <= sc < 400@. +-- |@'isRedirection' sc@ returns 'True' iff @300 '<=' sc '<' 400@. isRedirection ∷ StatusCode sc ⇒ sc → Bool {-# INLINE isRedirection #-} isRedirection = satisfy (\ n → n ≥ 300 ∧ n < 400) --- |@'isError' sc@ returns 'True' iff @400 <= sc@ +-- |@'isError' sc@ returns 'True' iff @400 '<=' sc@ isError ∷ StatusCode sc ⇒ sc → Bool {-# INLINE isError #-} isError = satisfy (≥ 400) --- |@'isClientError' sc@ returns 'True' iff @400 <= sc < 500@. +-- |@'isClientError' sc@ returns 'True' iff @400 '<=' sc '<' 500@. isClientError ∷ StatusCode sc ⇒ sc → Bool {-# INLINE isClientError #-} isClientError = satisfy (\ n → n ≥ 400 ∧ n < 500) --- |@'isServerError' sc@ returns 'True' iff @500 <= sc@. +-- |@'isServerError' sc@ returns 'True' iff @500 '<=' sc@. isServerError ∷ StatusCode sc ⇒ sc → Bool {-# INLINE isServerError #-} isServerError = satisfy (≥ 500) diff --git a/Network/HTTP/Lucu/StaticFile.hs b/Network/HTTP/Lucu/StaticFile.hs index 5ed214a..a1b6115 100644 --- a/Network/HTTP/Lucu/StaticFile.hs +++ b/Network/HTTP/Lucu/StaticFile.hs @@ -72,7 +72,9 @@ handleStaticFile sendContent path $ liftIO (LBS.readFile path) ≫= putChunks -- | @'staticDir' dir@ is a 'Resource' which maps all files in @dir@ --- and its subdirectories on the filesystem to the resource tree. +-- and its subdirectories on the filesystem to the resource tree. Thus +-- having 'Network.HTTP.Lucu.nonGreedy' 'staticDir' in a tree makes no +-- sense. -- -- Note that 'staticDir' currently doesn't have a directory-listing -- capability. Requesting the content of a directory will end up being diff --git a/Network/HTTP/Lucu/StatusCode/Internal.hs b/Network/HTTP/Lucu/StatusCode/Internal.hs index 24988ee..d6e892b 100644 --- a/Network/HTTP/Lucu/StatusCode/Internal.hs +++ b/Network/HTTP/Lucu/StatusCode/Internal.hs @@ -53,8 +53,8 @@ instance Eq SomeStatusCode where (SomeStatusCode α) == (SomeStatusCode β) = α ≈ β infix 4 ≈, ≉ --- |Two 'StatusCode's @a@ and @b@ are said to be equivalent iff --- @'numericCode' a '==' 'numericCode' b@. +-- |Equivalence of 'StatusCode's. Two 'StatusCode's @a@ and @b@ are +-- said to be equivalent iff @'numericCode' a '==' 'numericCode' b@. -- -- U+2248, ALMOST EQUAL TO (≈) ∷ (StatusCode α, StatusCode β) ⇒ α → β → Bool diff --git a/Network/HTTP/Lucu/Utils.hs b/Network/HTTP/Lucu/Utils.hs index 7623c70..9abaf1e 100644 --- a/Network/HTTP/Lucu/Utils.hs +++ b/Network/HTTP/Lucu/Utils.hs @@ -137,21 +137,21 @@ trim = reverse ∘ f ∘ reverse ∘ f f = dropWhile isSpace infixr 5 ⊲ --- | (B2;) = ('<|') +-- | (⊲) = ('<|') -- -- U+22B2, NORMAL SUBGROUP OF (⊲) ∷ Sequence α a ⇒ a → α → α (⊲) = (<|) infixl 5 ⊳ --- | (B3;) = ('|>') +-- | (⊳) = ('|>') -- -- U+22B3, CONTAINS AS NORMAL SUBGROUP (⊳) ∷ Sequence α a ⇒ α → a → α (⊳) = (|>) infixr 5 ⋈ --- | (C8;) = ('><') +-- | (⋈) = ('><') -- -- U+22C8, BOWTIE (⋈) ∷ Sequence α a ⇒ α → α → α diff --git a/examples/SSL.hs b/examples/SSL.hs index 624ed04..aa8b3a5 100644 --- a/examples/SSL.hs +++ b/examples/SSL.hs @@ -42,17 +42,16 @@ main = withOpenSSL $ helloWorld ∷ Resource helloWorld - = C.fromList - [ ( GET - , do setContentType [mimeType| text/plain |] - putChunk "getRemoteCertificate = " - cert ← do cert ← getRemoteCertificate - case cert of - Just c → liftIO $ Lazy.pack <$> printX509 c - Nothing → return "Nothing" - putChunks cert - ) - ] + = C.singleton + ( GET + , do setContentType [mimeType| text/plain |] + putChunk "getRemoteCertificate = " + cert ← do cert ← getRemoteCertificate + case cert of + Just c → liftIO $ Lazy.pack <$> printX509 c + Nothing → return "Nothing" + putChunks cert + ) genCert ∷ KeyPair k ⇒ k → IO X509 genCert pkey