starting purchase implementation

This commit is contained in:
nek0 2019-07-18 19:01:49 +02:00
parent 867481e9d1
commit c83f37607d
6 changed files with 76 additions and 0 deletions

View file

@ -33,6 +33,7 @@ executable mateamt
, Types.Reader
, Types.Refine
, Types.User
, Types.Purchase
-- other-extensions:
build-depends: base ^>=4.12.0.0
, servant

View file

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

View file

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

View file

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

View file

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