add Journal

matebeamter.cabal

@@ -35,11 +35,13 @@ executable matebeamter
                      , Control.Auth
                      , Control.User
                      , Control.Buy
+                     , Control.Journal
                      , View
                      , View.Scaffold
                      , View.Auth
                      , View.User
                      , View.Buy
+                     , View.Journal
   -- other-extensions:
   build-depends:       base ^>=4.12.0.0
                      , mateamt

src/API.hs

@@ -56,6 +56,8 @@ type UserAPI =
   :<|> "user" :> "create" :> Get '[HTML] UserNewPage
   :<|> "user" :> "create" :> ReqBody '[FormUrlEncoded] MT.UserSubmit
     :> Post '[HTML] UserSelectPage
+  :<|> "journal" :> QueryParam "page" Word
+    :> Get '[HTML] JournalPage
   :<|> "auth"
     :> QueryParam "destination" T.Text
     :> Get '[HTML]
@@ -83,6 +85,7 @@ type UserAPI =
   userManageAuthDeleteLink :<|>
   userNewLink :<|>
   userNewPostLink :<|>
+  journalLink :<|>
   authLink :<|>
   authPostLink :<|>
   authLogoutLink

src/Control.hs

@@ -5,3 +5,4 @@ module Control
 import Control.Auth as C
 import Control.User as C
 import Control.Buy as C
+import Control.Journal as C

src/Control/Journal.hs

@@ -0,0 +1,68 @@
+{-# 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

src/Main.hs

@@ -80,6 +80,7 @@ userApp initState = serveWithContext userApi EmptyContext $
     :<|> userManageAuthDeleteControl mcookie
     :<|> userNewControl mcookie
     :<|> userNewPostControl mcookie
+    :<|> journalControl mcookie
     :<|> authControl mcookie
     :<|> authPostControl mcookie
     :<|> authLogoutControl mcookie

src/Types/Views.hs

@@ -17,3 +17,5 @@ type ProductListPage = H.Html
 type AuthPage = H.Html
 
 type BuyConfirmPage = H.Html
+
+type JournalPage = H.Html

src/View.hs

@@ -5,3 +5,4 @@ module View
 import View.Auth as V
 import View.User as V
 import View.Buy as V
+import View.Journal as V

src/View/Journal.hs

@@ -0,0 +1,81 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PackageImports #-}
+
+module View.Journal where
+
+import Servant.Links (linkURI)
+
+import qualified Text.Blaze.Html5 as H
+import qualified Text.Blaze.Html5.Attributes as HA
+
+import Data.String (fromString)
+
+import qualified Data.Text as T
+import Data.Text.I18n
+
+import Data.Maybe (fromMaybe)
+
+import Control.Monad (when)
+
+-- imports from "mateamt"
+
+import qualified "mateamt" Types as MT
+
+-- internal imports
+
+import Util
+import Types
+import View.Scaffold
+import API
+
+journalPage
+  :: L10n
+  -> Locale
+  -> Maybe T.Text
+  -> Maybe Word
+  -> [MT.JournalEntry]
+  -> H.Html
+journalPage l10n loc mcookie mpage entries =
+  scaffold l10n loc mcookie (initPage $
+    translate "Matebeamter" <>
+    " - " <>
+    translate "Journal"
+    ) $ do
+      H.table $ do
+        H.thead $
+          H.tr $ do
+            H.th (H.toHtml $ translate "ID")
+            H.th (H.toHtml $ translate "Time")
+            H.th (H.toHtml $ translate "Description")
+            H.th (H.toHtml $ translate "Amount")
+            H.th (H.toHtml $ translate "Total amount")
+        mapM_
+          (\(MT.JournalEntry jid desc time amount total check) ->
+            H.tr
+              H.!? (check, HA.class_ "checked")
+              $ do
+                H.td (H.toHtml $ show jid)
+                H.td (H.toHtml $ show time)
+                H.td (H.toHtml desc)
+                H.td (H.toHtml $ formatMoney amount)
+                H.td (H.toHtml $ formatMoney total)
+            )
+          entries
+      let page = fromMaybe 0 mpage
+      H.form $ do
+        when (page /= 0) $
+          H.a
+            H.! HA.href
+              ("/" <> fromString
+                (show $ linkURI (journalLink (Just $ page - 1)))
+                )
+            $ H.toHtml $ translate "Previous Page"
+        when (length entries == 50) $
+          H.a
+            H.! HA.href
+              ("/" <> fromString
+                (show $ linkURI (journalLink (Just $ page + 1)))
+                )
+            $ H.toHtml $ translate "Next Page"
+  where
+    translate = localize l10n loc . gettext

src/View/User.hs

@@ -113,8 +113,19 @@ userSettingsPointer
   -> Int
   -> H.Html
 userSettingsPointer l10n locale uid =
-  H.a H.! HA.href ("/" <> fromString (show $ linkURI $ userManageLink uid)) $
-    H.toHtml $ translate "Manage user settings"
+  H.form $ do
+    H.button
+      H.! HA.type_ "submit"
+      H.! HA.formmethod "get"
+      H.! HA.formaction
+        ("/" <> fromString (show $ linkURI $ userManageLink uid))
+      $ H.toHtml $ translate "Manage user settings"
+    H.button
+      H.! HA.type_ "submit"
+      H.! HA.formmethod "get"
+      H.! HA.formaction
+        ("/" <> fromString (show $ linkURI $ journalLink Nothing))
+      $ H.toHtml $ translate "View Journal"
   where
     translate = localize l10n locale . gettext