Lucu 0.2.1 → 0.3

raw patch · 20 files changed

+351/−49 lines, 20 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Lucu.cabal +8/−1
• NEWS +10/−0
• Network/HTTP/Lucu.hs +6/−2
• Network/HTTP/Lucu/Config.hs +16/−1
• Network/HTTP/Lucu/HandleLike.hs +68/−0
• Network/HTTP/Lucu/Headers.hs +7/−7
• Network/HTTP/Lucu/HttpVersion.hs +5/−5
• Network/HTTP/Lucu/Httpd.hs +32/−10
• Network/HTTP/Lucu/Interaction.hs +6/−4
• Network/HTTP/Lucu/RequestReader.hs +7/−5
• Network/HTTP/Lucu/Resource.hs +15/−0
• Network/HTTP/Lucu/Response.hs +5/−5
• Network/HTTP/Lucu/ResponseWriter.hs +8/−7
• examples/Implanted.hs +11/−0
• examples/ImplantedSmall.hs +11/−0
• examples/Makefile +3/−2
• examples/Multipart.hs +35/−0
• examples/SSL.hs +67/−0
• examples/mise-rafturai.html +30/−0
• examples/small-file.txt +1/−0

@@ -8,7 +8,7 @@         messing around FastCGI. It is also intended to be run behind a         reverse-proxy so it doesn't have some facilities like logging,         client filtering or such like.-Version: 0.2.1+Version: 0.3 License: PublicDomain License-File: COPYING Author: PHO <pho at cielonegro dot org>@@ -25,7 +25,13 @@     data/CompileMimeTypes.hs     data/mime.types     examples/HelloWorld.hs+    examples/Implanted.hs+    examples/ImplantedSmall.hs     examples/Makefile+    examples/Multipart.hs+    examples/SSL.hs+    examples/mise-rafturai.html+    examples/small-file.txt  Source-Repository head     Type: darcs@@ -65,6 +71,7 @@         Network.HTTP.Lucu.ContentCoding         Network.HTTP.Lucu.DefaultPage         Network.HTTP.Lucu.Format+        Network.HTTP.Lucu.HandleLike         Network.HTTP.Lucu.Headers         Network.HTTP.Lucu.Interaction         Network.HTTP.Lucu.MultipartForm

@@ -1,3 +1,13 @@+Changes from 0.2.1 to 0.3+-------------------------+* Added SSL support:+    - Network.HTTP.Lucu.Config.Config has a new member:+        # cnfSSLConfig+    - Network.HTTP.Lucu.Resource has a new action:+        # getRemoteCertificate+    - examples/SSL.hs:+        an example for accepting HTTPS connections.+ Changes from 0.2 to 0.2.1 ------------------------- * Fixed incorrect dependency declaration in Lucu.cabal. No semantical

@@ -10,6 +10,12 @@ --   CGI. It just spawns a new thread. Inter-process communication is --   done with STM. --+--   [/Affinity for RESTafarians/] Lucu is a carefully designed+--   web server for RESTful applications.+--+--   [/SSL connections/] Lucu can handle HTTP connections over SSL+--   layer.+-- -- Lucu is not a replacement for Apache. It is intended to be used to -- create an efficient web-based application without messing around -- FastCGI. It is also intended to be run behind a reverse-proxy so it@@ -19,8 +25,6 @@ -- --   [/Client Filtering/] Lucu always accepts any clients. No IP --   filter is implemented.------   [/SSL Support/] Lucu can handle only HTTP. -- --   [/Bandwidth Limitting/] Lucu doesn't limit bandwidth it consumes. --

