Unfoldable Dispatcher

[Lucu.git] / examples / SSL.hs

diff --git a/examples/SSL.hs b/examples/SSL.hs
index 129316eba787f1e26ed7fbe88667bb6d96e7abd5..b9b76a3919e7c12f7930c08b2714f5d47d568637 100644 (file)
--- a/examples/SSL.hs
+++ b/examples/SSL.hs
@@ -1,68 +1,64 @@
-{-# LANGUAGE PackageImports #-}
-import           Control.Monad
-import "mtl"     Control.Monad.Trans
-import           Data.Time.Clock
-import           Network
-import           Network.HTTP.Lucu
-import           OpenSSL
-import           OpenSSL.EVP.PKey
-import           OpenSSL.RSA
+{-# LANGUAGE
+    OverloadedStrings
+  , PackageImports
+  , QuasiQuotes
+  , UnicodeSyntax
+  #-}
+import Control.Applicative
+import "mtl" Control.Monad.Trans
+import Control.Monad.Unicode
+import qualified Data.ByteString.Lazy.Char8 as Lazy
+import Data.Time.Clock
+import Network.HTTP.Lucu
+import OpenSSL
+import OpenSSL.EVP.PKey
+import OpenSSL.RSA
 import qualified OpenSSL.Session as SSL
-import           OpenSSL.X509
+import OpenSSL.X509
 
-main :: IO ()
+main ∷ IO ()
 main = withOpenSSL $
-       do ctx  <- SSL.context
+       do ctx  ← SSL.context
 
-          key  <- generateRSAKey 1024 3 Nothing
-          cert <- genCert key
+          key  ← generateRSAKey 1024 3 Nothing
+          cert ← genCert key
           SSL.contextSetPrivateKey     ctx key
           SSL.contextSetCertificate    ctx cert
           SSL.contextSetDefaultCiphers ctx
 
           let config    = defaultConfig {
-                            cnfServerPort = PortNumber 9000
+                            cnfServerPort = "9000"
                           , cnfSSLConfig  = Just SSLConfig {
-                                              sslServerPort = PortNumber 9001
+                                              sslServerPort = "9001"
                                             , sslContext    = ctx
                                             }
                           }
-              resources = mkResTree [ ( []
-                                      , helloWorld )
-                                    ]
+              resources = mkResTree [ ([], helloWorld) ]
           putStrLn "Access https://localhost:9001/ with your browser."
           runHttpd config resources []
 
-
-helloWorld :: ResourceDef
+helloWorld ∷ ResourceDef
 helloWorld 
-    = ResourceDef {
-        resUsesNativeThread = False
-      , resIsGreedy         = False
-      , resGet
-          = Just $ do setContentType $ read "text/plain"
-                      outputChunk "getRemoteCertificate = "
-                      cert <- do c <- getRemoteCertificate
-                                 case c of
-                                   Just c  -> liftIO $ printX509 c
-                                   Nothing -> return "Nothing"
-                      outputChunk cert
-      , resHead   = Nothing
-      , resPost   = Nothing
-      , resPut    = Nothing
-      , resDelete = Nothing
+    = 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
       }
 
-
-genCert :: KeyPair k => k -> IO X509
+genCert ∷ KeyPair k ⇒ k → IO X509
 genCert pkey
-    = do cert <- newX509
+    = do cert ← newX509
          setVersion      cert 2
          setSerialNumber cert 1
          setIssuerName   cert [("CN", "localhost")]
          setSubjectName  cert [("CN", "localhost")]
-         setNotBefore    cert =<< liftM (addUTCTime (-1)) getCurrentTime
-         setNotAfter     cert =<< liftM (addUTCTime (365 * 24 * 60 * 60)) getCurrentTime
+         setNotBefore    cert =≪ addUTCTime (-1)                 <$> getCurrentTime
+         setNotAfter     cert =≪ addUTCTime (365 * 24 * 60 * 60) <$> getCurrentTime
          setPublicKey    cert pkey
          signX509        cert pkey Nothing
          return cert
\ No newline at end of file