use time-http 0.5

[Lucu.git] / examples / SSL.hs

diff --git a/examples/SSL.hs b/examples/SSL.hs
index 23de8b04062c4d6b48b80b2b525ae913aab7610c..cbf75dc8aa4bd46fb8ef4ca9ce7de588d39cd666 100644 (file)
--- a/examples/SSL.hs
+++ b/examples/SSL.hs
@@ -9,13 +9,16 @@ import Control.Monad.IO.Class
 import Control.Monad.Unicode
 import qualified Data.ByteString.Lazy.Char8 as Lazy
 import qualified Data.Collections as C
 import Control.Monad.Unicode
 import qualified Data.ByteString.Lazy.Char8 as Lazy
 import qualified Data.Collections as C

+import Data.Default

 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 $


@@ -27,7 +30,7 @@ main = withOpenSSL $
           SSL.contextSetCertificate    ctx cert
           SSL.contextSetDefaultCiphers ctx
 
           SSL.contextSetCertificate    ctx cert
           SSL.contextSetDefaultCiphers ctx
 

-          let config = defaultConfig {
+          let config = def {

                          cnfServerPort = "9000"
                        , cnfSSLConfig  = Just SSLConfig {
                                            sslServerPort = "9001"
                          cnfServerPort = "9000"
                        , cnfSSLConfig  = Just SSLConfig {
                                            sslServerPort = "9001"


@@ -37,21 +40,20 @@ main = withOpenSSL $
               tree   ∷ ResourceTree
               tree   = C.fromList [ ([], nonGreedy helloWorld) ]
           putStrLn "Access https://localhost:9001/ with your browser."
               tree   ∷ ResourceTree
               tree   = C.fromList [ ([], nonGreedy helloWorld) ]
           putStrLn "Access https://localhost:9001/ with your browser."

-          runHttpd config $ resourceMap tree
+          withSocketsDo ∘ runHttpd config $ resourceMap tree

 
 helloWorld ∷ Resource
 helloWorld 
 
 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
 
 genCert ∷ KeyPair k ⇒ k → IO X509
 genCert pkey