{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PackageImports #-} module Control.Journal where import Servant import Servant.Client import Servant.Client.Core.Auth (mkAuthenticatedRequest) import Control.Monad.Reader (asks) import Control.Monad.IO.Class (liftIO) import Data.String import qualified Data.Text as T import Data.Text.I18n import Data.Maybe (fromMaybe, maybe) import Network.HTTP.Types.Status (Status(..)) -- imports from "Mateamt" import qualified "mateamt" Types as MT -- internal imports import Types import View import Util import Client import ClientAuth import API journalControl :: Maybe T.Text -> Maybe Word -> UserHandler JournalPage journalControl mcookie mpage = do (token, muser, loc, l10n, backend) <- controlInit mcookie case muser of Just user -> do eresult <- liftIO $ runClientM (journalShow (mkAuthenticatedRequest token authenticateReq) (Just 50) (Just $ 50 * maybe 0 fromIntegral mpage) ) backend case eresult of Right entries -> return (journalPage l10n loc mcookie mpage entries) Left err -> case err of FailureResponse _ resp -> if statusCode (responseStatusCode resp) == 401 then redirectOverAuth Nothing (Just $ journalLink mpage) Nothing else throwError $ addMessage (fromString $ show err) $ redirect303 userSelectLink othererr -> throwError $ addMessage (fromString $ show othererr) $ redirect303 userSelectLink Nothing -> redirectOverAuth Nothing (Just $ journalLink mpage) Nothing journalGetCheckControl :: Maybe T.Text -> UserHandler JournalCheckPage journalGetCheckControl mcookie = do (token, muser, loc, l10n, _) <- controlInit mcookie return $ journalCheckPage l10n loc mcookie journalPostCheckControl :: Maybe T.Text -> CashCheck -> UserHandler JournalPage journalPostCheckControl mcookie (CashCheck floatAmount) = do (token, muser, loc, l10n, backend) <- controlInit mcookie case muser of Just user -> do eresult <- liftIO $ runClientM (journalPostCashCheck (mkAuthenticatedRequest token authenticateReq) (MT.JournalCashCheck $ floor $ floatAmount * 100) ) backend case eresult of Right _ -> throwError $ addMessage (translate l10n loc "Cash check received and processed") $ redirect303 (journalLink Nothing) Left err -> handleClientErr err (Just journalGetCheckLink) -- case err of -- FailureResponse _ resp -> -- if statusCode (responseStatusCode resp) == 401 -- then -- redirectOverAuth Nothing (Just journalGetCheckLink) Nothing -- else -- throwError $ -- addMessage (fromString $ show err) $ -- redirect303 userSelectLink -- otherErr -> -- throwError $ -- addMessage (fromString $ show otherErr) $ -- redirect303 userSelectLink Nothing -> redirectOverAuth Nothing (Just $ journalLink Nothing) Nothing where translate l10n locale = localize l10n locale . gettext