{-# LANGUAGE OverloadedStrings #-} module Application ( getIndexAction , getUsersAction , getPaymentsAction , addUserAction , deleteUserAction , insertPaymentAction , signIn , checkConnection , signOut ) where import Web.Scotty import Network.HTTP.Types.Status (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 = Secure.loggedAction (\_ -> html $ page ) getUsersAction :: ActionM () getUsersAction = do users <- liftIO $ runDb getUsers html . fromString . show $ users getPaymentsAction :: ActionM () getPaymentsAction = do payments <- liftIO $ runDb getPayments json payments addUserAction :: Text -> Text -> ActionM () addUserAction email name = do _ <- liftIO . runDb $ insertUser email name html "Ok" deleteUserAction :: Text -> ActionM () deleteUserAction email = do _ <- liftIO . runDb $ deleteUser email html "Ok" 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 html "Not found" signIn :: Text -> ActionM () signIn login = do LoginSession.put login html "Ok" checkConnection :: ActionM () checkConnection = do maybeLogin <- LoginSession.get case maybeLogin of Just login -> html . TL.fromStrict $ T.intercalate " " [ "You are connected with the following login:" , login ] Nothing -> do status badRequest400 html "You are not connected" signOut :: ActionM () signOut = do LoginSession.delete html "Ok"