{-# LANGUAGE OverloadedStrings #-} module Application ( signIn , signOut , getIndexAction , getUsersAction , getPaymentsAction , addUserAction , deleteUserAction , insertPaymentAction ) where import Web.Scotty import Network.HTTP.Types.Status (ok200, badRequest400) import Database.Persist import Control.Monad.IO.Class (liftIO) import Data.Text (Text) import qualified Data.Text as T import Data.String (fromString) import qualified Data.Text.Lazy as TL import qualified LoginSession import qualified Secure import Model.Database (runDb) import Model.User import Model.Payment import View.Page (page) getIndexAction :: ActionM () getIndexAction = html page getUsersAction :: ActionM () getUsersAction = do users <- liftIO $ runDb getUsers html . fromString . show $ users getPaymentsAction :: ActionM () getPaymentsAction = Secure.loggedAction (\_ -> do payments <- liftIO $ runDb getPayments json payments ) addUserAction :: Text -> Text -> ActionM () addUserAction email name = do _ <- liftIO . runDb $ insertUser email name status ok200 deleteUserAction :: Text -> ActionM () deleteUserAction email = do _ <- liftIO . runDb $ deleteUser email status ok200 insertPaymentAction :: Text -> Text -> Int -> ActionM () insertPaymentAction email name cost = do maybeUser <- liftIO . runDb $ getUser email case maybeUser of Just user -> do _ <- liftIO . runDb $ insertPayment (entityKey user) name cost return () Nothing -> do status badRequest400 status ok200 signIn :: Text -> ActionM () signIn login = do maybeUser <- liftIO . runDb $ getUser login case maybeUser of Just _ -> do LoginSession.put login status ok200 Nothing -> status badRequest400 signOut :: ActionM () signOut = do LoginSession.delete status ok200