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

diff --git a/Network/HTTP/Lucu/Interaction.hs b/Network/HTTP/Lucu/Interaction.hs
index fecb815..41c74a3 100644
--- a/Network/HTTP/Lucu/Interaction.hs
+++ b/Network/HTTP/Lucu/Interaction.hs
@@ -9,6 +9,7 @@
 module Network.HTTP.Lucu.Interaction
     ( Interaction(..)
     , SomeInteraction(..)
+    , EndOfInteraction(..)
 
     , SyntacticallyInvalidInteraction(..)
     , mkSyntacticallyInvalidInteraction
@@ -31,7 +32,7 @@ import Blaze.ByteString.Builder (Builder)
 import Control.Applicative
 import Control.Concurrent.STM
 import Data.Ascii (Ascii)
-import qualified Data.ByteString as Strict
+import Data.ByteString (ByteString)
 import Data.Monoid.Unicode
 import Data.Sequence (Seq)
 import Data.Time
@@ -44,6 +45,7 @@ import Network.HTTP.Lucu.Headers
 import Network.HTTP.Lucu.Preprocess
 import Network.HTTP.Lucu.Request
 import Network.HTTP.Lucu.Response
+import Network.HTTP.Lucu.Utils
 #if defined(HAVE_SSL)
 import OpenSSL.X509
 #endif
@@ -63,6 +65,13 @@ instance Interaction SomeInteraction where
     toInteraction   = id
     fromInteraction = Just
 
+-- |'EndOfInteraction' is an 'Interaction' indicating the end of
+-- (possibly pipelined) requests. The connection has already been
+-- closed so no need to reply anything.
+data EndOfInteraction = EndOfInteraction
+    deriving Typeable
+instance Interaction EndOfInteraction
+
 -- |'SyntacticallyInvalidInteraction' is an 'Interaction' without even
 -- a syntactically valid 'Request'. The response code will always be
 -- 'BadRequest'.
@@ -76,13 +85,13 @@ instance Interaction SyntacticallyInvalidInteraction
 
 mkSyntacticallyInvalidInteraction ∷ Config
                                   → IO SyntacticallyInvalidInteraction
-mkSyntacticallyInvalidInteraction config@(Config {..})
+mkSyntacticallyInvalidInteraction conf@(Config {..})
     = do date ← getCurrentDate
          let res  = setHeader "Server"       cnfServerSoftware      $
                     setHeader "Date"         date                   $
                     setHeader "Content-Type" defaultPageContentType $
                     emptyResponse BadRequest
-             body = getDefaultPage config Nothing res
+             body = defaultPageForResponse conf Nothing res
          return SYI {
                   syiResponse   = res
                 , syiBodyToSend = body
@@ -114,8 +123,16 @@ mkSemanticallyInvalidInteraction config@(Config {..}) (AugmentedRequest {..})
          let res  = setHeader "Server"       cnfServerSoftware      $
                     setHeader "Date"         date                   $
                     setHeader "Content-Type" defaultPageContentType $
+                    ( if arWillChunkBody
+                      then setHeader "Transfer-Encoding" "chunked"
+                      else id
+                    ) $
+                    ( if arWillClose
+                      then setHeader "Connection" "close"
+                      else id
+                    ) $
                     emptyResponse arInitialStatus
-             body = getDefaultPage config (Just arRequest) res
+             body = defaultPageForResponse config (Just arRequest) res
          return SEI {
                   seiRequest          = arRequest
                 , seiExpectedContinue = arExpectedContinue
@@ -138,12 +155,12 @@ data NormalInteraction
       , niRemoteCert       ∷ !(Maybe X509)
 #endif
       , niRequest          ∷ !Request
-      , niResourcePath     ∷ ![Strict.ByteString]
+      , niResourcePath     ∷ !Path
       , niExpectedContinue ∷ !Bool
       , niReqBodyLength    ∷ !(Maybe RequestBodyLength)
 
       , niReceiveBodyReq   ∷ !(TMVar ReceiveBodyRequest)
-      , niReceivedBody     ∷ !(TMVar Strict.ByteString)
+      , niReceivedBody     ∷ !(TMVar ByteString)
 
       , niResponse         ∷ !(TVar Response)
       , niSendContinue     ∷ !(TMVar Bool)
@@ -180,7 +197,7 @@ mkNormalInteraction ∷ Config
                     → Maybe X509
 #endif
                     → AugmentedRequest
-                    → [Strict.ByteString]
+                    → Path
                     → IO NormalInteraction
 #if defined(HAVE_SSL)
 mkNormalInteraction config remoteAddr remoteCert (AugmentedRequest {..}) rsrcPath