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

View File

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

View File

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

View File

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

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 now
, C.constant (oldamount + amountSingles + perCrate * amountCrates)
, C.constant (oldamount + (amountSingles + (perCrate * amountCrates)))
, C.constant oldprice
, C.constant False
)

View File

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

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