diff --git a/src/Control/Buy.hs b/src/Control/Buy.hs index e0bdac7..de76176 100644 --- a/src/Control/Buy.hs +++ b/src/Control/Buy.hs @@ -6,6 +6,7 @@ import Control.Monad.Reader (asks) -- internal imports +import Control.User import Types import Model @@ -40,6 +41,7 @@ buy auth pds = do Just (auid, _) -> do void $ addToUserBalance auid (-price) conn newBalance <- userBalanceSelect conn auid + userUpdateTimestamp auth return $ PurchaseResult ( if newBalance < 0 then PurchaseDebtful diff --git a/src/Control/User.hs b/src/Control/User.hs index 54957fd..6c91f8c 100644 --- a/src/Control/User.hs +++ b/src/Control/User.hs @@ -60,6 +60,18 @@ userUpdate (Just (aid, method)) uds = { errBody = "Wrong Authentication present." } +userUpdateTimestamp + :: Maybe (Int, AuthMethod) + -> MateHandler () +userUpdateTimestamp (Just (aid, _)) = do + now <- liftIO getCurrentTime + conn <- asks rsConnection + void $ updateUserTimestamp aid (utctDay now) conn +userUpdateTimestamp Nothing = + throwError $ err401 + { errBody = "No Authentication present." + } + userList :: Maybe UserRefine -> MateHandler [UserSummary] diff --git a/src/Model/User.hs b/src/Model/User.hs index 9297549..36695fa 100644 --- a/src/Model/User.hs +++ b/src/Model/User.hs @@ -184,6 +184,26 @@ updateUserDetails uid uds now conn = liftIO $ runUpdate_ conn $ Update , uReturning = rCount } +updateUserTimestamp + :: Int + -> Day + -> PGS.Connection + -> MateHandler Int64 +updateUserTimestamp uid now conn = liftIO $ runUpdate_ conn $ Update + { uTable = userTable + , uUpdateWith = updateEasy (\(id_, ident, balance, _, email, ava) -> + ( id_ + , ident + , balance + , C.constant now + , email + , ava + ) + ) + , uWhere = \(i1, _, _, _, _, _) -> i1 .== C.constant uid + , uReturning = rCount + } + addToUserBalance :: Int -> Int