Skip to content

Instantly share code, notes, and snippets.

@dbushenko
Created April 21, 2015 19:43
Show Gist options
  • Save dbushenko/7c237435d86f5a4b8059 to your computer and use it in GitHub Desktop.
Save dbushenko/7c237435d86f5a4b8059 to your computer and use it in GitHub Desktop.
{-# 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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment