68 lines
1.7 KiB
Haskell
68 lines
1.7 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.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
|