X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=examples%2FSSL.hs;h=48b23813fbee4f2a746b2940fadf9252cba06965;hp=436749fdc01fe7a2a081fec88831414d815c5fe5;hb=ac2ff93;hpb=fc4e0252eed3c9cb43c250ea7dd29ef5dffa6dad

diff --git a/examples/SSL.hs b/examples/SSL.hs
index 436749f..48b2381 100644
--- a/examples/SSL.hs
+++ b/examples/SSL.hs
@@ -1,20 +1,26 @@
-{-# LANGUAGE PackageImports #-}
-import           Control.Monad
-import "mtl"     Control.Monad.Trans
-import           Data.Time.Clock
-import           Network.HTTP.Lucu
-import           OpenSSL
-import           OpenSSL.EVP.PKey
-import           OpenSSL.RSA
+{-# LANGUAGE
+    OverloadedStrings
+  , PackageImports
+  , 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
@@ -26,42 +32,32 @@ main = withOpenSSL $
                                             , 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"
+    = emptyResource {
+        resGet
+          = Just $ do setContentType $ parseMIMEType "text/plain"
                       outputChunk "getRemoteCertificate = "
-                      cert <- do c <- getRemoteCertificate
-                                 case c of
-                                   Just c  -> liftIO $ printX509 c
-                                   Nothing -> return "Nothing"
+                      cert ← do cert ← getRemoteCertificate
+                                case cert of
+                                  Just c  → liftIO $ Lazy.pack <$> printX509 c
+                                  Nothing → return "Nothing"
                       outputChunk cert
-      , resHead   = Nothing
-      , resPost   = Nothing
-      , resPut    = Nothing
-      , resDelete = Nothing
       }
 
-
-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