@@ -1,6 +1,7 @@ -- |Configurations for the Lucu httpd like a port to listen. module Network.HTTP.Lucu.Config     ( Config(..)+    , SSLConfig(..)     , defaultConfig     )     where@@ -11,6 +12,7 @@ import           Network.BSD import           Network.HTTP.Lucu.MIMEType.Guess import           Network.HTTP.Lucu.MIMEType.DefaultExtensionMap+import           OpenSSL.Session import           System.IO.Unsafe  -- |Configuration record for the Lucu httpd. You need to use@@ -23,6 +25,9 @@     , cnfServerHost :: !Strict.ByteString     -- |A port ID to listen to HTTP clients.     , cnfServerPort :: !PortID+    -- |Configuration for HTTPS connections. Set this 'Nothing' to+    -- disable HTTPS.+    , cnfSSLConfig :: !(Maybe SSLConfig)     -- |The maximum number of requests to accept in one connection     -- simultaneously. If a client exceeds this limitation, its last     -- request won't be processed until a response for its earliest@@ -56,14 +61,24 @@     , cnfExtToMIMEType :: !ExtMap     } +-- |Configuration record for HTTPS connections.+data SSLConfig+    = SSLConfig {+        -- |A port ID to listen to HTTPS clients.+        sslServerPort :: !PortID+        -- |An SSL context for accepting connections.+      , sslContext    :: !SSLContext+      }+ -- |The default configuration. Generally you can use this value as-is, -- or possibly you just want to replace the 'cnfServerSoftware' and--- 'cnfServerPort'.+-- 'cnfServerPort'. SSL connections are disabled by default. defaultConfig :: Config defaultConfig = Config {                   cnfServerSoftware              = C8.pack "Lucu/1.0"                 , cnfServerHost                  = C8.pack (unsafePerformIO getHostName)                 , cnfServerPort                  = Service "http"+                , cnfSSLConfig                   = Nothing                 , cnfMaxPipelineDepth            = 100                 , cnfMaxEntityLength             = 16 * 1024 * 1024 -- 16 MiB                 , cnfMaxOutputChunkLength        = 5 * 1024 * 1024  -- 5 MiB

@@ -0,0 +1,68 @@+module Network.HTTP.Lucu.HandleLike+    ( HandleLike(..)+    )+    where++import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy.Char8 as L+import qualified OpenSSL.Session as SSL+import           OpenSSL.X509+import qualified System.IO as I+++class HandleLike h where+    hGetLBS :: h -> IO L.ByteString+    hPutLBS :: h -> L.ByteString -> IO ()++    hGetBS  :: h -> Int -> IO B.ByteString+    hPutBS  :: h -> B.ByteString -> IO ()++    hPutChar  :: h -> Char -> IO ()++    hPutStr   :: h -> String -> IO ()+    hPutStrLn :: h -> String -> IO ()++    hGetPeerCert :: h -> IO (Maybe X509)+    hGetPeerCert = const $ return Nothing++    hFlush  :: h -> IO ()+    hClose  :: h -> IO ()+++instance HandleLike I.Handle where+    hGetLBS = L.hGetContents+    hPutLBS = L.hPut++    hGetBS  = B.hGet+    hPutBS  = B.hPut++    hPutChar  = I.hPutChar++    hPutStr   = I.hPutStr+    hPutStrLn = I.hPutStrLn++    hFlush  = I.hFlush+    hClose  = I.hClose+++instance HandleLike SSL.SSL where+    hGetLBS   = SSL.lazyRead+    hPutLBS   = SSL.lazyWrite++    hGetBS    = SSL.read+    hPutBS    = SSL.write++    hPutChar  s = hPutLBS s . L.singleton++    hPutStr   s = hPutLBS s . L.pack+    hPutStrLn s = hPutLBS s . L.pack . (++ "\n")++    hGetPeerCert s+        = do isValid <- SSL.getVerifyResult s+             if isValid then+                 SSL.getPeerCertificate s+               else+                 return Nothing++    hFlush _  = return () -- unneeded+    hClose s  = SSL.shutdown s SSL.Bidirectional

@@ -25,10 +25,10 @@ import           Foreign.ForeignPtr import           Foreign.Ptr import           Foreign.Storable+import           Network.HTTP.Lucu.HandleLike import           Network.HTTP.Lucu.Parser import           Network.HTTP.Lucu.Parser.Http import           Network.HTTP.Lucu.Utils-import           System.IO  type Headers = Map NCBS Strict.ByteString newtype NCBS = NCBS Strict.ByteString@@ -205,15 +205,15 @@                                else c)  -hPutHeaders :: Handle -> Headers -> IO ()+hPutHeaders :: HandleLike h => h -> Headers -> IO () hPutHeaders h hds     = h `seq` hds `seq`-      mapM_ putH (M.toList hds) >> C8.hPut h (C8.pack "\r\n")+      mapM_ putH (M.toList hds) >> hPutBS h (C8.pack "\r\n")     where       putH :: (NCBS, Strict.ByteString) -> IO ()       putH (name, value)           = name `seq` value `seq`-            do C8.hPut h (fromNCBS name)-               C8.hPut h (C8.pack ": ")-               C8.hPut h value-               C8.hPut h (C8.pack "\r\n")+            do hPutBS h (fromNCBS name)+               hPutBS h (C8.pack ": ")+               hPutBS h value+               hPutBS h (C8.pack "\r\n")

