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

diff --git a/Network/HTTP/Lucu/Interaction.hs b/Network/HTTP/Lucu/Interaction.hs
index e486e1a..abc1cf5 100644
--- a/Network/HTTP/Lucu/Interaction.hs
+++ b/Network/HTTP/Lucu/Interaction.hs
@@ -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
@@ -94,7 +93,7 @@ data SemanticallyInvalidInteraction
     = SEI {
         seiRequest          ∷ !Request
       , seiExpectedContinue ∷ !Bool
-      , seiReqBodyLength    ∷ !(S.Maybe RequestBodyLength)
+      , seiReqBodyLength    ∷ !(Maybe RequestBodyLength)
 
       , seiResponse         ∷ !Response
       , seiWillChunkBody    ∷ !Bool
@@ -137,7 +136,7 @@ data NormalInteraction
       , niRequest          ∷ !Request
       , niResourcePath     ∷ ![Strict.ByteString]
       , niExpectedContinue ∷ !Bool
-      , niReqBodyLength    ∷ !(S.Maybe RequestBodyLength)
+      , niReqBodyLength    ∷ !(Maybe RequestBodyLength)
 
       , niReceiveBodyReq   ∷ !(TMVar ReceiveBodyRequest)
       , niReceivedBody     ∷ !(TMVar Strict.ByteString)
@@ -148,6 +147,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)
@@ -217,11 +217,12 @@ type InteractionQueue = TVar (Seq SomeInteraction)
 mkInteractionQueue ∷ IO InteractionQueue
 mkInteractionQueue = newTVarIO (∅)
 
-setResponseStatus ∷ NormalInteraction → StatusCode → STM ()
+-- FIXME: Response.hs should provide setStatus ∷ sc → Response → Response
+setResponseStatus ∷ StatusCode sc ⇒ NormalInteraction → sc → STM ()
 setResponseStatus (NI {..}) sc
     = do res ← readTVar niResponse
          let res' = res {
-                      resStatus = sc
+                      resStatus = fromStatusCode sc
                     }
          writeTVar niResponse res'