provide metainformation to frontends

This commit is contained in:
nek0 2019-12-19 02:40:54 +01:00
parent 13fc158a16
commit 313df9af39
9 changed files with 68 additions and 6 deletions

View file

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

View file

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

View file

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

View file

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

20
src/Control/Meta.hs Normal file
View file

@ -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
}
)

View file

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

View file

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

19
src/Types/Meta.hs Normal file
View file

@ -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

View file

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