purchase implemented #1

Merged
nek0 merged 2 commits from purchase into master 2019-07-21 10:22:29 +00:00
6 changed files with 76 additions and 0 deletions
Showing only changes of commit c83f37607d - Show all commits

View file

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

View file

@ -38,6 +38,8 @@ type UserAPI =
:<|> "update" :> AuthProtect "header-auth" :<|> "update" :> AuthProtect "header-auth"
:> Capture "id" Int :> ReqBody '[JSON] ProductSubmit :> Post '[JSON] () :> Capture "id" Int :> ReqBody '[JSON] ProductSubmit :> Post '[JSON] ()
) )
:<|> "buy" :> AuthProtect "header-auth" :> ReqBody '[JSON] [PurchaseDetail]
:> Post '[JSON] PurchaseResult
:<|> "auth" :> :<|> "auth" :>
( "get" :> ReqBody '[JSON] Int :> Post '[JSON] AuthInfo ( "get" :> ReqBody '[JSON] Int :> Post '[JSON] AuthInfo
:<|> "send" :> ReqBody '[JSON] AuthRequest :> Post '[JSON] AuthResult :<|> "send" :> ReqBody '[JSON] AuthRequest :> Post '[JSON] AuthResult

View file

@ -66,6 +66,7 @@ app initState =
(`runReaderT` initState) (`runReaderT` initState)
( users :<|> ( users :<|>
products :<|> products :<|>
buy :<|>
auth auth
) )
@ -170,6 +171,12 @@ products =
update Nothing _ _ = update Nothing _ _ =
throwError $ err403 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 = auth =
authGet :<|> authGet :<|>
authSend :<|> authSend :<|>

View file

@ -105,6 +105,41 @@ productSelect conn = do
bevs 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 insertProduct
:: ProductSubmit :: ProductSubmit
-> Insert [Int] -> Insert [Int]

View file

@ -7,3 +7,4 @@ import Types.Product as T
import Types.Refine as T import Types.Refine as T
import Types.Reader as T import Types.Reader as T
import Types.User 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