6 import Control.Applicative
7 import "mtl" Control.Monad.Trans
8 import Control.Monad.Unicode
9 import qualified Data.ByteString.Lazy.Char8 as Lazy
10 import Data.Time.Clock
11 import Network.HTTP.Lucu
13 import OpenSSL.EVP.PKey
15 import qualified OpenSSL.Session as SSL
22 key ← generateRSAKey 1024 3 Nothing
24 SSL.contextSetPrivateKey ctx key
25 SSL.contextSetCertificate ctx cert
26 SSL.contextSetDefaultCiphers ctx
28 let config = defaultConfig {
29 cnfServerPort = "9000"
30 , cnfSSLConfig = Just SSLConfig {
31 sslServerPort = "9001"
35 resources = mkResTree [ ([], helloWorld) ]
36 putStrLn "Access https://localhost:9001/ with your browser."
37 runHttpd config resources []
39 helloWorld ∷ ResourceDef
43 = Just $ do setContentType $ parseMIMEType "text/plain"
44 putChunk "getRemoteCertificate = "
45 cert ← do cert ← getRemoteCertificate
47 Just c → liftIO $ Lazy.pack <$> printX509 c
48 Nothing → return "Nothing"
52 genCert ∷ KeyPair k ⇒ k → IO X509
56 setSerialNumber cert 1
57 setIssuerName cert [("CN", "localhost")]
58 setSubjectName cert [("CN", "localhost")]
59 setNotBefore cert =≪ addUTCTime (-1) <$> getCurrentTime
60 setNotAfter cert =≪ addUTCTime (365 * 24 * 60 * 60) <$> getCurrentTime
61 setPublicKey cert pkey
62 signX509 cert pkey Nothing