provide metainformation to frontends

app/Main.hs

@@ -14,6 +14,7 @@ import Data.ByteString.Lazy as BL hiding (putStrLn)
 import qualified Data.Text as T
 import Data.String
 import Data.YAML
+import Data.Version (showVersion)
 
 import Database.PostgreSQL.Simple
 
@@ -39,6 +40,8 @@ import Types
 import Control
 import Janitor
 
+import Paths_mateamt (version)
+
 main :: IO ()
 main = do
   (Options confLoc) <- execParser opts
@@ -88,6 +91,8 @@ main = do
                 initState = ReadState
                   { rsConnection  = conn
                   , rsTicketStore = store
+                  , rsCurrencySymbol = sym
+                  , rsSoftwareVersion = T.pack (showVersion version)
                   }
             runSettings settings (app block_registration initState)
   where
@@ -193,7 +198,9 @@ app block_registration initState =
         avatarGet :<|>
         avatarInsert :<|>
         avatarUpdate :<|>
-        avatarList
+        avatarList :<|>
+
+        metaGet
       )
 
 mateApi :: Proxy MateAPI

mateamt.cabal

@@ -25,6 +25,7 @@ executable mateamt
   other-modules:       AppTypes
                      , AppTypes.Configuration
                      , Janitor
+                     , Paths_mateamt
   -- other-extensions:
   build-depends:       base >=4.12.0.0 && < 5
                      , mateamt
@@ -58,6 +59,7 @@ library
                      , Control.Product
                      , Control.Auth
                      , Control.Avatar
+                     , Control.Meta
                      , Model
                      , Model.User
                      , Model.Product
@@ -75,6 +77,7 @@ library
                      , Types.Amount
                      , Types.Journal
                      , Types.Avatar
+                     , Types.Meta
                      , Util
   -- other-extensions:
   build-depends:       base >=4.12.0.0 && < 5

src/API.hs

@@ -17,7 +17,7 @@ import Data.Proxy
 
 import Types
 
-type MateAPI =
+type MateAPI = "v1" :> (
   "auth" :> "get" :> ReqBody '[JSON] TicketRequest :> Post '[JSON] AuthInfo
   :<|> "auth" :> ReqBody '[JSON] AuthRequest :> Post '[JSON] AuthResult
   :<|> "auth" :> AuthProtect "header-auth" :> Delete '[JSON] ()
@@ -68,6 +68,9 @@ type MateAPI =
     :> ReqBody '[JSON] AvatarData :> Patch '[JSON] ()
   :<|> "avatar" :> "list" :> Get '[JSON] [Avatar]
 
+  :<|> "meta" :> Get '[JSON] MetaInformation
+  )
+
 
 authGetLink :: Link
 authSendLink :: Link
@@ -101,6 +104,8 @@ avaterInsertLink :: Link
 avatarUpdateLink :: Int -> Link
 avatarListLink :: Link
 
+metaGetLink :: Link
+
 ( authGetLink :<|>
   authSendLink :<|>
   authLogoutLink :<|>
@@ -131,5 +136,7 @@ avatarListLink :: Link
   avatarGetLink :<|>
   avaterInsertLink :<|>
   avatarUpdateLink :<|>
-  avatarListLink
+  avatarListLink :<|>
+
+  metaGetLink
   ) = allLinks (Proxy :: Proxy MateAPI)

src/Control.hs

@@ -8,3 +8,4 @@ import Control.User as C
 import Control.Auth as C
 import Control.Product as C
 import Control.Avatar as C
+import Control.Meta as C

src/Control/Meta.hs

@@ -0,0 +1,20 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Control.Meta where
+
+import Servant
+
+import Control.Monad.Reader (ask)
+
+-- internal imports
+
+import Types
+import Model
+
+metaGet :: MateHandler MetaInformation
+metaGet = do
+  (ReadState _ _ symbol version) <- ask
+  return (MetaInformation
+    { metaInfoVersion = version
+    , metaInfoCurrency = symbol
+    }
+    )

src/Model/Product.hs

@@ -331,7 +331,7 @@ manualProductAmountRefill aups conn =
             [
             ( C.constant pid
             , C.constant now
-            , C.constant (oldamount + amountSingles + perCrate * amountCrates)
+            , C.constant (oldamount + (amountSingles + (perCrate * amountCrates)))
             , C.constant oldprice
             , C.constant False
             )

src/Types.hs

@@ -11,3 +11,4 @@ import Types.Purchase as T
 import Types.Amount as T
 import Types.Journal as T
 import Types.Avatar as T
+import Types.Meta as T

src/Types/Meta.hs

@@ -0,0 +1,19 @@
+{-# LANGUAGE DeriveGeneric #-}
+module Types.Meta where
+
+import qualified Data.Text as T
+
+import Data.Aeson
+
+import GHC.Generics
+
+data MetaInformation = MetaInformation
+  { metaInfoVersion  :: T.Text
+  , metaInfoCurrency :: T.Text
+  }
+  deriving (Show, Generic)
+
+instance ToJSON MetaInformation where
+  toEncoding = genericToEncoding defaultOptions
+
+instance FromJSON MetaInformation

src/Types/Reader.hs

@@ -1,5 +1,7 @@
 module Types.Reader where
 
+import qualified Data.Text as T
+
 import Servant (Handler)
 
 import Control.Monad.Reader (ReaderT)
@@ -13,6 +15,8 @@ import Types.Auth (TicketStore)
 data ReadState = ReadState
   { rsConnection      :: Connection
   , rsTicketStore     :: TicketStore
+  , rsCurrencySymbol  :: T.Text
+  , rsSoftwareVersion :: T.Text
   }
 
 type MateHandler = ReaderT ReadState Handler