100 lines
2.8 KiB
Haskell
100 lines
2.8 KiB
Haskell
{-# 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, symbol, version) <- 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 version 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, _, symbol, version) <- controlInit mcookie
|
|
return $ journalCheckPage l10n loc version mcookie
|
|
|
|
journalPostCheckControl
|
|
:: Maybe T.Text
|
|
-> CashCheck
|
|
-> UserHandler JournalPage
|
|
journalPostCheckControl mcookie (CashCheck floatAmount) = do
|
|
(token, muser, loc, l10n, backend, symbol, version) <- 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 (read <$> muser) (Just journalGetCheckLink)
|
|
Nothing ->
|
|
redirectOverAuth Nothing (Just $ journalLink Nothing) Nothing
|
|
where
|
|
translate l10n locale = localize l10n locale . gettext
|