X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FInteraction.hs;h=df5e2302d21b16da302ce833bd849a2d1a068766;hp=e871159ada06c278078b8d29f8fb61aaec2ca8a2;hb=51eda5b;hpb=ece223c516e66223ef1d5d8e6bbe4054a235d983

diff --git a/Network/HTTP/Lucu/Interaction.hs b/Network/HTTP/Lucu/Interaction.hs
index e871159..df5e230 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
@@ -110,7 +109,6 @@ mkSemanticallyInvalidInteraction ∷ Config
                                  → IO SemanticallyInvalidInteraction
 mkSemanticallyInvalidInteraction config@(Config {..}) (AugmentedRequest {..})
     = do date ← getCurrentDate
-         -- FIXME: DRY
          let res  = setHeader "Server"       cnfServerSoftware      $
                     setHeader "Date"         date                   $
                     setHeader "Content-Type" defaultPageContentType $
@@ -138,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)
@@ -218,11 +216,11 @@ type InteractionQueue = TVar (Seq SomeInteraction)
 mkInteractionQueue ∷ IO InteractionQueue
 mkInteractionQueue = newTVarIO (∅)
 
-setResponseStatus ∷ NormalInteraction → StatusCode → STM ()
+setResponseStatus ∷ StatusCode sc ⇒ NormalInteraction → sc → STM ()
 setResponseStatus (NI {..}) sc
     = do res ← readTVar niResponse
          let res' = res {
-                      resStatus = sc
+                      resStatus = fromStatusCode sc
                     }
          writeTVar niResponse res'