aboutsummaryrefslogtreecommitdiff
path: root/src/server/Application.hs
diff options
context:
space:
mode:
authorJoris Guyonvarch2015-07-21 23:25:58 +0200
committerJoris Guyonvarch2015-07-21 23:25:58 +0200
commit2a53fe50c62d4b7aec0f422998c743f68aa523c1 (patch)
treead32464c99668b477c4006146ec218c947bc9c8f /src/server/Application.hs
parenta271d6034bc4cc631a64476d25d21c83a701fa39 (diff)
downloadbudget-2a53fe50c62d4b7aec0f422998c743f68aa523c1.tar.gz
budget-2a53fe50c62d4b7aec0f422998c743f68aa523c1.tar.bz2
budget-2a53fe50c62d4b7aec0f422998c743f68aa523c1.zip
Adding the payment without reloading the page
Diffstat (limited to 'src/server/Application.hs')
-rw-r--r--src/server/Application.hs86
1 files changed, 46 insertions, 40 deletions
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