From 9be2b946657c536a4363a076235f70728be087c4 Mon Sep 17 00:00:00 2001 From: PHO Date: Sat, 26 Nov 2011 15:15:10 +0900 Subject: [PATCH] examples Ditz-issue: e0312227f40a0fa92d4c5d69a64dad473f54389a --- examples/Implanted.hs | 8 +++--- examples/ImplantedSmall.hs | 9 ++++--- examples/Multipart.hs | 54 ++++++++++++++++++++------------------ examples/SSL.hs | 47 +++++++++++++++++---------------- 4 files changed, 63 insertions(+), 55 deletions(-) diff --git a/examples/Implanted.hs b/examples/Implanted.hs index 82d98e7..9259c13 100644 --- a/examples/Implanted.hs +++ b/examples/Implanted.hs @@ -1,12 +1,14 @@ {-# LANGUAGE UnicodeSyntax #-} +import qualified Data.Collections as C import MiseRafturai import Network.HTTP.Lucu main ∷ IO () -main = let config = defaultConfig { cnfServerPort = "9999" } - resources = mkResTree [ ([], miseRafturai) ] +main = let config = defaultConfig { cnfServerPort = "9999" } + tree ∷ ResourceTree + tree = C.fromList [ ([], nonGreedy miseRafturai) ] in do putStrLn "Access http://localhost:9999/ with your browser." - runHttpd config resources [] + runHttpd config $ resourceMap tree diff --git a/examples/ImplantedSmall.hs b/examples/ImplantedSmall.hs index a985cae..f7e8856 100644 --- a/examples/ImplantedSmall.hs +++ b/examples/ImplantedSmall.hs @@ -1,13 +1,14 @@ {-# LANGUAGE UnicodeSyntax #-} +import qualified Data.Collections as C import Network.HTTP.Lucu import SmallFile main ∷ IO () -main = let config = defaultConfig { cnfServerPort = "9999" } - resources = mkResTree [ ([], smallFile) ] +main = let config = defaultConfig { cnfServerPort = "9999" } + tree ∷ ResourceTree + tree = C.fromList [ ([], nonGreedy smallFile) ] in do putStrLn "Access http://localhost:9999/ with your browser." - runHttpd config resources [] - \ No newline at end of file + runHttpd config $ resourceMap tree diff --git a/examples/Multipart.hs b/examples/Multipart.hs index 8ddc618..49945ec 100644 --- a/examples/Multipart.hs +++ b/examples/Multipart.hs @@ -4,38 +4,40 @@ #-} import qualified Data.ByteString.Lazy.Char8 as Lazy import Control.Applicative +import qualified Data.Collections as C import Control.Monad.Unicode import Data.Maybe import Data.Monoid.Unicode import Network.HTTP.Lucu main ∷ IO () -main = let config = defaultConfig { cnfServerPort = "9999" } - resources = mkResTree [ ([], resMain) ] +main = let config = defaultConfig { cnfServerPort = "9999" } + tree ∷ ResourceTree + tree = C.fromList [ ([], nonGreedy resMain) ] in do putStrLn "Access http://localhost:9999/ with your browser." - runHttpd config resources [] + runHttpd config $ resourceMap tree - -resMain ∷ ResourceDef -resMain - = emptyResource { - resGet - = Just $ do setContentType $ parseMIMEType "text/html" - putChunks $ "Multipart Form Test\n" - ⊕ "
\n" - ⊕ " Upload some file:\n" - ⊕ " \n" - ⊕ " \n" - ⊕ " \n" - ⊕ "
\n" - , resPost - = Just $ do form ← getForm Nothing - let text = fromMaybe (∅) $ fdContent <$> lookup "text" form - file = fromMaybe (∅) $ fdContent <$> lookup "file" form - fileName = fdFileName =≪ lookup "file" form - setContentType $ parseMIMEType "text/plain" - putChunks $ "You entered \"" ⊕ text ⊕ "\".\n" - putChunks $ "You uploaded a " ⊕ Lazy.pack (show $ Lazy.length file) ⊕ " bytes long file.\n" - putChunks $ "The file name is " ⊕ Lazy.pack (show fileName) ⊕ ".\n" - } +resMain ∷ Resource +resMain = C.fromList + [ ( GET + , do setContentType $ parseMIMEType "text/html" + putChunks $ "Multipart Form Test\n" + ⊕ "
\n" + ⊕ " Upload some file:\n" + ⊕ " \n" + ⊕ " \n" + ⊕ " \n" + ⊕ "
\n" + ) + , ( POST + , do form ← getForm Nothing + let text = fromMaybe (∅) $ fdContent <$> lookup "text" form + file = fromMaybe (∅) $ fdContent <$> lookup "file" form + fileName = fdFileName =≪ lookup "file" form + setContentType $ parseMIMEType "text/plain" + putChunks $ "You entered \"" ⊕ text ⊕ "\".\n" + putChunks $ "You uploaded a " ⊕ Lazy.pack (show $ Lazy.length file) ⊕ " bytes long file.\n" + putChunks $ "The file name is " ⊕ Lazy.pack (show fileName) ⊕ ".\n" + ) + ] diff --git a/examples/SSL.hs b/examples/SSL.hs index b9b76a3..23de8b0 100644 --- a/examples/SSL.hs +++ b/examples/SSL.hs @@ -5,9 +5,10 @@ , UnicodeSyntax #-} import Control.Applicative -import "mtl" Control.Monad.Trans +import Control.Monad.IO.Class import Control.Monad.Unicode import qualified Data.ByteString.Lazy.Char8 as Lazy +import qualified Data.Collections as C import Data.Time.Clock import Network.HTTP.Lucu import OpenSSL @@ -26,29 +27,31 @@ main = withOpenSSL $ SSL.contextSetCertificate ctx cert SSL.contextSetDefaultCiphers ctx - let config = defaultConfig { - cnfServerPort = "9000" - , cnfSSLConfig = Just SSLConfig { - sslServerPort = "9001" - , sslContext = ctx - } - } - resources = mkResTree [ ([], helloWorld) ] + let config = defaultConfig { + cnfServerPort = "9000" + , cnfSSLConfig = Just SSLConfig { + sslServerPort = "9001" + , sslContext = ctx + } + } + tree ∷ ResourceTree + tree = C.fromList [ ([], nonGreedy helloWorld) ] putStrLn "Access https://localhost:9001/ with your browser." - runHttpd config resources [] + runHttpd config $ resourceMap tree -helloWorld ∷ ResourceDef +helloWorld ∷ Resource helloWorld - = emptyResource { - resGet - = Just $ 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.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 + ) + ] genCert ∷ KeyPair k ⇒ k → IO X509 genCert pkey @@ -61,4 +64,4 @@ genCert pkey setNotAfter cert =≪ addUTCTime (365 * 24 * 60 * 60) <$> getCurrentTime setPublicKey cert pkey signX509 cert pkey Nothing - return cert \ No newline at end of file + return cert -- 2.40.0