{-# LANGUAGE OverloadedStrings #-} module Application ( signInAction , validateSignInAction , signOutAction , getIndexAction , getUsersAction , getPaymentsAction , addUserAction , deleteUserAction , createPaymentAction ) 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 qualified Data.Text.IO as TIO import Data.String (fromString) import qualified LoginSession import qualified Secure import Model.Database import Model.User import Model.Payment import Model.SignIn 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 $ createUser email name status ok200 deleteUserAction :: Text -> ActionM () deleteUserAction email = do _ <- liftIO . runDb $ deleteUser email status ok200 createPaymentAction :: Text -> Text -> Int -> ActionM () createPaymentAction email name cost = do maybeUser <- liftIO . runDb $ getUser email case maybeUser of Just user -> do _ <- liftIO . runDb $ createPayment (entityKey user) name cost return () Nothing -> do status badRequest400 status ok200 signInAction :: Text -> ActionM () signInAction login = do maybeUser <- liftIO . runDb $ getUser login case maybeUser of Just _ -> do token <- liftIO . runDb $ createSignInToken login let url = T.concat ["http://localhost:3000/validateSignIn?token=", token] liftIO . TIO.putStrLn $ url status ok200 Nothing -> status badRequest400 validateSignInAction :: Text -> ActionM () validateSignInAction token = do maybeSignIn <- liftIO . runDb $ getSignInToken token case maybeSignIn of Just signIn -> do LoginSession.put (signInEmail . entityVal $ signIn) liftIO . runDb . signInTokenIsUsed . entityKey $ signIn redirect "/" Nothing -> status badRequest400 signOutAction :: ActionM () signOutAction = do LoginSession.delete status ok200