hlint

[Lucu.git] / examples / SSL.hs

diff --git a/examples/SSL.hs b/examples/SSL.hs
index 48b23813fbee4f2a746b2940fadf9252cba06965..f78b6c229939c49825fb6ab612ddf783066b3abf 100644 (file)
--- a/examples/SSL.hs
+++ b/examples/SSL.hs
@@ -1,19 +1,23 @@
 {-# LANGUAGE
     OverloadedStrings
   , PackageImports
 {-# LANGUAGE
     OverloadedStrings
   , PackageImports

+  , QuasiQuotes

   , UnicodeSyntax
   #-}
 import Control.Applicative
   , 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 Control.Monad.Unicode
 import qualified Data.ByteString.Lazy.Char8 as Lazy

+import qualified Data.Collections as C

 import Data.Time.Clock
 import Data.Time.Clock

+import Network

 import Network.HTTP.Lucu
 import OpenSSL
 import OpenSSL.EVP.PKey
 import OpenSSL.RSA
 import qualified OpenSSL.Session as SSL
 import OpenSSL.X509
 import Network.HTTP.Lucu
 import OpenSSL
 import OpenSSL.EVP.PKey
 import OpenSSL.RSA
 import qualified OpenSSL.Session as SSL
 import OpenSSL.X509

+import Prelude.Unicode

 
 main ∷ IO ()
 main = withOpenSSL $
 
 main ∷ IO ()
 main = withOpenSSL $


@@ -25,29 +29,30 @@ main = withOpenSSL $
           SSL.contextSetCertificate    ctx cert
           SSL.contextSetDefaultCiphers ctx
 
           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."
           putStrLn "Access https://localhost:9001/ with your browser."

-          runHttpd config resources []
+          withSocketsDo ∘ runHttpd config $ resourceMap tree

 
 

-helloWorld ∷ ResourceDef
+helloWorld ∷ Resource

 helloWorld 
 helloWorld 

-    = emptyResource {
-        resGet
-          = Just $ do setContentType $ parseMIMEType "text/plain"
-                      outputChunk "getRemoteCertificate = "
-                      cert ← do cert ← getRemoteCertificate
-                                case cert of
-                                  Just c  → liftIO $ Lazy.pack <$> printX509 c
-                                  Nothing → return "Nothing"
-                      outputChunk 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
 
 genCert ∷ KeyPair k ⇒ k → IO X509
 genCert pkey


@@ -60,4 +65,4 @@ genCert pkey
          setNotAfter     cert =≪ addUTCTime (365 * 24 * 60 * 60) <$> getCurrentTime
          setPublicKey    cert pkey
          signX509        cert pkey Nothing
          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