X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FResource.hs;h=c75421378c89dd1c5eb6b25b5fea31cf354ce5a5;hp=87d2a33338d1e0a726c80af4fef3e1735fbc3e23;hb=895341e;hpb=05f8f795a483f672b7cafc7ba9d444dc84b937a8 diff --git a/Network/HTTP/Lucu/Resource.hs b/Network/HTTP/Lucu/Resource.hs index 87d2a33..c754213 100644 --- a/Network/HTTP/Lucu/Resource.hs +++ b/Network/HTTP/Lucu/Resource.hs @@ -211,7 +211,7 @@ getRemoteAddr = itrRemoteAddr <$> getInteraction getRemoteAddr' ∷ Resource HostName getRemoteAddr' = do sa ← getRemoteAddr - (Just a, _) ← liftIO $ getNameInfo [NI_NUMERICHOST] False False sa + (Just a, _) ← liftIO $ getNameInfo [NI_NUMERICHOST] True False sa return a -- |Resolve an address to the remote host. @@ -252,7 +252,7 @@ getRequestVersion = reqVersion <$> getRequest -- |Get the path of this 'Resource' (to be exact, -- 'Network.HTTP.Lucu.Resource.Tree.ResourceDef') in the -- 'Network.HTTP.Lucu.Resource.Tree.ResTree'. The result of this --- action is the exact path in the tree even if the +-- action is the exact path in the tree even when the -- 'Network.HTTP.Lucu.Resource.Tree.ResourceDef' is greedy. -- -- Example: @@ -883,33 +883,13 @@ output str = outputChunk str *> driftTo Done -- be repeated as many times as you want. It is safe to apply -- 'outputChunk' to an infinite string. outputChunk ∷ Lazy.ByteString → Resource () -outputChunk wholeChunk +outputChunk str = do driftTo DecidingBody itr ← getInteraction - - let limit = cnfMaxOutputChunkLength $ itrConfig itr - when (limit ≤ 0) - $ abort InternalServerError [] - (Just $ "cnfMaxOutputChunkLength must be positive: " ⊕ T.pack (show limit)) - - discardBody ← liftIO $ atomically $ readTVar $ itrWillDiscardBody itr - unless (discardBody) - $ sendChunks itr wholeChunk limit - - unless (Lazy.null wholeChunk) - $ liftIO $ atomically $ - writeTVar (itrSentNoBodySoFar itr) False - where - sendChunks ∷ Interaction → Lazy.ByteString → Int → Resource () - sendChunks itr@(Interaction {..}) str limit - | Lazy.null str = return () - | otherwise = do let (chunk, remaining) = Lazy.splitAt (fromIntegral limit) str - liftIO $ atomically - $ putTMVar itrBodyToSend (chunkToBuilder chunk) - sendChunks itr remaining limit - - chunkToBuilder ∷ Lazy.ByteString → Builder - chunkToBuilder = mconcat ∘ map BB.fromByteString ∘ Lazy.toChunks + liftIO $ atomically + $ do putTMVar (itrBodyToSend itr) (BB.fromLazyByteString str) + unless (Lazy.null str) + $ writeTVar (itrSentNoBodySoFar itr) False {-