mkscrg/.gitignore

## .gitignore
wspq-repro.cabal
.stack-work/

## README.md

      
    Raw
  

              README.md
            
          
    See yesodweb/wai#552

stack build
stack exec main

Open http://localhost:8000 in your browser after it's running.
Request timeline (~ms)

(0) client opens websocket connection
(0) server forks off pinger thread with 2s interval
(1000) client closes websocket connection
(1000) client initiates /db request
(1000) server opens Postgres connection, sleeps for 2s
(2000) pinger thread sends on the (closed) websocket connection
(3000) server runs a query on the Postgres connection, throws an exception about file descriptors


## index.html
<!DOCTYPE html>
<html>
  <head>
  </head>
  <body>
    <script>
function connectWS(openMillis, onClose) {
  var ws = new WebSocket('ws://' + window.location.host);
  ws.onopen = function() {
    window.setTimeout(function() { ws.close(); }, openMillis);
  };
  ws.onclose = function() {
    onClose();
  };
}

function requestDB() {
  var xhr = new XMLHttpRequest();
  xhr.open('GET', '/db');
  xhr.send();
}

connectWS(1000, requestDB);
    </script>
  </body>
</html>

## Main.hs
module Main (main) where

import ClassyPrelude

import qualified Database.PostgreSQL.LibPQ as PQ
import qualified Database.PostgreSQL.Simple as PG
import qualified Database.PostgreSQL.Simple.Internal as PGI

import qualified Network.HTTP.Types as HTTP
import qualified Network.Wai as Wai
import qualified Network.Wai.Handler.Warp as Warp

import qualified Network.Wai.Handler.WebSockets as WaiWS
import qualified Network.WebSockets as WS

import qualified System.IO as IO
import qualified System.Posix.Types as Posix


main :: IO ()
main = do
    IO.hSetBuffering stdout IO.LineBuffering
    let pgConnStr = "postgresql://localhost:5432/postgres"
    putStrLn "open http://localhost:8000 in your browser"
    Warp.runSettings settings (application pgConnStr)
  where
    settings
        = Warp.setPort 8000
        $ Warp.setOnClose (\_ -> putStrLn "warp connection closed")
        $ Warp.defaultSettings

application :: ByteString -> Wai.Application
application pgConnStr
    = WaiWS.websocketsOr WS.defaultConnectionOptions wsApp
    $ waiApp pgConnStr

wsApp :: WS.ServerApp
wsApp pendingConn = do
    wsConn <- WS.acceptRequest pendingConn
    WS.forkPingThread wsConn 2
    forever $ void $ WS.receiveDataMessage wsConn

waiApp :: ByteString -> Wai.Application
waiApp pgConnStr req respond = case Wai.pathInfo req of
    [] -> respond $ Wai.responseFile HTTP.status200 [] "index.html" Nothing
    "db":_ -> handle logException $ do
        queryPostgres pgConnStr
        respond $ Wai.responseLBS HTTP.status200 [] "success"
    _ -> respond $ Wai.responseLBS HTTP.status404 [] "not found"
  where
    logException :: SomeException -> IO a
    logException someEx = do
        putStrLn $ "exception handling DB request: " ++ tshow someEx
        throwIO someEx

queryPostgres :: ByteString -> IO ()
queryPostgres pgConnStr = bracket (PG.connectPostgreSQL pgConnStr) PG.close $
    \pgConn -> do
        PGI.withConnection pgConn $ \pqConn -> do
            Just (Posix.Fd fd) <- PQ.socket pqConn
            putStrLn $ "LIBPQ fd: " ++ tshow fd
        threadDelay 2000000
        void $ (PG.query_ pgConn "select 1" :: IO [PG.Only Int])

## package.yaml
name: wspq-repro
version: 0.1.0.0

executables:
  main:
    main: Main.hs

ghc-options: -Wall -O -threaded -with-rtsopts=-N

dependencies:
  - base
  - classy-prelude
  - http-types
  - postgresql-libpq
  - postgresql-simple
  - wai
  - wai-websockets
  - warp
  - websockets

