From c83f37607d9468d2b78b169f6ea08bb97d5326fa Mon Sep 17 00:00:00 2001 From: nek0 Date: Thu, 18 Jul 2019 19:01:49 +0200 Subject: [PATCH] starting purchase implementation --- mateamt.cabal | 1 + src/API.hs | 2 ++ src/Main.hs | 7 +++++++ src/Model/Product.hs | 35 +++++++++++++++++++++++++++++++++++ src/Types.hs | 1 + src/Types/Purchase.hs | 30 ++++++++++++++++++++++++++++++ 6 files changed, 76 insertions(+) create mode 100644 src/Types/Purchase.hs diff --git a/mateamt.cabal b/mateamt.cabal index 8313bcb..8e96a50 100644 --- a/mateamt.cabal +++ b/mateamt.cabal @@ -33,6 +33,7 @@ executable mateamt , Types.Reader , Types.Refine , Types.User + , Types.Purchase -- other-extensions: build-depends: base ^>=4.12.0.0 , servant diff --git a/src/API.hs b/src/API.hs index ddb6ac9..ff0210d 100644 --- a/src/API.hs +++ b/src/API.hs @@ -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 diff --git a/src/Main.hs b/src/Main.hs index 84d984c..3db00d6 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -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 :<|> diff --git a/src/Model/Product.hs b/src/Model/Product.hs index 8893435..30ec34a 100644 --- a/src/Model/Product.hs +++ b/src/Model/Product.hs @@ -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] diff --git a/src/Types.hs b/src/Types.hs index d9f12ed..f302c75 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -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 diff --git a/src/Types/Purchase.hs b/src/Types/Purchase.hs new file mode 100644 index 0000000..c3bd5d8 --- /dev/null +++ b/src/Types/Purchase.hs @@ -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