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

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

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

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]

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

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