ResponseWriter now compiles.

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

diff --git a/Network/HTTP/Lucu/Resource.hs b/Network/HTTP/Lucu/Resource.hs
index 0caf6ceb7dbf6479e8dfa4141609872f0381e945..0dd73c96113971e2aa20d41f71eff4045bc1e6e6 100644 (file)
--- a/Network/HTTP/Lucu/Resource.hs
+++ b/Network/HTTP/Lucu/Resource.hs
@@ -239,7 +239,7 @@ getRemoteCertificate = itrRemoteCert <$> getInteraction
 getRequest ∷ Resource Request
 getRequest
     = do itr ← getInteraction
-         liftIO $ atomically $ readItr itrRequest fromJust itr
+         liftIO $ atomically $ fromJust <$> readItr itrRequest itr
 
 -- |Get the 'Method' value of the request.
 getMethod ∷ Resource Method
@@ -609,7 +609,7 @@ input ∷ Int → Resource Lazy.ByteString
 input limit
     = do driftTo GettingBody
          itr     ← getInteraction
-         hasBody ← liftIO $ atomically $ readItr itrRequestHasBody id itr
+         hasBody ← liftIO $ atomically $ readItr itrRequestHasBody itr
          chunk   ← if hasBody then
                        askForInput itr
                    else
@@ -628,7 +628,7 @@ input limit
                         $ fail ("inputLBS: limit must be positive: " ⧺ show actualLimit)
                -- Reader にリクエスト
                liftIO $ atomically
-                      $ do chunkLen ← readItr itrReqChunkLength id itr
+                      $ do chunkLen ← readItr itrReqChunkLength itr
                            writeItr itrWillReceiveBody True itr
                            if ((> actualLimit) <$> chunkLen) ≡ Just True then
                                -- 受信前から多過ぎる事が分かってゐる
@@ -637,8 +637,8 @@ input limit
                                writeItr itrReqBodyWanted (Just actualLimit) itr
                -- 應答を待つ。トランザクションを分けなければ當然デッドロックする。
                chunk ← liftIO $ atomically
-                       $ do chunkLen    ← readItr itrReceivedBodyLen id itr
-                            chunkIsOver ← readItr itrReqChunkIsOver  id itr
+                       $ do chunkLen    ← readItr itrReceivedBodyLen itr
+                            chunkIsOver ← readItr itrReqChunkIsOver  itr
                             if chunkLen < actualLimit then
                                 -- 要求された量に滿たなくて、まだ殘りが
                                 -- あるなら再試行。
@@ -651,8 +651,9 @@ input limit
                                     $ tooLarge actualLimit
                             -- 成功。itr 内にチャンクを置いたままにする
                             -- とメモリの無駄になるので除去。
-                            chunk ← readItr itrReceivedBody seqToLBS itr
-                            writeItr itrReceivedBody (∅) itr
+                            chunk ← seqToLBS <$> readItr itrReceivedBody itr
+                            writeItr itrReceivedBody    (∅) itr
+                            writeItr itrReceivedBodyLen 0   itr
                             return chunk
 
                driftTo DecidingHeader
@@ -683,7 +684,7 @@ inputChunk ∷ Int → Resource Lazy.ByteString
 inputChunk limit
     = do driftTo GettingBody
          itr     ← getInteraction
-         hasBody ← liftIO $ atomically $ readItr itrRequestHasBody id itr
+         hasBody ← liftIO $ atomically $ readItr itrRequestHasBody itr
          chunk   ← if hasBody then
                         askForInput itr
                     else
@@ -706,16 +707,17 @@ inputChunk limit
                            writeItr itrWillReceiveBody True itr
                -- 應答を待つ。トランザクションを分けなければ當然デッドロック。
                chunk ← liftIO $ atomically
-                       $ do chunkLen ← readItr itrReceivedBodyLen id itr
+                       $ do chunkLen ← readItr itrReceivedBodyLen itr
                             -- 要求された量に滿たなくて、まだ殘りがある
                             -- なら再試行。
                             when (chunkLen < actualLimit)
-                                $ do chunkIsOver ← readItr itrReqChunkIsOver id itr
+                                $ do chunkIsOver ← readItr itrReqChunkIsOver itr
                                      unless chunkIsOver
                                          $ retry
                             -- 成功
-                            chunk ← readItr itrReceivedBody seqToLBS itr
-                            writeItr itrReceivedBody (∅) itr
+                            chunk ← seqToLBS <$> readItr itrReceivedBody itr
+                            writeItr itrReceivedBody    (∅) itr
+                            writeItr itrReceivedBodyLen 0   itr
                             return chunk
                when (Lazy.null chunk)
                    $ driftTo DecidingHeader
@@ -904,14 +906,14 @@ outputChunk wholeChunk
                (Just $ "cnfMaxOutputChunkLength must be positive: " ⊕ T.pack (show limit))
 
          discardBody ← liftIO $ atomically $
-                       readItr itrWillDiscardBody id itr
+                       readItr itrWillDiscardBody itr
 
          unless (discardBody)
              $ sendChunks wholeChunk limit
 
          unless (Lazy.null wholeChunk)
              $ liftIO $ atomically $
-               writeItr itrBodyIsNull False itr
+               writeItr itrSentNoBody False itr
     where
       sendChunks ∷ Lazy.ByteString → Int → Resource ()
       sendChunks str limit
@@ -947,7 +949,7 @@ outputChunk wholeChunk
 driftTo ∷ InteractionState → Resource ()
 driftTo newState
     = do itr ← getInteraction
-         liftIO $ atomically $ do oldState ← readItr itrState id itr
+         liftIO $ atomically $ do oldState ← readItr itrState itr
                                   if newState < oldState then
                                       throwStateError oldState newState
                                     else
@@ -975,9 +977,9 @@ driftTo newState
           = postprocess itr
 
       drift itr _ Done
-          = do bodyIsNull ← readItr itrBodyIsNull id itr
+          = do bodyIsNull ← readItr itrSentNoBody itr
                when bodyIsNull
-                        $ writeDefaultPage itr
+                   $ writeDefaultPage itr
 
       drift _ _ _
           = return ()