on wai-websockets/1.2.0.3 help sign in
typeable/wai/warp/server-no-keepalive.hs
34 lines 1.2 kB history raw
1{-# LANGUAGE OverloadedStrings #-}
2import Network.Wai.Handler.Warp
3import Control.Exception (bracket)
4import Control.Monad (forever)
5import Network (sClose)
6import Network.Socket (accept)
7import Control.Monad.IO.Class (liftIO)
8import qualified Data.Enumerator as E
9import qualified Data.Enumerator.Binary as EB
10import Control.Concurrent (forkIO)
11import Network.Wai (responseLBS)
12import Network.HTTP.Types (status200)
13import Data.Enumerator (($$), run_)
15app = const $ return $ responseLBS status200 [("Content-type", "text/plain")] "This is not kept alive under any circumtances"
17main = withManager 30000000 $ \man -> bracket
18 (bindPort (settingsPort set) (settingsHost set))
19 sClose
20 (\socket -> forever $ do
21 (conn, sa) <- accept socket
22 th <- liftIO $ registerKillThread man
23 _ <- forkIO $ do
24 run_ $ enumSocket th 4096 conn $$ do
25 liftIO $ pause th
26 (len, env) <- parseRequest (settingsPort set) sa
27 liftIO $ resume th
28 res <- E.joinI $ EB.isolate len $$ app env
29 _ <- liftIO $ sendResponse th env conn res
30 liftIO $ sClose conn
31 return ()
32 )
33 where
34 set = defaultSettings