starting purchase implementation
This commit is contained in:
parent
867481e9d1
commit
c83f37607d
6 changed files with 76 additions and 0 deletions
|
@ -33,6 +33,7 @@ executable mateamt
|
|||
, Types.Reader
|
||||
, Types.Refine
|
||||
, Types.User
|
||||
, Types.Purchase
|
||||
-- other-extensions:
|
||||
build-depends: base ^>=4.12.0.0
|
||||
, servant
|
||||
|
|
|
@ -38,6 +38,8 @@ type UserAPI =
|
|||
:<|> "update" :> AuthProtect "header-auth"
|
||||
:> Capture "id" Int :> ReqBody '[JSON] ProductSubmit :> Post '[JSON] ()
|
||||
)
|
||||
:<|> "buy" :> AuthProtect "header-auth" :> ReqBody '[JSON] [PurchaseDetail]
|
||||
:> Post '[JSON] PurchaseResult
|
||||
:<|> "auth" :>
|
||||
( "get" :> ReqBody '[JSON] Int :> Post '[JSON] AuthInfo
|
||||
:<|> "send" :> ReqBody '[JSON] AuthRequest :> Post '[JSON] AuthResult
|
||||
|
|
|
@ -66,6 +66,7 @@ app initState =
|
|||
(`runReaderT` initState)
|
||||
( users :<|>
|
||||
products :<|>
|
||||
buy :<|>
|
||||
auth
|
||||
)
|
||||
|
||||
|
@ -170,6 +171,12 @@ products =
|
|||
update Nothing _ _ =
|
||||
throwError $ err403
|
||||
|
||||
buy (Just auid) pds = do
|
||||
error "Buying not yet implemented"
|
||||
conn <- rsConnection <$> ask
|
||||
price <- foldl (\total pd -> total + getBeveragePrice pd) 0 pds
|
||||
liftIO $ runUpdate_ conn updateUserBalance auid
|
||||
|
||||
auth =
|
||||
authGet :<|>
|
||||
authSend :<|>
|
||||
|
|
|
@ -105,6 +105,41 @@ productSelect conn = do
|
|||
bevs
|
||||
|
||||
|
||||
getProductPrice
|
||||
:: PurchaseDetail
|
||||
-> PGS.Connection
|
||||
-> MateHandler Int
|
||||
getproductproce (PurchaseDetail bid amount) conn = do
|
||||
when (amount <= 0)
|
||||
throwError $ err406
|
||||
{ errBody = "Amounts less or equal zero are not acceptable"
|
||||
bevs <- liftIO $ runSelect conn
|
||||
( keepWhen
|
||||
(\(id_, _, _, _, _, _, _, _, _, _, _, _, _) -> id_ .== C.constant bid) <<<
|
||||
queryTable productTable
|
||||
) :: MateHandler
|
||||
[ ( Int
|
||||
, T.Text
|
||||
, Int
|
||||
, Int
|
||||
, Int
|
||||
, Int
|
||||
, Maybe Int
|
||||
, Maybe Int
|
||||
, Int
|
||||
, Int
|
||||
, Int
|
||||
, Maybe Int
|
||||
, Maybe T.Text
|
||||
)
|
||||
]
|
||||
(amount *) <$> head <$> mapM
|
||||
(\(i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13) -> return $
|
||||
i3
|
||||
)
|
||||
bevs
|
||||
|
||||
|
||||
insertProduct
|
||||
:: ProductSubmit
|
||||
-> Insert [Int]
|
||||
|
|
|
@ -7,3 +7,4 @@ import Types.Product as T
|
|||
import Types.Refine as T
|
||||
import Types.Reader as T
|
||||
import Types.User as T
|
||||
import Types.Purchase as T
|
||||
|
|
30
src/Types/Purchase.hs
Normal file
30
src/Types/Purchase.hs
Normal file
|
@ -0,0 +1,30 @@
|
|||
{-# LANGUAGE DeriveGeneric #-}
|
||||
|
||||
module Types.Purchase where
|
||||
|
||||
import Data.Text
|
||||
|
||||
import GHC.Generics
|
||||
|
||||
|
||||
data PurchaseDetail = PurchaseDetail
|
||||
{ pdBeverage :: Int
|
||||
, pdAmount :: Int
|
||||
}
|
||||
|
||||
instance ToJSON PurchaseDetail where
|
||||
toEncoding = genericToEncoding defaultOptions
|
||||
|
||||
instance fromJSON PurchaseDetail
|
||||
|
||||
|
||||
data PurchaseResult
|
||||
= PurchaseOK
|
||||
| PurchaseDebtful
|
||||
| PayAmount Int
|
||||
deriving (Generic, Show)
|
||||
|
||||
instance ToJSON PurchaseResult where
|
||||
toEncoding = genericToEncoding defaultOptions
|
||||
|
||||
instance fromJSON PurchaseResult
|
Loading…
Reference in a new issue