haskweb/Database.hs

{-# OPTIONS -Wall #-}

module Database (
    connect, addUser, validate, Connection, isLoggedIn, isAvailable,
    Username, Password
) where

import Control.Monad.State

import Network.CGI

import AppMonad
import DatabaseData
import Shared

validate :: Username -> Password -> App Bool
validate username password = do
    c <- gets connection
    isValid <- liftIO $ validateC c username password
    when isValid $ do
        setCookie $ newCookie "username" username
        (Just str) <- liftIO $ getLoginStringC c username
        setCookie $ newCookie "login_string" str
    return isValid

isLoggedIn :: App Bool
isLoggedIn = defRunMaybeT False $ do
    c <- gets connection
    name <- MaybeT $ getCookie "username"
    loginString <- MaybeT $ getCookie "login_string"
    liftIO $ isLoggedInC c name loginString

isAvailable :: Username -> App Bool
isAvailable username = do
    c <- gets connection
    liftIO $ isAvailableC c username

addUser :: Username -> Password -> App ()
addUser username password = do
    c <- gets connection
    liftIO $ addUserC c username password