snap-server 0.9.4.0 → 0.9.4.1

raw patch · 5 files changed

+37/−22 lines, 5 filesdep ~basedep ~case-insensitive

Dependency ranges changed: base, case-insensitive

Files

• snap-server.cabal +2/−2
• src/Snap/Internal/Http/Server/Config.hs +16/−11
• src/Snap/Internal/Http/Server/Date.hs +3/−3
• src/Snap/Internal/Http/Server/SimpleBackend.hs +15/−5
• test/snap-server-testsuite.cabal +1/−1

@@ -1,5 +1,5 @@ name:           snap-server-version:        0.9.4.0+version:        0.9.4.1 synopsis:       A fast, iteratee-based, epoll-enabled web server for the Snap Framework description:   Snap is a simple and fast web development framework and server written in@@ -91,7 +91,7 @@     blaze-builder             >= 0.2.1.4  && < 0.4,     blaze-builder-enumerator  >= 0.2.0    && < 0.3,     bytestring                >= 0.9.1    && < 0.11,-    case-insensitive          >= 0.3      && < 1.2,+    case-insensitive          >= 0.3      && < 1.3,     containers                >= 0.3      && < 0.6,     enumerator                >= 0.4.15   && < 0.5,     MonadCatchIO-transformers >= 0.2.1    && < 0.4,

@@ -97,7 +97,23 @@     , proxyType      :: Maybe ProxyType     , startupHook    :: Maybe (StartupInfo m a -> IO ())     }+#if MIN_VERSION_base(4,7,0)+  deriving Typeable+#else ++------------------------------------------------------------------------------+-- | The 'Typeable1' instance is here so 'Config' values can be+-- dynamically loaded with Hint.+configTyCon :: TyCon+configTyCon = mkTyCon "Snap.Http.Server.Config.Config"+{-# NOINLINE configTyCon #-}++instance (Typeable1 m) => Typeable1 (Config m) where+    typeOf1 _ = mkTyConApp configTyCon [typeOf1 (undefined :: m ())]+#endif++ instance Show (Config m a) where     show c = unlines [ "Config:"                      , "hostname: "       ++ _hostname@@ -187,17 +203,6 @@         }       where         ov f = getLast $! (mappend `on` (Last . f)) a b------------------------------------------------------------------------------------ | The 'Typeable1' instance is here so 'Config' values can be--- dynamically loaded with Hint.-configTyCon :: TyCon-configTyCon = mkTyCon "Snap.Http.Server.Config.Config"-{-# NOINLINE configTyCon #-}--instance (Typeable1 m) => Typeable1 (Config m) where-    typeOf1 _ = mkTyConApp configTyCon [typeOf1 (undefined :: m ())]   ------------------------------------------------------------------------------

@@ -62,7 +62,7 @@  ------------------------------------------------------------------------------ ensureFreshDate :: IO ()-ensureFreshDate = block $ do+ensureFreshDate = mask $ \_ -> do     now <- epochTime     old <- readIORef $ _lastFetchTime dateState     when (now > old) $ updateState dateState@@ -70,14 +70,14 @@  ------------------------------------------------------------------------------ getDateString :: IO ByteString-getDateString = block $ do+getDateString = mask $ \_ -> do     ensureFreshDate     readIORef $ _cachedDateString dateState   ------------------------------------------------------------------------------ getLogDateString :: IO ByteString-getLogDateString = block $ do+getLogDateString = mask $ \_ -> do     ensureFreshDate     readIORef $ _cachedLogString dateState 

@@ -24,7 +24,11 @@ import           Data.Maybe import           Foreign hiding (new) import           Foreign.C+#if MIN_VERSION_base(4,4,0)+import           GHC.Conc (labelThread, forkOn)+#else import           GHC.Conc (labelThread, forkOnIO)+#endif import           Network.Socket #if !MIN_VERSION_base(4,6,0) import           Prelude hiding (catch)@@ -47,6 +51,13 @@   ------------------------------------------------------------------------------+#if !MIN_VERSION_base(4,4,0)+forkOn :: Int -> IO () -> IO ThreadId+forkOn = forkOnIO+#endif+++------------------------------------------------------------------------------ -- | For each cpu, we store: --    * A list of accept threads, one per port. --    * A TimeoutManager@@ -85,15 +96,14 @@ newLoop defaultTimeout sockets handler elog cpu = do     tmgr       <- TM.initialize defaultTimeout getCurrentDateTime     exit       <- newEmptyMVar-    accThreads <- forM sockets $ \p -> forkOnIO cpu $+    accThreads <- forM sockets $ \p -> forkOn cpu $                   acceptThread defaultTimeout handler tmgr elog cpu p exit      return $! EventLoopCpu cpu accThreads tmgr exit - ------------------------------------------------------------------------------ stopLoop :: EventLoopCpu -> IO ()-stopLoop loop = block $ do+stopLoop loop = mask $ \_ -> do     TM.stop $ _timeoutManager loop     Prelude.mapM_ killThread $ _acceptThreads loop @@ -115,7 +125,7 @@         (s,addr) <- accept $ Listen.listenSocket sock         setSocketOption s NoDelay 1         debug $ "acceptThread: accepted connection from remote: " ++ show addr-        _ <- forkOnIO cpu (go s addr `catches` cleanup)+        _ <- forkOn cpu (go s addr `catches` cleanup)         return ()      loop = do@@ -169,7 +179,7 @@      bracket (Listen.createSession lsock 8192 fd               (threadWaitRead $ fromIntegral fd))-            (\session -> block $ do+            (\session -> mask $ \_ -> do                  debug "thread killed, closing socket"                   -- cancel thread timeout

@@ -159,7 +159,7 @@     blaze-builder              >= 0.2.1.4  && <0.4,     blaze-builder-enumerator   >= 0.2.0    && <0.3,     bytestring,-    case-insensitive           >= 0.3      && <1.2,+    case-insensitive           >= 0.3      && <1.3,     containers,     directory-tree,     enumerator                 >= 0.4.15   && <0.5,