make preparations for notifications

This commit is contained in:
nek0 2021-06-10 17:54:57 +02:00
parent 5ee1fb4ac8
commit 28709dd0cf
5 changed files with 58 additions and 23 deletions

View File

@ -17,20 +17,26 @@ buy
-> MateHandler PurchaseResult
buy auth pds = do
conn <- asks rsConnection
(missing, real) <- foldM (\(ms, rs) pd -> do
mmiss <- checkProductAvailability pd conn
case mmiss of
Just miss -> return
( (pd {purchaseDetailAmount = miss}):ms
, pd {purchaseDetailAmount = max 0 (purchaseDetailAmount pd - miss)}:rs
(missing, real) <-
foldM
(\(ms, rs) pd -> do
mmiss <- checkProductAvailability pd conn
case mmiss of
Just miss -> return
-- If there is less items in stock than ordered
( (pd {purchaseDetailAmount = miss}):ms
-- Add number of missing items
, pd {purchaseDetailAmount = max 0 (purchaseDetailAmount pd - miss)}:rs
-- purchase remaining items in stock
)
Nothing -> return
-- There are at least as many items in stock as ordered
( ms -- Missing items do not change
, pd:rs -- Add everything to purchase
)
)
Nothing -> return
( ms
, pd:rs
)
)
([], [])
pds
([], [])
pds
mapM_ (`postBuyProductAmountUpdate` conn) real
price <- foldM
(\total pd ->

View File

@ -38,12 +38,12 @@ productNew Nothing _ =
{ errBody = "No Authentication present."
}
productOverview
:: Int
-> MateHandler ProductOverview
productOverview pid = do
conn <- asks rsConnection
productOverviewSelectSingle pid conn
-- productOverview
-- :: Int
-- -> MateHandler ProductOverview
-- productOverview pid = do
-- conn <- asks rsConnection
-- productOverviewSelectSingle pid conn
productStockRefill
:: Maybe (Int, AuthMethod)

View File

@ -149,6 +149,21 @@ userNotify
-> PurchaseResult
-> MateHandler ()
userNotify (Just (auid, method)) boughtItems (PurchaseResult flag missing) = do
conn <- asks rsConnection
authData <- selectAuthOverviewById auid conn
user <- userDetailsSelect (authDataUser authData) conn
digestedDetails <- mapM
(\pd -> do
overview <- (productOverviewSelectSingle (purchaseDetailProduct pd) conn
return (purchaseDetailAmout pd, productOverviewIdent overview)
)
boughtItems
let messageText = mconcat $ map (<> "\n") $
[ "Hello " <> userIdent user <> ","
, ""
, "Your " <> authDataMethod authData <> " with the comment \"" <>
authDataComment authData <> "\" Just made following purchase:"<>
]
throwError $ err501
{ errBody = "userNotify: Not implemented yet"
}

View File

@ -117,11 +117,11 @@ generateRandomText = decodeUtf8 . B64.encode <$> random 23
selectAuthOverviews
:: Int
-> PGS.Connection
:: Int -- ^ User ID
-> PGS.Connection -- ^ Connection Handler
-> MateHandler [AuthOverview]
selectAuthOverviews uid conn = do
liftIO $ map fromDatabase <$> runSelect conn (proc () -> do
liftIO $ map fromDatabase <$> head <$> runSelect conn (proc () -> do
(adid, aduid, admethod, adcomment, _) <-
queryTable authDataTable -< ()
restrict -< aduid .== C.constant uid
@ -129,6 +129,20 @@ selectAuthOverviews uid conn = do
)
selectAuthOverviewById
:: Int -- ^ Auth Data ID
-> PGS.Connection -- ^ Connection Handler
-> MateHandler AuthOverview
selectAuthOverviews aid conn = do
liftIO $ map fromDatabase <$> runSelect conn (proc () -> do
(adid, aduid, admethod, adcomment, _) <-
queryTable authDataTable -< ()
restrict -< adid .== C.constant aid
limit 1
returnA -< (adid, adcomment, admethod)
)
getUserAuthInfo
:: Int
-> AuthMethod

View File

@ -91,7 +91,7 @@ userDetailsSelect
-> PGS.Connection
-> MateHandler UserDetails
userDetailsSelect uid conn = do
users <- liftIO $ map fromDatabase <$> runSelect conn (
users <- liftIO $ map fromDatabase <$> runSelect conn (limit 1 $
keepWhen (\(uuid, _, _, _, _, _) ->
uuid .== C.constant uid
) <<< queryTable userTable