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