swagger now works!

This commit is contained in:
nek0 2022-07-17 21:28:22 +02:00
parent f3891f2bfe
commit 7aea50af90
20 changed files with 191 additions and 96 deletions

View File

@ -3,3 +3,4 @@ module AppTypes
) where
import AppTypes.Configuration as T
import AppTypes.SwaggerAPI as T

View File

@ -1,13 +1,18 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Main where
import Prelude as P
import Servant
import Servant.Server.Experimental.Auth
import qualified Servant.OpenApi as OA
import Servant.RawM
import Data.Set as S (empty)
import Data.ByteString.Char8 as B8 hiding (putStrLn)
@ -16,6 +21,9 @@ import Data.String
import Data.Yaml
import Data.Version (showVersion)
import Data.IP
import qualified Data.OpenApi as OA hiding (Server)
import Data.Typeable
import Data.Data (Typeable)
import Database.PostgreSQL.Simple
import Database.PostgreSQL.Simple.Migration
@ -32,6 +40,8 @@ import Control.Monad.Reader
import Control.Concurrent.STM.TVar
import Control.Lens hiding (Context)
import Options.Applicative
import System.Clock (TimeSpec(..))
@ -153,56 +163,73 @@ main = do
app :: ReadState -> Application
-- app conn = serveWithContext userApi genAuthServerContext (users conn)
app initState =
serveWithContext mateApi (genAuthServerContext (rsConnection initState)) $
serveWithContext combinedAPI (genAuthServerContext (rsConnection initState)) $
hoistServerWithContext
mateApi
combinedAPI
authProxy
(`runReaderT` initState)
( authGet :<|>
authSend :<|>
authLogout :<|>
( mateSwagger :<|>
( authGet :<|>
authSend :<|>
authLogout :<|>
authManageList :<|>
authManageNewAuth :<|>
authManageDeleteAuth :<|>
authManageList :<|>
authManageNewAuth :<|>
authManageDeleteAuth :<|>
userNew :<|>
userGet :<|>
userUpdate :<|>
userList :<|>
userRecharge :<|>
userTransfer :<|>
userNew :<|>
userGet :<|>
userUpdate :<|>
userList :<|>
userRecharge :<|>
userTransfer :<|>
productNew :<|>
productOverview :<|>
productStockRefill :<|>
productStockUpdate :<|>
productList :<|>
productShortList :<|>
productNew :<|>
productOverview :<|>
productStockRefill :<|>
productStockUpdate :<|>
productList :<|>
productShortList :<|>
buy :<|>
buy :<|>
journalShow :<|>
journalCheck :<|>
journalShow :<|>
journalCheck :<|>
avatarGet :<|>
avatarInsert :<|>
avatarUpdate :<|>
avatarList :<|>
avatarGet :<|>
avatarInsert :<|>
avatarUpdate :<|>
avatarList :<|>
roleList :<|>
roleNew :<|>
roleUpdate :<|>
roleDelete :<|>
roleAssociationList :<|>
roleAssociationSubmit :<|>
roleAssociationDelete :<|>
roleList :<|>
roleNew :<|>
roleUpdate :<|>
roleDelete :<|>
roleAssociationList :<|>
roleAssociationSubmit :<|>
roleAssociationDelete :<|>
metaGet
metaGet
)
)
mateApi :: Proxy MateAPI
mateApi = Proxy
mateSwagger :: ReaderT ReadState Handler OA.OpenApi
mateSwagger = return $ OA.toOpenApi mateAPI
& OA.info.OA.title .~ "Mateamt API"
& OA.info.OA.version .~ "1.0"
& OA.info.OA.description ?~ "AN API to buy Mate and other products from your local Hackerspace or event."
& OA.info.OA.license ?~ ("AGPL" & OA.url ?~ OA.URL "https://www.gnu.org/licenses/agpl-3.0-standalone.html")
mateAPI :: Proxy MateAPI
mateAPI = Proxy
swaggerAPI :: Proxy SwaggerAPI
swaggerAPI = Proxy
combinedAPI :: Proxy CombinedAPI
combinedAPI = Proxy
type CombinedAPI = SwaggerAPI :<|> MateAPI
authProxy :: Proxy '[ AuthHandler Request (Maybe (Int, AuthMethod)) ]
authProxy = Proxy
@ -225,3 +252,9 @@ authHandler conn = mkAuthHandler handler
validateToken hh conn
_ ->
return Nothing
instance OA.HasOpenApi sub => OA.HasOpenApi (AuthProtect "header-auth" :> sub) where
toOpenApi _ = OA.toOpenApi (Proxy :: Proxy sub)
instance OA.HasOpenApi (RawM' Application) where
toOpenApi _ = OA.toOpenApi (Proxy :: Proxy (Get '[JSON] NoContent))

View File

@ -84,6 +84,7 @@ library
, bytestring >=0.10.12.0
, base16-bytestring
, base64-bytestring
, lens
, openapi3 >=3
, random
, servant
@ -119,6 +120,7 @@ executable mateamt
other-modules:
AppTypes
AppTypes.Configuration
AppTypes.SwaggerAPI
Janitor
Paths_mateamt
other-extensions:
@ -136,13 +138,17 @@ executable mateamt
, containers >=0.6.2.1
, bytestring >=0.10.12.0
, base16-bytestring
, lens
, opaleye
, openapi3
, postgresql-simple
, postgresql-simple-migration
, stm
, network
, servant
, servant-server
, servant-rawm
, servant-openapi3
, warp
, wai
, wai-logger

View File

@ -9,6 +9,7 @@ module API where
import Servant.API
import Servant.Links
import Servant.Server
import Data.Proxy
@ -24,32 +25,32 @@ import Types
type MateAPI = "v1" :> (
"auth" :> "get" :> ReqBody '[JSON] TicketRequest :> Post '[JSON] AuthInfo
:<|> "auth" :> ReqBody '[JSON] AuthRequest :> Post '[JSON] AuthResult
:<|> "auth" :> AuthProtect "header-auth" :> Delete '[JSON] ()
:<|> "auth" :> AuthProtect "header-auth" :> Delete '[JSON] NoContent
:<|> "auth" :> "manage" :> AuthProtect "header-auth"
:> Get '[JSON] [AuthOverview]
:<|> "auth" :> "manage" :> AuthProtect "header-auth"
:> ReqBody '[JSON] AuthSubmit :> Post '[JSON] Int
:<|> "auth" :> "manage" :> AuthProtect "header-auth"
:> ReqBody '[JSON] Int :> Delete '[JSON] ()
:> ReqBody '[JSON] Int :> Delete '[JSON] NoContent
:<|> "user" :> ReqBody '[JSON] UserSubmit :> Post '[JSON] Int
:<|> "user" :> AuthProtect "header-auth" :> Get '[JSON] UserDetails
:<|> "user" :> AuthProtect "header-auth"
:> ReqBody '[JSON] UserDetailsSubmit :> Patch '[JSON] ()
:> ReqBody '[JSON] UserDetailsSubmit :> Patch '[JSON] NoContent
:<|> "user" :> "list" :> QueryParam "refine" UserRefine :> Get '[JSON] [UserSummary]
:<|> "user" :> "recharge" :> AuthProtect "header-auth"
:> ReqBody '[JSON] UserRecharge :> Post '[JSON] ()
:> ReqBody '[JSON] UserRecharge :> Post '[JSON] NoContent
:<|> "user" :> "transfer" :> AuthProtect "header-auth"
:> ReqBody '[JSON] UserTransfer :> Post '[JSON] ()
:> ReqBody '[JSON] UserTransfer :> Post '[JSON] NoContent
:<|> "product" :> AuthProtect "header-auth" :> ReqBody '[JSON] ProductSubmit
:> Post '[JSON] Int
:<|> "product" :> Capture "pid" Int :> Get '[JSON] ProductOverview
:<|> "product" :> AuthProtect "header-auth"
:> ReqBody '[JSON] [AmountRefill] :> Patch '[JSON] ()
:> ReqBody '[JSON] [AmountRefill] :> Patch '[JSON] NoContent
:<|> "product" :> AuthProtect "header-auth"
:> ReqBody '[JSON] [AmountUpdate] :> Put '[JSON] ()
:> ReqBody '[JSON] [AmountUpdate] :> Put '[JSON] NoContent
:<|> "product" :> "list" :> QueryParam "refine" ProductRefine
:> Get '[JSON] [ProductOverview]
:<|> "product" :> "shortlist" :> QueryParam "refine" ProductRefine
@ -63,13 +64,13 @@ type MateAPI = "v1" :> (
:> Get '[JSON] [JournalEntry]
:<|> "journal" :> AuthProtect "header-auth"
:> ReqBody '[JSON] JournalCashCheck
:> Post '[JSON] ()
:> Post '[JSON] NoContent
:<|> "avatar" :> Capture "id" Int :> RawM' Application
:<|> "avatar" :> AuthProtect "header-auth" :> ReqBody '[JSON] AvatarData
:> Post '[JSON] Int
:<|> "avatar" :> AuthProtect "header-auth" :> Capture "id" Int
:> ReqBody '[JSON] AvatarData :> Patch '[JSON] ()
:> ReqBody '[JSON] AvatarData :> Patch '[JSON] NoContent
:<|> "avatar" :> "list" :> Get '[JSON] [Avatar]
:<|> "role" :> "list"
@ -78,17 +79,17 @@ type MateAPI = "v1" :> (
:> Post '[JSON] Int
:<|> "role" :> AuthProtect "header-auth" :> Capture "rid" Int
:> ReqBody '[JSON] RoleSubmit
:> Patch '[JSON] ()
:> Patch '[JSON] NoContent
:<|> "role" :> AuthProtect "header-auth" :> ReqBody '[JSON] Int
:> Delete '[JSON] ()
:> Delete '[JSON] NoContent
:<|> "role" :> "association" :> "list"
:> Get '[JSON] [RoleAssociation]
:<|> "role" :> "association" :> AuthProtect "header-auth"
:> ReqBody '[JSON] RoleAssociationSubmit
:> Post '[JSON] ()
:> Post '[JSON] NoContent
:<|> "role" :> "association" :> AuthProtect "header-auth"
:> ReqBody '[JSON] RoleAssociation
:> Delete '[JSON] ()
:> Delete '[JSON] NoContent
:<|> "meta" :> Get '[JSON] MetaInformation
)

View File

@ -39,9 +39,10 @@ authSend req = uncurry (processAuthRequest req) =<< ((,) <$>
authLogout
:: Maybe (Int, AuthMethod)
-> MateHandler ()
authLogout (Just (muid, _)) =
-> MateHandler NoContent
authLogout (Just (muid, _)) = do
processLogout muid =<< asks rsConnection
return NoContent
authLogout Nothing =
throwError $ err401
{ errBody = "Unauthorized access"
@ -93,7 +94,7 @@ authManageNewAuth Nothing _ =
authManageDeleteAuth
:: Maybe (Int, AuthMethod)
-> Int
-> MateHandler ()
-> MateHandler NoContent
authManageDeleteAuth (Just (uid, method)) adid =
if method `elem` [PrimaryPass, ChallengeResponse]
then do
@ -102,12 +103,18 @@ authManageDeleteAuth (Just (uid, method)) adid =
let currentad = head (filter (\ad -> authOverviewId ad == adid) ads)
case authOverviewMethod currentad of
PrimaryPass -> if validateDeletion ads
then void (deleteAuthDataById adid conn)
then do
void (deleteAuthDataById adid conn)
return NoContent
else throwUnacceptableDeletionError
ChallengeResponse -> if validateDeletion ads
then void (deleteAuthDataById adid conn)
then do
void (deleteAuthDataById adid conn)
return NoContent
else throwUnacceptableDeletionError
_ -> void $ deleteAuthDataById adid conn
_ -> do
void $ deleteAuthDataById adid conn
return NoContent
else
throwError $ err401
{ errBody = "Unauthorized access"

View File

@ -64,10 +64,11 @@ avatarUpdate
:: Maybe (Int, AuthMethod)
-> Int
-> AvatarData
-> MateHandler ()
-> MateHandler NoContent
avatarUpdate (Just _) aid ad = do
conn <- asks rsConnection
void $ updateAvatar aid ad (md5 $ BS.pack $ avatarDataData ad) conn
return NoContent
avatarUpdate Nothing _ _ =
throwError $ err401
{ errBody = "No Authentication present."

View File

@ -35,13 +35,14 @@ journalShow Nothing _ _ =
journalCheck
:: Maybe (Int, AuthMethod)
-> JournalCashCheck
-> MateHandler ()
-> MateHandler NoContent
journalCheck (Just (uid, method)) check = do
mayCheckJournal <- checkCapability uid roleCanManageJournal
if method `elem` [PrimaryPass, ChallengeResponse] && mayCheckJournal
then do
conn <- asks rsConnection
void $ insertNewCashCheck check conn
return NoContent
else
throwError $ err401
{ errBody = "Wrong Authentication present"

View File

@ -48,7 +48,7 @@ productOverview pid = do
productStockRefill
:: Maybe (Int, AuthMethod)
-> [AmountRefill]
-> MateHandler ()
-> MateHandler NoContent
productStockRefill (Just (uid, auth)) amorefs = do
mayRefill <- anyM
(checkCapability uid)
@ -71,6 +71,7 @@ productStockRefill (Just (uid, auth)) amorefs = do
amorefs
then do
void $ manualProductAmountRefill amorefs conn
return NoContent
else
throwError $ err400
{ errBody = "Amounts less than 0 are not acceptable."
@ -91,7 +92,7 @@ productStockRefill Nothing _ =
productStockUpdate
:: Maybe (Int, AuthMethod)
-> [AmountUpdate]
-> MateHandler ()
-> MateHandler NoContent
productStockUpdate (Just (uid, method)) amoups = do
mayUpdateStock <- checkCapability uid roleCanManageProducts
if method `elem` [PrimaryPass, ChallengeResponse] && mayUpdateStock
@ -100,6 +101,7 @@ productStockUpdate (Just (uid, method)) amoups = do
then do
conn <- asks rsConnection
void $ manualProductAmountUpdate amoups conn
return NoContent
else
throwError $ err400
{ errBody = "Amounts less than 0 are not acceptable."

View File

@ -41,12 +41,13 @@ roleUpdate
:: Maybe (Int, AuthMethod)
-> Int
-> RoleSubmit
-> MateHandler ()
-> MateHandler NoContent
roleUpdate (Just (uid, auth)) id_ roleSubmit = do
isRoleManager <- checkCapability uid roleCanManageRoles
if auth `elem` [PrimaryPass, ChallengeResponse] && isRoleManager
then
then do
void $ updateRole id_ roleSubmit =<< asks rsConnection
return NoContent
else
throwError $ err401
{ errBody = "You are not authorized for this action."
@ -59,12 +60,13 @@ roleUpdate Nothing _ _ =
roleDelete
:: Maybe (Int, AuthMethod)
-> Int
-> MateHandler ()
-> MateHandler NoContent
roleDelete (Just (uid, auth)) id_ = do
isRoleManager <- checkCapability uid roleCanManageRoles
if auth `elem` [PrimaryPass, ChallengeResponse] && isRoleManager
then
then do
void $ deleteRole id_ =<< asks rsConnection
return NoContent
else
throwError $ err401
{ errBody = "You are not authorized for this action."
@ -82,12 +84,13 @@ roleAssociationList =
roleAssociationSubmit
:: Maybe (Int, AuthMethod)
-> RoleAssociationSubmit
-> MateHandler ()
-> MateHandler NoContent
roleAssociationSubmit (Just (uid, auth)) (RoleAssociationSubmit auid arid) = do
isRoleManager <- checkCapability uid roleCanManageRoles
if auth `elem` [PrimaryPass, ChallengeResponse] && isRoleManager
then
then do
associateUserToRole auid arid =<< asks rsConnection
return NoContent
else
throwError $ err401
{ errBody = "You are not authorized for this action."
@ -100,12 +103,13 @@ roleAssociationSubmit Nothing _ =
roleAssociationDelete
:: Maybe (Int, AuthMethod)
-> RoleAssociation
-> MateHandler ()
-> MateHandler NoContent
roleAssociationDelete (Just (uid, auth)) (RoleAssociation auid arid) = do
isRoleManager <- checkCapability uid roleCanManageRoles
if auth `elem` [PrimaryPass, ChallengeResponse] && isRoleManager
then
then do
void $ deleteAssociation auid arid =<< asks rsConnection
return NoContent
else
throwError $ err401
{ errBody = "You are not authorized for this action."

View File

@ -78,7 +78,7 @@ userGetAll (Just (_, _)) = do
userUpdate
:: Maybe (Int, AuthMethod)
-> UserDetailsSubmit
-> MateHandler ()
-> MateHandler NoContent
userUpdate Nothing _ =
throwError $ err401
{ errBody = "No Authentication present."
@ -89,6 +89,7 @@ userUpdate (Just (aid, method)) uds =
now <- liftIO getCurrentTime
conn <- asks rsConnection
void $ updateUserDetails aid uds (utctDay now) conn
return NoContent
else
throwError $ err401
{ errBody = "Wrong Authentication present."
@ -96,11 +97,12 @@ userUpdate (Just (aid, method)) uds =
userUpdateTimestamp
:: Maybe (Int, AuthMethod)
-> MateHandler ()
-> MateHandler NoContent
userUpdateTimestamp (Just (aid, _)) = do
now <- liftIO getCurrentTime
conn <- asks rsConnection
void $ updateUserTimestamp aid (utctDay now) conn
return NoContent
userUpdateTimestamp Nothing =
throwError $ err401
{ errBody = "No Authentication present."
@ -116,7 +118,7 @@ userList ref = do
userRecharge
:: Maybe (Int, AuthMethod)
-> UserRecharge
-> MateHandler ()
-> MateHandler NoContent
userRecharge (Just (auid, _)) (UserRecharge amount) = do
when (amount < 0) $
throwError $ err400
@ -132,6 +134,7 @@ userRecharge (Just (auid, _)) (UserRecharge amount) = do
)
conn
void $ addToUserBalance auid amount conn
return NoContent
userRecharge Nothing _ =
throwError $ err401
{ errBody = "No Authentication present."
@ -140,7 +143,7 @@ userRecharge Nothing _ =
userTransfer
:: Maybe (Int, AuthMethod)
-> UserTransfer
-> MateHandler ()
-> MateHandler NoContent
userTransfer (Just (auid, method)) (UserTransfer target amount) = do
when (amount < 0) $
throwError $ err400
@ -167,6 +170,7 @@ userTransfer (Just (auid, method)) (UserTransfer target amount) = do
}
void $ addToUserBalance auid (-amount) conn
void $ addToUserBalance target amount conn
return NoContent
userTransfer Nothing _ =
throwError $ err401
{ errBody = "No Authentication present."
@ -176,7 +180,7 @@ userNotify
:: Maybe (Int, AuthMethod)
-> [PurchaseDetail]
-> PurchaseResult
-> MateHandler ()
-> MateHandler NoContent
userNotify (Just (auid, _)) boughtItems (PurchaseResult flag _) = do
conn <- asks rsConnection
authOV <- selectAuthOverviewById auid conn
@ -240,8 +244,9 @@ userNotify (Just (auid, _)) boughtItems (PurchaseResult flag _) = do
userDetails
(__ "Purchase notification")
messageText
return NoContent
Nothing ->
return ()
return NoContent
userNotify Nothing _ _ =
throwError $ err401
{ errBody = "No Authentication present."

View File

@ -4,8 +4,10 @@ module Types.Amount where
import GHC.Generics
import Data.Aeson
import Data.OpenApi
import Data.Time (UTCTime)
-- internal imports
@ -22,7 +24,7 @@ instance ToJSON AmountUpdate where
toEncoding = genericToEncoding defaultOptions
instance FromJSON AmountUpdate
instance ToSchema AmountUpdate
data AmountRefill = AmountRefill
{ amountRefillProductId :: Int
@ -35,7 +37,7 @@ instance ToJSON AmountRefill where
toEncoding = genericToEncoding defaultOptions
instance FromJSON AmountRefill
instance ToSchema AmountRefill
data Amount = Amount
{ amountProductId :: Int

View File

@ -13,6 +13,8 @@ import Data.Time.Clock (UTCTime)
import Data.ByteString (ByteString)
import Data.OpenApi
import qualified Data.Text as T
import Data.Text.Encoding
@ -32,7 +34,7 @@ instance ToJSON TicketRequest where
toEncoding = genericToEncoding defaultOptions
instance FromJSON TicketRequest
instance ToSchema TicketRequest
data AuthInfo = AuthInfo
{ authChallenge :: Maybe T.Text
@ -44,6 +46,7 @@ instance ToJSON AuthInfo where
toEncoding = genericToEncoding defaultOptions
instance FromJSON AuthInfo
instance ToSchema AuthInfo
-- instance ToDatabase AuthInfo where
--
@ -71,6 +74,8 @@ instance ToJSON AuthMethod where
instance FromJSON AuthMethod
instance ToSchema AuthMethod
instance ToParamSchema AuthMethod
data AuthSubmit = AuthSubmit
{ authSubmitMethod :: AuthMethod
@ -83,7 +88,7 @@ instance ToJSON AuthSubmit where
toEncoding = genericToEncoding defaultOptions
instance FromJSON AuthSubmit
instance ToSchema AuthSubmit
newtype AuthTicket = AuthTicket T.Text deriving (Show, Generic, Eq, Ord)
@ -91,7 +96,7 @@ instance ToJSON AuthTicket where
toEncoding = genericToEncoding defaultOptions
instance FromJSON AuthTicket
instance ToSchema AuthTicket
newtype AuthResponse = AuthResponse T.Text deriving (Show, Generic)
@ -99,7 +104,7 @@ instance ToJSON AuthResponse where
toEncoding = genericToEncoding defaultOptions
instance FromJSON AuthResponse
instance ToSchema AuthResponse
data AuthRequest = AuthRequest
{ authRequestTicket :: AuthTicket
@ -111,7 +116,7 @@ instance ToJSON AuthRequest where
toEncoding = genericToEncoding defaultOptions
instance FromJSON AuthRequest
instance ToSchema AuthRequest
data AuthResult
= Granted
@ -124,7 +129,7 @@ instance ToJSON AuthResult where
toEncoding = genericToEncoding defaultOptions
instance FromJSON AuthResult
instance ToSchema AuthResult
newtype AuthToken = AuthToken T.Text deriving (Show, Generic)
@ -132,7 +137,7 @@ instance ToJSON AuthToken where
toEncoding = genericToEncoding defaultOptions
instance FromJSON AuthToken
instance ToSchema AuthToken
data Token = Token
{ tokenString :: T.Text
@ -209,6 +214,7 @@ instance ToJSON AuthOverview where
toEncoding = genericToEncoding defaultOptions
instance FromJSON AuthOverview
instance ToSchema AuthOverview
-- instance ToDatabase AuthOverview where
--

View File

@ -10,6 +10,7 @@ import Data.Text.Encoding (decodeUtf8)
import Data.Word (Word8)
import Data.Aeson
import Data.OpenApi (ToSchema)
import GHC.Generics
@ -28,6 +29,7 @@ instance ToJSON Avatar where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Avatar
instance ToSchema Avatar
instance FromDatabase Avatar where
type OutTuple Avatar = (Int, T.Text, ByteString, ByteString)
@ -46,6 +48,7 @@ instance ToJSON AvatarData where
toEncoding = genericToEncoding defaultOptions
instance FromJSON AvatarData
instance ToSchema AvatarData
instance FromDatabase AvatarData where
type OutTuple AvatarData = (T.Text, ByteString)

View File

@ -7,6 +7,7 @@ import GHC.Generics
import Data.Aeson
import Data.Time (UTCTime)
import Data.OpenApi (ToSchema)
data JournalEntry = JournalEntry
{ journalEntryId :: Int
@ -23,7 +24,7 @@ instance ToJSON JournalEntry where
toEncoding = genericToEncoding defaultOptions
instance FromJSON JournalEntry
instance ToSchema JournalEntry
data JournalSubmit = JournalSubmit
{ journalSubmitUser :: Maybe Int
@ -36,7 +37,7 @@ instance ToJSON JournalSubmit where
toEncoding = genericToEncoding defaultOptions
instance FromJSON JournalSubmit
instance ToSchema JournalSubmit
data JournalCashCheck = JournalCashCheck
{ journalCashCheckUser :: Int
@ -48,6 +49,7 @@ instance ToJSON JournalCashCheck where
toEncoding = genericToEncoding defaultOptions
instance FromJSON JournalCashCheck
instance ToSchema JournalCashCheck
data JournalAction
= CashCheck
@ -61,3 +63,4 @@ instance ToJSON JournalAction where
toEncoding = genericToEncoding defaultOptions
instance FromJSON JournalAction
instance ToSchema JournalAction

View File

@ -6,6 +6,7 @@ import qualified Data.Text as T
import Data.Aeson
import GHC.Generics
import Data.OpenApi (ToSchema)
data MetaInformation = MetaInformation
{ metaInfoVersion :: T.Text
@ -18,3 +19,4 @@ instance ToJSON MetaInformation where
toEncoding = genericToEncoding defaultOptions
instance FromJSON MetaInformation
instance ToSchema MetaInformation

View File

@ -5,6 +5,7 @@ module Types.Product where
import GHC.Generics
import Data.Aeson
import Data.OpenApi (ToSchema)
import qualified Data.Text as T
@ -33,6 +34,7 @@ instance ToJSON Product where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Product
instance ToSchema Product
instance ToDatabase Product where
@ -72,7 +74,7 @@ instance ToJSON ProductOverview where
toEncoding = genericToEncoding defaultOptions
instance FromJSON ProductOverview
instance ToSchema ProductOverview
data ProductShortOverview = ProductShortOverview
{ productShortOverviewId :: Int
@ -94,7 +96,7 @@ instance ToJSON ProductShortOverview where
toEncoding = genericToEncoding defaultOptions
instance FromJSON ProductShortOverview
instance ToSchema ProductShortOverview
data ProductSubmit = ProductSubmit
{ productSubmitIdent :: T.Text
@ -116,3 +118,4 @@ instance ToJSON ProductSubmit where
toEncoding = genericToEncoding defaultOptions
instance FromJSON ProductSubmit
instance ToSchema ProductSubmit

View File

@ -5,6 +5,7 @@ module Types.Purchase where
import Data.Aeson
import GHC.Generics
import Data.OpenApi (ToSchema)
data PurchaseDetail = PurchaseDetail
@ -17,7 +18,7 @@ instance ToJSON PurchaseDetail where
toEncoding = genericToEncoding defaultOptions
instance FromJSON PurchaseDetail
instance ToSchema PurchaseDetail
data PurchaseResult = PurchaseResult
{ purchaseResultFlag :: PurchaseResultFlag
@ -29,7 +30,7 @@ instance ToJSON PurchaseResult where
toEncoding = genericToEncoding defaultOptions
instance FromJSON PurchaseResult
instance ToSchema PurchaseResult
data PurchaseResultFlag
= PurchaseOK
@ -41,3 +42,4 @@ instance ToJSON PurchaseResultFlag where
toEncoding = genericToEncoding defaultOptions
instance FromJSON PurchaseResultFlag
instance ToSchema PurchaseResultFlag

View File

@ -4,7 +4,7 @@ module Types.Role where
import qualified Data.Text as T
import Data.Aeson
import Data.OpenApi (ToSchema)
import GHC.Generics
-- internal imports
@ -35,6 +35,7 @@ instance ToJSON Role where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Role
instance ToSchema Role
instance ToDatabase Role where
@ -71,6 +72,7 @@ instance ToJSON RoleSubmit where
toEncoding = genericToEncoding defaultOptions
instance FromJSON RoleSubmit
instance ToSchema RoleSubmit
data RoleAssociation = RoleAssociation
{ roleAssociationUser :: Int
@ -82,6 +84,7 @@ instance ToJSON RoleAssociation where
toEncoding = genericToEncoding defaultOptions
instance FromJSON RoleAssociation
instance ToSchema RoleAssociation
data RoleAssociationSubmit = RoleAssociationSubmit
{ roleAssociationSubmitUser :: Int
@ -93,3 +96,4 @@ instance ToJSON RoleAssociationSubmit where
toEncoding = genericToEncoding defaultOptions
instance FromJSON RoleAssociationSubmit
instance ToSchema RoleAssociationSubmit

View File

@ -5,8 +5,8 @@ module Types.User where
import GHC.Generics
import Data.Time.Calendar (Day)
import Data.Aeson
import Data.OpenApi (ToSchema)
import qualified Data.Text as T
@ -54,7 +54,7 @@ instance ToJSON UserSummary where
toEncoding = genericToEncoding defaultOptions
instance FromJSON UserSummary
instance ToSchema UserSummary
data UserSubmit = UserSubmit
{ userSubmitIdent :: T.Text
@ -67,7 +67,7 @@ instance ToJSON UserSubmit where
toEncoding = genericToEncoding defaultOptions
instance FromJSON UserSubmit
instance ToSchema UserSubmit
data UserDetails = UserDetails
{ userDetailsId :: Int
@ -84,7 +84,7 @@ instance ToJSON UserDetails where
toEncoding = genericToEncoding defaultOptions
instance FromJSON UserDetails
instance ToSchema UserDetails
data UserDetailsSubmit = UserDetailsSubmit
{ userDetailsSubmitIdent :: T.Text
@ -99,7 +99,7 @@ instance ToJSON UserDetailsSubmit where
toEncoding = genericToEncoding defaultOptions
instance FromJSON UserDetailsSubmit
instance ToSchema UserDetailsSubmit
newtype UserRecharge = UserRecharge
{ userRechargeAmount :: Int
@ -110,7 +110,7 @@ instance ToJSON UserRecharge where
toEncoding = genericToEncoding defaultOptions
instance FromJSON UserRecharge
instance ToSchema UserRecharge
data UserTransfer = UserTransfer
{ userTransferTarget :: Int
@ -122,3 +122,4 @@ instance ToJSON UserTransfer where
toEncoding = genericToEncoding defaultOptions
instance FromJSON UserTransfer
instance ToSchema UserTransfer

View File

@ -155,3 +155,11 @@ sendNotification mail = do
else
print ("Warning: sending notification failed: Sendmail not present!"
:: String)
err200 :: ServerError
err200 = ServerError
{ errHTTPCode = 200
, errBody = "OK"
, errReasonPhrase = "RequestScceeded"
, errHeaders = []
}