Add a payment from the UI, it needs polishing however

1 files changed, 12 insertions, 10 deletions

diff --git a/src/server/Application.hs b/src/server/Application.hs
index 7e93fe1..24342dc 100644
--- a/src/server/Application.hs
+++ b/src/server/Application.hs
@@ -69,16 +69,18 @@ deleteUserAction email = do
   _ <- liftIO . runDb $ deleteUser email
   status ok200
 
-createPaymentAction :: Text -> Text -> Int -> ActionM ()
-createPaymentAction email name cost = do
-  maybeUser <- liftIO . runDb $ getUser email
-  case maybeUser of
-    Just user -> do
-      _ <- liftIO . runDb $ createPayment (entityKey user) name cost
-      return ()
-    Nothing -> do
-      status badRequest400
-      status ok200
+createPaymentAction :: Text -> Int -> ActionM ()
+createPaymentAction name cost =
+  Secure.loggedAction (\login -> do
+    maybeUser <- liftIO . runDb $ getUser login
+    case maybeUser of
+      Just user -> do
+        _ <- liftIO . runDb $ createPayment (entityKey user) name cost
+        return ()
+      Nothing -> do
+        status badRequest400
+        status ok200
+  )
 
 signInAction :: Text -> ActionM ()
 signInAction login =