SSL Support

[Lucu.git] / Network / HTTP / Lucu / Interaction.hs

diff --git a/Network/HTTP/Lucu/Interaction.hs b/Network/HTTP/Lucu/Interaction.hs
index a81320b0f192e62cc2fbf40d2f998d70d3feab61..6b5cdae11a708ddf3c36b26e81bfd581fa572064 100644 (file)
--- a/Network/HTTP/Lucu/Interaction.hs
+++ b/Network/HTTP/Lucu/Interaction.hs
@@ -27,10 +27,12 @@ import           Network.HTTP.Lucu.Headers
 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 :: Strict.ByteString
 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 @@ newInteraction conf addr req
          return $ Interaction {
                       itrConfig       = conf
                     , itrRemoteAddr   = addr
+                    , itrRemoteCert   = cert
                     , itrResourcePath = Nothing
                     , itrRequest      = request
                     , itrResponse     = responce