@@ -9,9 +9,9 @@     where  import qualified Data.ByteString.Char8 as C8+import           Network.HTTP.Lucu.HandleLike import           Network.HTTP.Lucu.Parser import           Prelude hiding (min)-import           System.IO  -- |@'HttpVersion' major minor@ represents \"HTTP\/major.minor\". data HttpVersion = HttpVersion !Int !Int@@ -45,15 +45,15 @@                       ]  -hPutHttpVersion :: Handle -> HttpVersion -> IO ()+hPutHttpVersion :: HandleLike h => h -> HttpVersion -> IO () hPutHttpVersion !h !v     = case v of         -- 頻出するので高速化-        HttpVersion 1 0 -> C8.hPut h (C8.pack "HTTP/1.0")-        HttpVersion 1 1 -> C8.hPut h (C8.pack "HTTP/1.1")+        HttpVersion 1 0 -> hPutBS h (C8.pack "HTTP/1.0")+        HttpVersion 1 1 -> hPutBS h (C8.pack "HTTP/1.1")         -- 一般の場合         HttpVersion !maj !min-            -> do C8.hPut  h (C8.pack "HTTP/")+            -> do hPutBS   h (C8.pack "HTTP/")                   hPutStr  h (show maj)                   hPutChar h '.'                   hPutStr  h (show min)

@@ -13,6 +13,7 @@ import           Network.HTTP.Lucu.RequestReader import           Network.HTTP.Lucu.Resource.Tree import           Network.HTTP.Lucu.ResponseWriter+import qualified OpenSSL.Session as SSL import           System.IO import           System.Posix.Signals @@ -53,21 +54,42 @@ runHttpd cnf tree fbs     = withSocketsDo $       do installHandler sigPIPE Ignore Nothing-         so <- listenOn (cnfServerPort cnf)-         loop so++         case cnfSSLConfig cnf of+           Nothing+               -> return ()+           Just scnf+               -> do so       <- listenOn (sslServerPort scnf)+                     _loopTID <- forkIO $ httpsLoop (sslContext scnf) so+                     return ()+         +         httpLoop =<< listenOn (cnfServerPort cnf)     where-      loop :: Socket -> IO ()-      loop so-          -- 本當は Network.accept を使ひたいが、このアクションは勝手に-          -- リモートのIPを逆引きするので、使へない。-          = do (h, addr)  <- accept' so+      httpLoop :: Socket -> IO ()+      httpLoop so+          = do (h, addr)  <- acceptHTTP so                tQueue     <- newInteractionQueue                readerTID  <- forkIO $ requestReader cnf tree fbs h addr tQueue                _writerTID <- forkIO $ responseWriter cnf h tQueue readerTID-               loop so+               httpLoop so -      accept' :: Socket -> IO (Handle, So.SockAddr)-      accept' soSelf+      httpsLoop :: SSL.SSLContext -> Socket -> IO ()+      httpsLoop ctx so+          = do (ssl, addr) <- acceptHTTPS ctx so+               tQueue      <- newInteractionQueue+               readerTID   <- forkIO $ requestReader cnf tree fbs ssl addr tQueue+               _writerTID  <- forkIO $ responseWriter cnf ssl tQueue readerTID+               httpsLoop ctx so++      acceptHTTP :: Socket -> IO (Handle, So.SockAddr)+      acceptHTTP soSelf           = do (soPeer, addr) <- So.accept soSelf                hPeer          <- So.socketToHandle soPeer ReadWriteMode                return (hPeer, addr)++      acceptHTTPS :: SSL.SSLContext -> Socket -> IO (SSL.SSL, So.SockAddr)+      acceptHTTPS ctx so+          = do (so', addr) <- So.accept so+               ssl         <- SSL.connection ctx so'+               SSL.accept ssl+               return (ssl, addr)

