matebeamter/src/Control/Journal.hs

{-# 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)

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
  let (token, muser) = parseTokenAndUser mcookie
      loc = localeFromCookie mcookie
  l10n <- asks rsL10n
  backend <- asks rsBackend
  case muser of
    Just user -> do
      eresult <- liftIO $ runClientM
        (journalShow
          (mkAuthenticatedRequest token authenticateReq)
          (Just 50)
          (Just $ 50 * fromMaybe 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
  let (token, muser) = parseTokenAndUser mcookie
      loc = localeFromCookie mcookie
  l10n <- asks rsL10n
  return $ journalCheckPage l10n loc mcookie

journalPostCheckControl
  :: Maybe T.Text
  -> CashCheck
  -> UserHandler JournalPage
journalPostCheckControl mcookie (CashCheck floatAmount) = do
  let (token, muser) = parseTokenAndUser mcookie
      loc = localeFromCookie mcookie
  l10n <- asks rsL10n
  backend <- asks rsBackend
  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 ->
          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