bein-0.3.3: Bein/Web.hs

module Main where

import Bein.Web.Types
import Bein.Web.Commands
import Bein.Web.Routing
import qualified System.Posix.Daemonize as D
import Happstack.Server
import Control.Concurrent
import Control.Monad.Trans
import Control.Monad.Reader
import Control.Concurrent.STM
import Database.HDBC.PostgreSQL
import Bein.Configuration
import Network
import System.IO

main :: IO ()
main = D.serviced $ D.simpleDaemon { D.program = httpd, D.user = Just "bein", D.group = Just "bein" }

getPort :: WebState -> IO Int
getPort st = (liftIO.atomically.readTVar.configT) st >>= return.http_port

httpd :: a -> IO ()
httpd _ = getState >>= \s -> do 
  p <- getPort s
  runReaderT sessionExpirer s
  simpleHTTP' (\a -> runReaderT a s) (Conf p Nothing) routing

sessionExpirer :: BeinM WebState ThreadId
sessionExpirer = forkR f
  where f = do update "select remove_expired_sessions()" []
               liftIO $ threadDelay (5*60*1000000)
               f

getState :: IO WebState
getState = do
  conn <- connectPostgreSQL "dbname=bein"
  config <- readConfiguration conn
  configTV <- newTVarIO config
  sockMV <- (connectTo "" (UnixSocket (daemon_port config)) >>= \h -> do
                hSetBuffering h LineBuffering                                       
                newMVar h) `catch` (\_ -> newEmptyMVar)
  return $ WebState { stDb = conn, stConfigT = configTV, stDaemonPort = sockMV, 
                      stObject = undefined, stUser = Nothing }