|
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]) |