@@ -27,10 +27,12 @@ import           Network.HTTP.Lucu.HttpVersion import           Network.HTTP.Lucu.Request import           Network.HTTP.Lucu.Response+import           OpenSSL.X509  data Interaction = Interaction {       itrConfig       :: !Config     , itrRemoteAddr   :: !SockAddr+    , itrRemoteCert   :: !(Maybe X509)     , itrResourcePath :: !(Maybe [String])     , itrRequest      :: !(TVar (Maybe Request)) -- FIXME: TVar である必要無し     , itrResponse     :: !(TVar Response)@@ -80,10 +82,9 @@ defaultPageContentType = C8.pack "application/xhtml+xml"  -newInteraction :: Config -> SockAddr -> Maybe Request -> IO Interaction-newInteraction conf addr req-    = conf `seq` addr `seq` req `seq`-      do request  <- newTVarIO $ req+newInteraction :: Config -> SockAddr -> Maybe X509 -> Maybe Request -> IO Interaction+newInteraction !conf !addr !cert !req+    = do request  <- newTVarIO $ req          responce <- newTVarIO $ Response {                        resVersion = HttpVersion 1 1                      , resStatus  = Ok@@ -117,6 +118,7 @@          return $ Interaction {                       itrConfig       = conf                     , itrRemoteAddr   = addr+                    , itrRemoteCert   = cert                     , itrResourcePath = Nothing                     , itrRequest      = request                     , itrResponse     = responce

@@ -16,6 +16,7 @@ import           Network.HTTP.Lucu.Config import           Network.HTTP.Lucu.Chunk import           Network.HTTP.Lucu.DefaultPage+import           Network.HTTP.Lucu.HandleLike import           Network.HTTP.Lucu.Interaction import           Network.HTTP.Lucu.Parser import           Network.HTTP.Lucu.Postprocess@@ -24,12 +25,12 @@ import           Network.HTTP.Lucu.Response import           Network.HTTP.Lucu.Resource.Tree import           Prelude hiding (catch)-import           System.IO+import           System.IO (stderr)  -requestReader :: Config -> ResTree -> [FallbackHandler] -> Handle -> SockAddr -> InteractionQueue -> IO ()+requestReader :: HandleLike h => Config -> ResTree -> [FallbackHandler] -> h -> SockAddr -> InteractionQueue -> IO () requestReader !cnf !tree !fbs !h !addr !tQueue-    = do input <- B.hGetContents h+    = do input <- hGetLBS h          acceptRequest input       `catches`       [ Handler (( \ _                   -> return () ) :: IOException -> IO ())@@ -58,7 +59,7 @@       acceptNonparsableRequest :: StatusCode -> IO ()       acceptNonparsableRequest status           = {-# SCC "acceptNonparsableRequest" #-}-            do itr <- newInteraction cnf addr Nothing+            do itr <- newInteraction cnf addr Nothing Nothing                atomically $ do updateItr itr itrResponse                                              $ \ res -> res {                                                           resStatus = status@@ -72,7 +73,8 @@       acceptParsableRequest :: Request -> ByteString -> IO ()       acceptParsableRequest req input           = {-# SCC "acceptParsableRequest" #-}-            do itr <- newInteraction cnf addr (Just req)+            do cert <- hGetPeerCert h+               itr  <- newInteraction cnf addr cert (Just req)                action                    <- atomically $                       do preprocess itr

@@ -73,6 +73,7 @@     , getConfig     , getRemoteAddr     , getRemoteAddr'+    , getRemoteCertificate     , getRequest     , getMethod     , getRequestURI@@ -163,6 +164,7 @@ import           Network.HTTP.Lucu.Utils import           Network.Socket hiding (accept) import           Network.URI hiding (path)+import           OpenSSL.X509  -- |The 'Resource' monad. This monad implements -- 'Control.Monad.Trans.MonadIO' so it can do any 'Prelude.IO'@@ -224,6 +226,19 @@                       _                           -> undefined +-- | Return the X.509 certificate of the client, or 'Nothing' if:+--+--   * This request didn't came through an SSL stream.+--+--   * The client didn't send us its certificate.+--+--   * The 'OpenSSL.Session.VerificationMode' of+--     'OpenSSL.Session.SSLContext' in+--     'Network.HTTP.Lucu.Config.SSLConfig' has not been set to+--     'OpenSSL.Session.VerifyPeer'.+getRemoteCertificate :: Resource (Maybe X509)+getRemoteCertificate = do itr <- getInteraction+                          return $! itrRemoteCert itr  -- |Get the 'Network.HTTP.Lucu.Request.Request' value which represents -- the request header. In general you don't have to use this action.

@@ -19,9 +19,9 @@ import qualified Data.ByteString.Char8 as C8 hiding (ByteString) import           Data.Dynamic import           Network.HTTP.Lucu.Format+import           Network.HTTP.Lucu.HandleLike import           Network.HTTP.Lucu.Headers import           Network.HTTP.Lucu.HttpVersion-import           System.IO  -- |This is the definition of HTTP status code. -- 'Network.HTTP.Lucu.Resource.setStatus' accepts these named statuses@@ -97,23 +97,23 @@     setHeaders res hdr = res { resHeaders = hdr }  -hPutResponse :: Handle -> Response -> IO ()+hPutResponse :: HandleLike h => h -> Response -> IO () hPutResponse h res     = h `seq` res `seq`       do hPutHttpVersion h (resVersion res)          hPutChar        h ' '          hPutStatus      h (resStatus  res)-         C8.hPut         h (C8.pack "\r\n")+         hPutBS          h (C8.pack "\r\n")          hPutHeaders     h (resHeaders res) -hPutStatus :: Handle -> StatusCode -> IO ()+hPutStatus :: HandleLike h => h -> StatusCode -> IO () hPutStatus h sc     = h `seq` sc `seq`       case statusCode sc of         (# num, msg #)             -> do hPutStr  h (fmtDec 3 num)                   hPutChar h ' '-                  C8.hPut  h msg+                  hPutBS   h msg   -- |@'isInformational' sc@ is 'Prelude.True' iff @sc < 200@.

@@ -12,16 +12,17 @@ import           Data.Sequence (ViewR(..)) import           Network.HTTP.Lucu.Config import           Network.HTTP.Lucu.Format+import           Network.HTTP.Lucu.HandleLike import           Network.HTTP.Lucu.Headers import           Network.HTTP.Lucu.HttpVersion import           Network.HTTP.Lucu.Interaction import           Network.HTTP.Lucu.Postprocess import           Network.HTTP.Lucu.Response import           Prelude hiding (catch)-import           System.IO+import           System.IO (stderr)  -responseWriter :: Config -> Handle -> InteractionQueue -> ThreadId -> IO ()+responseWriter :: HandleLike h => Config -> h -> InteractionQueue -> ThreadId -> IO () responseWriter !cnf !h !tQueue !readerTID     = awaitSomethingToWrite       `catches`@@ -135,11 +136,11 @@                unless willDiscardBody                           $ do if willChunkBody then                                    do hPutStr h (fmtHex False 0 $! fromIntegral $! C8.length chunk)-                                      C8.hPut h (C8.pack "\r\n")-                                      C8.hPut h chunk-                                      C8.hPut h (C8.pack "\r\n")+                                      hPutLBS h (C8.pack "\r\n")+                                      hPutLBS h chunk+                                      hPutLBS h (C8.pack "\r\n")                                  else-                                   C8.hPut h chunk+                                   hPutLBS h chunk                                hFlush h                awaitSomethingToWrite @@ -150,7 +151,7 @@             do willDiscardBody <- atomically $! readItr itr itrWillDiscardBody id                willChunkBody   <- atomically $! readItr itr itrWillChunkBody   id                when (not willDiscardBody && willChunkBody)-                        $ C8.hPut h (C8.pack "0\r\n\r\n") >> hFlush h+                        $ hPutLBS h (C8.pack "0\r\n\r\n") >> hFlush h        finalize :: Interaction -> IO ()       finalize itr

@@ -0,0 +1,11 @@+import MiseRafturai+import Network+import Network.HTTP.Lucu++main :: IO ()+main = let config    = defaultConfig { cnfServerPort = PortNumber 9999 }+           resources = mkResTree [ ([], miseRafturai) ]+       in+         do putStrLn "Access http://localhost:9999/ with your browser."+            runHttpd config resources []+                                   

@@ -0,0 +1,11 @@+import Network+import Network.HTTP.Lucu+import SmallFile++main :: IO ()+main = let config    = defaultConfig { cnfServerPort = PortNumber 9999 }+           resources = mkResTree [ ([], smallFile) ]+       in+         do putStrLn "Access http://localhost:9999/ with your browser."+            runHttpd config resources []+                                   

@@ -1,14 +1,15 @@-build: MiseRafturai.hs SmallFile.hs+build: MiseRafturai.hs SmallFile.hs SSL.hs 	ghc --make HelloWorld -threaded -O3 -fwarn-unused-imports 	ghc --make Implanted -threaded -O3 -fwarn-unused-imports 	ghc --make ImplantedSmall -threaded -O3 -fwarn-unused-imports 	ghc --make Multipart -threaded -O3 -fwarn-unused-imports+	ghc --make SSL -threaded -O3 -fwarn-unused-imports  run: build 	./HelloWorld  clean:-	rm -f HelloWorld Implanted MiseRafturai.hs ImplantedSmall SmallFile.hs Multipart *.hi *.o+	rm -f HelloWorld Implanted MiseRafturai.hs ImplantedSmall SmallFile.hs Multipart SSL *.hi *.o  MiseRafturai.hs: mise-rafturai.html 	lucu-implant-file -m MiseRafturai -o $@ $<

@@ -0,0 +1,35 @@+import Data.List+import Data.Maybe+import Network+import Network.HTTP.Lucu++main :: IO ()+main = let config    = defaultConfig { cnfServerPort = PortNumber 9999 }+           resources = mkResTree [ ([], resMain) ]+       in+         do putStrLn "Access http://localhost:9999/ with your browser."+            runHttpd config resources []+++resMain :: ResourceDef+resMain +    = ResourceDef {+        resUsesNativeThread = False+      , resIsGreedy         = False+      , resGet+          = Just $ do setContentType $ read "text/html"+                      output ("<title>Multipart Form Test</title>" +++                              "<form action=\"/\" method=\"post\" enctype=\"multipart/form-data\">" +++                              "  Enter some value:" +++                              "  <input type=\"text\" name=\"val\">" +++                              "  <input type=\"submit\" value=\"Submit\">" +++                              "</form>")+      , resHead   = Nothing+      , resPost+          = Just $ do form <- inputForm defaultLimit+                      let value = fromMaybe "" $ fmap snd $ find ((== "val") . fst) form+                      setContentType $ read "text/plain"+                      output ("You entered: " ++ value)+      , resPut    = Nothing+      , resDelete = Nothing+      }

@@ -0,0 +1,67 @@+import           Control.Monad+import           Control.Monad.Trans+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++main :: IO ()+main = withOpenSSL $+       do ctx  <- SSL.context++          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+                          , cnfSSLConfig  = Just SSLConfig {+                                              sslServerPort = PortNumber 9001+                                            , sslContext    = ctx+                                            }+                          }+              resources = mkResTree [ ( []+                                      , helloWorld )+                                    ]+          putStrLn "Access https://localhost:9001/ with your browser."+          runHttpd config resources []+++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+      }+++genCert :: KeyPair k => k -> IO X509+genCert pkey+    = 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+         setPublicKey    cert pkey+         signX509        cert pkey Nothing+         return cert

@@ -0,0 +1,30 @@+<?xml version="1.0" encoding="utf-8"?>+<html xml:lang="ga" xmlns="http://www.w3.org/1999/xhtml">+  <head>+    <title>Mise Rafturaí</title>+  </head>+  <body>+    <h1>Mise Rafturaí</h1>++    <p>+      Mise Rafturaí an file<br />+      Lán dúċais is gráḋ<br />+      Le súile gan solas<br />+      Le ciúnas gan crá<br />+    </p>++    <p>+      Ag dul síar ar m'aistear<br />+      Le solas mo ċroí<br />+      Fann agus tuirseaċ<br />+      Go deireaḋ mo ṡlí<br />+    </p>++    <p>+      Féaċ anois mé<br />+      Is mo ċúl le ḃfalla<br />+      Ag seinm ceoil<br />+      Do ṗócaí folaṁ<br />+    </p>+  </body>+</html>

@@ -0,0 +1,1 @@+Hello, world!