matebeamter/src/Control/Journal.hs

101 lines
2.9 KiB
Haskell
Raw Normal View History

2019-11-02 21:53:23 +00:00
{-# 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
2019-12-11 23:45:22 +00:00
import Data.Text.I18n
2019-11-02 21:53:23 +00:00
2019-12-12 02:41:22 +00:00
import Data.Maybe (fromMaybe, maybe)
2019-11-02 21:53:23 +00:00
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
2019-11-02 21:53:23 +00:00
case muser of
Just user -> do
eresult <- liftIO $ runClientM
(journalShow
(mkAuthenticatedRequest token authenticateReq)
(Just 50)
2019-12-12 02:41:22 +00:00
(Just $ 50 * maybe 0 fromIntegral mpage)
2019-11-02 21:53:23 +00:00
)
backend
case eresult of
Right entries ->
return (journalPage l10n loc version mcookie mpage entries)
2019-11-02 21:53:23 +00:00
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 Nothing)
2019-11-02 21:53:23 +00:00
othererr ->
throwError $
addMessage (fromString $ show othererr) $
redirect303 (userSelectLink Nothing)
2019-12-11 23:45:22 +00:00
Nothing ->
redirectOverAuth Nothing (Just $ journalLink mpage) Nothing
2019-12-11 03:12:19 +00:00
2019-12-11 23:45:22 +00:00
journalGetCheckControl
2019-12-11 03:12:19 +00:00
:: Maybe T.Text
-> UserHandler JournalCheckPage
2019-12-11 23:45:22 +00:00
journalGetCheckControl mcookie = do
(token, muser, loc, l10n, _, symbol, version) <- controlInit mcookie
return $ journalCheckPage l10n loc version mcookie
2019-12-11 23:45:22 +00:00
journalPostCheckControl
:: Maybe T.Text
-> CashCheck
-> UserHandler JournalPage
journalPostCheckControl mcookie (CashCheck floatAmount) = do
(token, muser, loc, l10n, backend, symbol, version) <- controlInit mcookie
2019-12-11 23:45:22 +00:00
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 ->
2019-12-15 09:34:38 +00:00
handleClientErr err (read <$> muser) (Just journalGetCheckLink)
2019-12-11 23:45:22 +00:00
Nothing ->
redirectOverAuth Nothing (Just $ journalLink Nothing) Nothing
where
translate l10n locale = localize l10n locale . gettext