Main.hs

module Example.Main where

import Example.Types
import Example.Views

import TsWeb.Routing (dbwrite, get, getpost, path, post, runroute)
import TsWeb.Routing.Auth (auth)
import TsWeb.Session (patchConfig)
import TsWeb.Types (TsWebStateM)
import TsWeb.Types.Db (ReadOnlyPool, ReadWritePool, pool)

import qualified Web.Spock as Spock

import Web.Spock ((<//>), root, text, var)
import Web.Spock.Config (PoolOrConn(..), defaultSpockCfg, spc_csrfProtection)
import Web.Spock.Core (SpockCtxT)

main :: IO ()
main = do
  rwpool <- pool "localhost" "tsweb" "tsweb" 1 12 1
  ropool <- pool "localhost" "tsweb" "tsweb" 1 12 1
  spockCfg <-
    patchConfig (_dbSession db) ropool rwpool <$>
    defaultSpockCfg sess PCNoDatabase ()
  Spock.runSpock
    8080
    (Spock.spock (spockCfg {spc_csrfProtection = False}) (routes ropool rwpool))
  where
    sess :: SessionData
    sess = SessionData (UserId Nothing) False

routes ::
     ReadOnlyPool -> ReadWritePool -> SpockCtxT () (TsWebStateM SessionData) ()
routes ropool rwpool =
  runroute ropool rwpool $
  path
    #root
    root
    (do get index
        get $ auth userP userindex
        get $ auth adminP adminindex
        post $ text "post\n") .
  path #admin "admin" (get $ auth adminP adminindex) .
  path #users "users" (getpost users) .
  path
    #user
    ("users" <//> var)
    (do TsWeb.Routing.get $ viewuser
        dbwrite $ post makeuser) .
  path #login ("login" <//> var) (post login) .
  path #logind "login" (get loginstat) . path #logout "logout" (getpost logout)