default-extensions:
  - NoImplicitPrelude
  - OverloadedStrings

## stack.yaml
resolver: nightly-2016-05-17
packages:
  - location: .
  - location:
      git: git@github.com:mkscrg/wai
      commit: 40da70543e04ce586f7094ec4a4449c5c73c109a
    subdirs:
      - warp
	<!DOCTYPE html>
	<html>
	<head>
	</head>
	<body>
	<script>
	function connectWS(openMillis, onClose) {
	var ws = new WebSocket('ws://' + window.location.host);
	ws.onopen = function() {
	window.setTimeout(function() { ws.close(); }, openMillis);
	};
	ws.onclose = function() {
	onClose();
	};
	}

	function requestDB() {
	var xhr = new XMLHttpRequest();
	xhr.open('GET', '/db');
	xhr.send();
	}

	connectWS(1000, requestDB);
	</script>
	</body>
	</html>
	module Main (main) where

	import ClassyPrelude

	import qualified Database.PostgreSQL.LibPQ as PQ
	import qualified Database.PostgreSQL.Simple as PG
	import qualified Database.PostgreSQL.Simple.Internal as PGI

	import qualified Network.HTTP.Types as HTTP
	import qualified Network.Wai as Wai
	import qualified Network.Wai.Handler.Warp as Warp

	import qualified Network.Wai.Handler.WebSockets as WaiWS
	import qualified Network.WebSockets as WS

	import qualified System.IO as IO
	import qualified System.Posix.Types as Posix


	main :: IO ()
	main = do
	IO.hSetBuffering stdout IO.LineBuffering
	let pgConnStr = "postgresql://localhost:5432/postgres"
	putStrLn "open http://localhost:8000 in your browser"
	Warp.runSettings settings (application pgConnStr)
	where
	settings
	= Warp.setPort 8000
	$ Warp.setOnClose (\_ -> putStrLn "warp connection closed")
	$ Warp.defaultSettings

	application :: ByteString -> Wai.Application
	application pgConnStr
	= WaiWS.websocketsOr WS.defaultConnectionOptions wsApp
	$ waiApp pgConnStr

	wsApp :: WS.ServerApp
	wsApp pendingConn = do
	wsConn <- WS.acceptRequest pendingConn
	WS.forkPingThread wsConn 2
	forever $ void $ WS.receiveDataMessage wsConn

	waiApp :: ByteString -> Wai.Application
	waiApp pgConnStr req respond = case Wai.pathInfo req of
	[] -> respond $ Wai.responseFile HTTP.status200 [] "index.html" Nothing
	"db":_ -> handle logException $ do
	queryPostgres pgConnStr
	respond $ Wai.responseLBS HTTP.status200 [] "success"
	_ -> respond $ Wai.responseLBS HTTP.status404 [] "not found"
	where
	logException :: SomeException -> IO a
	logException someEx = do
	putStrLn $ "exception handling DB request: " ++ tshow someEx
	throwIO someEx

	queryPostgres :: ByteString -> IO ()
	queryPostgres pgConnStr = bracket (PG.connectPostgreSQL pgConnStr) PG.close $
	\pgConn -> do
	PGI.withConnection pgConn $ \pqConn -> do
	Just (Posix.Fd fd) <- PQ.socket pqConn
	putStrLn $ "LIBPQ fd: " ++ tshow fd
	threadDelay 2000000
	void $ (PG.query_ pgConn "select 1" :: IO [PG.Only Int])
	name: wspq-repro
	version: 0.1.0.0

	executables:
	main:
	main: Main.hs

	ghc-options: -Wall -O -threaded -with-rtsopts=-N

	dependencies:
	- base
	- classy-prelude
	- http-types
	- postgresql-libpq
	- postgresql-simple
	- wai
	- wai-websockets
	- warp
	- websockets

	default-extensions:
	- NoImplicitPrelude
	- OverloadedStrings
	resolver: nightly-2016-05-17
	packages:
	- location: .
	- location:
	git: git@github.com:mkscrg/wai
	commit: 40da70543e04ce586f7094ec4a4449c5c73c109a
	subdirs:
	- warp