From 2a53fe50c62d4b7aec0f422998c743f68aa523c1 Mon Sep 17 00:00:00 2001
From: Joris Guyonvarch
Date: Tue, 21 Jul 2015 23:25:58 +0200
Subject: Adding the payment without reloading the page

---
 src/server/Application.hs | 86 +++++++++++++++++++++++++----------------------
 1 file changed, 46 insertions(+), 40 deletions(-)

(limited to 'src/server/Application.hs')

diff --git a/src/server/Application.hs b/src/server/Application.hs
index 24342dc..59aa252 100644
--- a/src/server/Application.hs
+++ b/src/server/Application.hs
@@ -3,13 +3,15 @@
 module Application
   ( signInAction
   , validateSignInAction
+  , getUserName
+  , getPaymentsAction
+  , createPaymentAction
   , signOutAction
+
   , getIndexAction
   , getUsersAction
-  , getPaymentsAction
   , addUserAction
   , deleteUserAction
-  , createPaymentAction
   ) where
 
 import Web.Scotty
@@ -44,44 +46,6 @@ import View.Page (page)
 
 import Mail
 
-getIndexAction :: ActionM ()
-getIndexAction = html page
-
-getUsersAction :: ActionM ()
-getUsersAction = do
-  users <- liftIO $ runDb getUsers
-  html . fromString . show $ users
-
-getPaymentsAction :: ActionM ()
-getPaymentsAction =
-  Secure.loggedAction (\_ -> do
-    payments <- liftIO $ runDb getPayments
-    json payments
-  )
-
-addUserAction :: Text -> Text -> ActionM ()
-addUserAction email name = do
-  _ <- liftIO . runDb $ createUser email name
-  status ok200
-
-deleteUserAction :: Text -> ActionM ()
-deleteUserAction email = do
-  _ <- liftIO . runDb $ deleteUser email
-  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 =
   if isValid (TE.encodeUtf8 login)
@@ -129,6 +93,26 @@ redirectError :: Text -> ActionM ()
 redirectError msg =
   redirect . TL.fromStrict . T.concat $ ["/?signInError=", msg]
 
+getUserName :: ActionM ()
+getUserName =
+  Secure.loggedAction (\user -> do
+    json . Message . userName . entityVal $ user
+  )
+
+getPaymentsAction :: ActionM ()
+getPaymentsAction =
+  Secure.loggedAction (\_ -> do
+    payments <- liftIO $ runDb getPayments
+    json payments
+  )
+
+createPaymentAction :: Text -> Int -> ActionM ()
+createPaymentAction name cost =
+  Secure.loggedAction (\user -> do
+    _ <- liftIO . runDb $ createPayment (entityKey user) name cost
+    return ()
+  )
+
 signOutAction :: ActionM ()
 signOutAction = do
   LoginSession.delete
@@ -138,3 +122,25 @@ errorResponse :: Text -> ActionM ()
 errorResponse msg = do
   status badRequest400
   json (Message msg)
+
+
+
+
+
+getIndexAction :: ActionM ()
+getIndexAction = html page
+
+getUsersAction :: ActionM ()
+getUsersAction = do
+  users <- liftIO $ runDb getUsers
+  html . fromString . show $ users
+
+addUserAction :: Text -> Text -> ActionM ()
+addUserAction email name = do
+  _ <- liftIO . runDb $ createUser email name
+  status ok200
+
+deleteUserAction :: Text -> ActionM ()
+deleteUserAction email = do
+  _ <- liftIO . runDb $ deleteUser email
+  status ok200
-- 
cgit v1.2.3