direct-http 0.5.0.1 → 0.5.1
raw patch · 2 files changed
+43/−21 lines, 2 filesdep +SafeSemaphorePVP ok
version bump matches the API change (PVP)
Dependencies added: SafeSemaphore
API changes (from Hackage documentation)
Files
- Network/HTTP.hs +37/−19
- direct-http.cabal +6/−2
Network/HTTP.hs view
@@ -1,5 +1,11 @@ {-# LANGUAGE TypeSynonymInstances, FlexibleInstances, FlexibleContexts, DeriveDataTypeable #-}+-- | This module provides facilities for implementing webservers, in a+-- servelet-like style. The general philosophy is that direct-http makes+-- as few decisions as possible for the user code, allowing such things as+-- URL routing and virtual-host policies to be implemented in any desired+-- fashion. It focuses on providing a robust transport layer which can+-- integrate well with any higher layer. module Network.HTTP ( -- * The monad HTTP,@@ -124,6 +130,8 @@ where import Control.Concurrent.Lifted+import Control.Concurrent.MSem (MSem)+import qualified Control.Concurrent.MSem as MSem import Control.Exception.Lifted import Control.Monad.Base import Control.Monad.Reader@@ -147,6 +155,7 @@ import GHC.IO.Exception (IOErrorType(..)) import qualified Network.Socket as Network hiding (send, sendTo, recv, recvFrom) import qualified Network.Socket.ByteString as Network+import Numeric import Prelude hiding (catch) import System.Daemonize import System.Environment@@ -165,7 +174,7 @@ httpStateErrorLogMaybeHandleMVar :: MVar (Maybe Handle), httpStateForkPrimitive :: IO () -> IO ThreadId, httpStateThreadSetMVar :: MVar (Set ThreadId),- httpStateThreadTerminationQSem :: QSem,+ httpStateThreadTerminationMSem :: MSem Word, httpStateMaybeConnection :: Maybe HTTPConnection } @@ -199,7 +208,7 @@ | RequestContentNone | RequestContentClosed | RequestContentIdentity Int- | RequestContentChunked Bool Int+ | RequestContentChunked Int data ResponseContentParameters = ResponseContentUninitialized@@ -280,7 +289,7 @@ httpFork action = do state <- getHTTPState let mvar = httpStateThreadSetMVar state- qsem = httpStateThreadTerminationQSem state+ msem = httpStateThreadTerminationMSem state threadSet <- takeMVar mvar childThread <- liftBaseDiscard (httpStateForkPrimitive state) $ finally action@@ -289,7 +298,7 @@ self <- myThreadId let threadSet' = Set.delete self threadSet' putMVar mvar threadSet'- signalQSem qsem)+ liftBase $ MSem.signal msem) let threadSet' = Set.insert childThread threadSet putMVar mvar threadSet' return childThread@@ -417,13 +426,13 @@ errorLogMaybeHandleMVar <- newMVar errorLogMaybeHandle let forkPrimitive = serverParametersForkPrimitive parameters threadSetMVar <- newMVar Set.empty- threadTerminationQSem <- newQSem 0+ threadTerminationMSem <- MSem.new 0 let state = HTTPState { httpStateAccessLogMaybeHandleMVar = accessLogMaybeHandleMVar, httpStateErrorLogMaybeHandleMVar = errorLogMaybeHandleMVar, httpStateForkPrimitive = forkPrimitive, httpStateThreadSetMVar = threadSetMVar,- httpStateThreadTerminationQSem = threadTerminationQSem,+ httpStateThreadTerminationMSem = threadTerminationMSem, httpStateMaybeConnection = Nothing } if serverParametersDaemonize parameters@@ -450,12 +459,12 @@ threadWaitLoop = do state <- getHTTPState let mvar = httpStateThreadSetMVar state- qsem = httpStateThreadTerminationQSem state+ msem = httpStateThreadTerminationMSem state threadSet <- readMVar mvar if Set.null threadSet then liftBase exitSuccess else do- waitQSem qsem+ liftBase $ MSem.wait msem threadWaitLoop @@ -1578,7 +1587,7 @@ (_, Just _) -> (True, True) if hasContent then if chunked- then return $ RequestContentChunked False 0+ then return $ RequestContentChunked 0 else case maybeLength of Nothing -> return $ RequestContentNone Just length -> return $ RequestContentIdentity length@@ -1630,10 +1639,10 @@ if not blocking || isAtLeastTargetLength highLevelBuffer then return (highLevelBuffer', lowLevelBuffer', parameters') else loop highLevelBuffer' lowLevelBuffer' parameters'- RequestContentChunked _ _ -> do+ RequestContentChunked _ -> do httpLog $ "Don't understand chunked." throwIO UnexpectedEndOfInput- -- TODO+ -- TODO IAK HTTPConnection { httpConnectionInputBufferMVar = lowLevelBufferMVar } <- getHTTPConnection lowLevelBuffer <- takeMVar lowLevelBufferMVar@@ -2151,11 +2160,21 @@ send bytestring return (buffer, parameters') ResponseContentChunked -> do- httpLog $ "Chunked not implemented."- putMVar parametersMVar parameters- putMVar bufferMVar buffer- throwIO UnexpectedEndOfInput- -- TODO+ alreadySent <- takeMVar alreadySentMVar+ if alreadySent+ then return ()+ else do+ headersBuffer <- getHeadersBuffer+ send headersBuffer+ putMVar alreadySentMVar True+ if BS.length bytestring > 0+ then do+ let lengthBuffer =+ UTF8.fromString $ showHex (BS.length bytestring) "" ++ "\r\n"+ crlfBuffer = UTF8.fromString "\r\n"+ send $ BS.concat [lengthBuffer, bytestring, crlfBuffer]+ else return ()+ return (buffer, parameters) putMVar parametersMVar parameters putMVar bufferMVar buffer @@ -2211,11 +2230,10 @@ throwIO OutputIncomplete else return () ResponseContentChunked -> do- httpLog $ "Chunked not implemented."+ let emptyChunkBuffer = UTF8.fromString $ "0\r\n\r\n\r\n"+ send emptyChunkBuffer putMVar parametersMVar parameters putMVar bufferMVar buffer- throwIO UnexpectedEndOfInput- -- TODO putMVar parametersMVar ResponseContentClosed putMVar bufferMVar BS.empty
direct-http.cabal view
@@ -1,5 +1,5 @@ name: direct-http-version: 0.5.0.1+version: 0.5.1 cabal-version: >= 1.10 build-type: Simple license: BSD3@@ -22,6 +22,9 @@ to it, and makes several design decisions differently. The biggest is the use of MonadControlBase for exceptions. .+ Version 0.5.1: Uses SafeSemaphore, which is the future, rather than QSem+ from base, which is deprecated.+ . Version 0.5.0.1: This preliminary release is a preview to gauge community interest. Not even all major features are implemented; things that exist only as stubs include encryption, compression, chunking, and reading back@@ -42,5 +45,6 @@ direct-daemonize >= 3.0 && < 4, transformers-base >= 0.4.1 && < 1, lifted-base >= 0.1.1 && < 2,- monad-control >= 0.3.1.3 && < 1+ monad-control >= 0.3.1.3 && < 1,+ SafeSemaphore >= 0.9.0 && < 1 default-language: Haskell2010