gistfile1.hs

{-# LANGUAGE OverloadedStrings #-}

module Main where

import Db
import Views

import Data.Default (def)
import Data.String (fromString)
import Web.Scotty
import Network.Wai.Middleware.Static
import Network.Wai.Middleware.RequestLogger (logStdoutDev)
import Network.Wai.Session (withSession, Session)
import Network.Wai.Session.Map (mapStore_)
import Control.Applicative
import qualified Data.Configurator as C
import qualified Data.Configurator.Types as C
import qualified Data.Vault.Lazy as Vault
import Database.MySQL.Simple
import Data.Pool(Pool, createPool, withResource)


import Network.Wai
import Network.Wai.Handler.Warp (run)
import Network.HTTP.Types (ok200)


makeDbConfig :: C.Config -> IO (Maybe Db.DbConfig)
makeDbConfig conf = do
  name <- C.lookup conf "database.name" :: IO (Maybe String)
  user <- C.lookup conf "database.user" :: IO (Maybe String)
  password <- C.lookup conf "database.password" :: IO (Maybe String)
  return $ DbConfig <$> name
                    <*> user
                    <*> password

main :: IO ()
main = do
    loadedConf <- C.load [C.Required "application.conf"]
    dbConf <- makeDbConfig loadedConf
    session <- Vault.newKey
    store <- mapStore_

    case dbConf of
      Nothing -> putStrLn "No database configuration found, terminating..."
      Just conf -> do      
          pool <- createPool (newConn conf) close 1 5 5
          scotty 3000 $ do
              middleware $ withSession store (fromString "SESSION") def session
              middleware $ staticPolicy (noDots >-> addBase "static")
              middleware logStdoutDev

              get "/sess" $ do u <- Vault.lookup session "env"
                               html "hello"
              get "/:word" helloWorld
              post "/login" login