X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FInteraction.hs;h=fecb81543083babe065501dc03d4d52a529cee94;hp=e486e1a32d2895faaa1165727fc01fd9c15f255d;hb=8cd9d79234344199a1644f661684bde3ed5e440b;hpb=f402841101b4b84f263eea1a43c848f81c48ff93

diff --git a/Network/HTTP/Lucu/Interaction.hs b/Network/HTTP/Lucu/Interaction.hs
index e486e1a..fecb815 100644
--- a/Network/HTTP/Lucu/Interaction.hs
+++ b/Network/HTTP/Lucu/Interaction.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE
-    DeriveDataTypeable
+    CPP
+  , DeriveDataTypeable
   , ExistentialQuantification
   , OverloadedStrings
   , RecordWildCards
@@ -23,7 +24,6 @@ module Network.HTTP.Lucu.Interaction
     , InteractionQueue
     , mkInteractionQueue
 
-    , setResponseStatus
     , getCurrentDate
     )
     where
@@ -34,7 +34,6 @@ import Data.Ascii (Ascii)
 import qualified Data.ByteString as Strict
 import Data.Monoid.Unicode
 import Data.Sequence (Seq)
-import qualified Data.Strict.Maybe as S
 import Data.Time
 import qualified Data.Time.HTTP as HTTP
 import Data.Typeable
@@ -45,7 +44,9 @@ import Network.HTTP.Lucu.Headers
 import Network.HTTP.Lucu.Preprocess
 import Network.HTTP.Lucu.Request
 import Network.HTTP.Lucu.Response
+#if defined(HAVE_SSL)
 import OpenSSL.X509
+#endif
 
 class Typeable i ⇒ Interaction i where
     toInteraction ∷ i → SomeInteraction
@@ -94,7 +95,7 @@ data SemanticallyInvalidInteraction
     = SEI {
         seiRequest          ∷ !Request
       , seiExpectedContinue ∷ !Bool
-      , seiReqBodyLength    ∷ !(S.Maybe RequestBodyLength)
+      , seiReqBodyLength    ∷ !(Maybe RequestBodyLength)
 
       , seiResponse         ∷ !Response
       , seiWillChunkBody    ∷ !Bool
@@ -133,11 +134,13 @@ data NormalInteraction
     = NI {
         niConfig           ∷ !Config
       , niRemoteAddr       ∷ !SockAddr
+#if defined(HAVE_SSL)
       , niRemoteCert       ∷ !(Maybe X509)
+#endif
       , niRequest          ∷ !Request
       , niResourcePath     ∷ ![Strict.ByteString]
       , niExpectedContinue ∷ !Bool
-      , niReqBodyLength    ∷ !(S.Maybe RequestBodyLength)
+      , niReqBodyLength    ∷ !(Maybe RequestBodyLength)
 
       , niReceiveBodyReq   ∷ !(TMVar ReceiveBodyRequest)
       , niReceivedBody     ∷ !(TMVar Strict.ByteString)
@@ -148,6 +151,7 @@ data NormalInteraction
       , niWillDiscardBody  ∷ !(TVar Bool)
       , niWillClose        ∷ !(TVar Bool)
       , niResponseHasCType ∷ !(TVar Bool)
+      -- FIXME: use TBChan Builder (in stm-chans package)
       , niBodyToSend       ∷ !(TMVar Builder)
 
       , niState            ∷ !(TVar InteractionState)
@@ -172,11 +176,17 @@ data InteractionState
 
 mkNormalInteraction ∷ Config
                     → SockAddr
+#if defined(HAVE_SSL)
                     → Maybe X509
+#endif
                     → AugmentedRequest
                     → [Strict.ByteString]
                     → IO NormalInteraction
+#if defined(HAVE_SSL)
 mkNormalInteraction config remoteAddr remoteCert (AugmentedRequest {..}) rsrcPath
+#else
+mkNormalInteraction config remoteAddr (AugmentedRequest {..}) rsrcPath
+#endif
     = do receiveBodyReq   ← newEmptyTMVarIO
          receivedBody     ← newEmptyTMVarIO
 
@@ -192,7 +202,9 @@ mkNormalInteraction config remoteAddr remoteCert (AugmentedRequest {..}) rsrcPat
          return NI {
                   niConfig           = config
                 , niRemoteAddr       = remoteAddr
+#if defined(HAVE_SSL)
                 , niRemoteCert       = remoteCert
+#endif
                 , niRequest          = arRequest
                 , niResourcePath     = rsrcPath
                 , niExpectedContinue = arExpectedContinue
@@ -217,13 +229,5 @@ type InteractionQueue = TVar (Seq SomeInteraction)
 mkInteractionQueue ∷ IO InteractionQueue
 mkInteractionQueue = newTVarIO (∅)
 
-setResponseStatus ∷ NormalInteraction → StatusCode → STM ()
-setResponseStatus (NI {..}) sc
-    = do res ← readTVar niResponse
-         let res' = res {
-                      resStatus = sc
-                    }
-         writeTVar niResponse res'
-
 getCurrentDate ∷ IO Ascii
 getCurrentDate = HTTP.toAscii <$> getCurrentTime