, 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 qualified Data.Collections as C
+import Data.Default
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 Prelude.Unicode
main ∷ IO ()
main = withOpenSSL $
SSL.contextSetCertificate ctx cert
SSL.contextSetDefaultCiphers ctx
- let config = defaultConfig {
- cnfServerPort = "9000"
- , cnfSSLConfig = Just SSLConfig {
- sslServerPort = "9001"
- , sslContext = ctx
- }
- }
- resources = mkResTree [ ([], helloWorld) ]
+ let config = def {
+ cnfServerPort = "9000"
+ , cnfSSLConfig = Just SSLConfig {
+ sslServerPort = "9001"
+ , sslContext = ctx
+ }
+ }
+ tree ∷ ResourceTree
+ tree = C.fromList [ ([], nonGreedy helloWorld) ]
putStrLn "Access https://localhost:9001/ with your browser."
- runHttpd config resources []
+ withSocketsDo ∘ runHttpd config $ resourceMap tree
-helloWorld ∷ ResourceDef
+helloWorld ∷ Resource
helloWorld
- = 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
- }
+ = 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
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