diff options
Diffstat (limited to 'src/server/Controller')
-rw-r--r-- | src/server/Controller/SignIn.hs | 16 | ||||
-rw-r--r-- | src/server/Controller/User.hs | 25 |
2 files changed, 29 insertions, 12 deletions
diff --git a/src/server/Controller/SignIn.hs b/src/server/Controller/SignIn.hs index 955ad35..3bbb9ff 100644 --- a/src/server/Controller/SignIn.hs +++ b/src/server/Controller/SignIn.hs @@ -64,22 +64,22 @@ errorResponse msg = do jsonObject [("error", Json.String msg)] validateSignIn :: Config -> Text -> ActionM () -validateSignIn config token = do - maybeSignIn <- liftIO . runDb $ getSignInToken token +validateSignIn config textToken = do + mbToken <- liftIO . runDb $ getSignInToken textToken now <- liftIO getCurrentTime - case maybeSignIn of - Just signIn -> - if signInIsUsed . entityVal $ signIn + case mbToken of + Just token -> + if signInIsUsed . entityVal $ token then redirectError (getMessage SignInUsed) else - let diffTime = now `diffUTCTime` (signInCreation . entityVal $ signIn) + let diffTime = now `diffUTCTime` (signInCreation . entityVal $ token) in if diffTime > (fromIntegral $ (signInExpirationMn config) * 60) then redirectError (getMessage SignInExpired) else do - LoginSession.put (signInEmail . entityVal $ signIn) - liftIO . runDb . signInTokenToUsed . entityKey $ signIn + LoginSession.put (signInEmail . entityVal $ token) + liftIO . runDb . signInTokenToUsed . entityKey $ token redirect "/" Nothing -> redirectError (getMessage SignInInvalid) diff --git a/src/server/Controller/User.hs b/src/server/Controller/User.hs index bc99ea5..420a2d9 100644 --- a/src/server/Controller/User.hs +++ b/src/server/Controller/User.hs @@ -4,12 +4,17 @@ module Controller.User ( getUsers , whoAmI , getIncome + , setIncome ) where import Web.Scotty +import Network.HTTP.Types.Status (ok200) + import Control.Monad.IO.Class (liftIO) +import Database.Persist + import qualified Data.Aeson.Types as Json import qualified Secure @@ -18,21 +23,33 @@ import Json (jsonObject) import Model.Database import qualified Model.User as U +import qualified Model.Income as I getUsers :: ActionM () getUsers = - Secure.loggedAction (\_ -> do + Secure.loggedAction (\_ -> (liftIO $ map U.getJsonUser <$> runDb U.getUsers) >>= json ) whoAmI :: ActionM () whoAmI = - Secure.loggedAction (\user -> do + Secure.loggedAction (\user -> json (U.getJsonUser user) ) getIncome :: ActionM () getIncome = - Secure.loggedAction (\_ -> do - jsonObject [] + Secure.loggedAction (\user -> do + mbIncome <- liftIO . runDb . I.getIncome $ entityKey user + case mbIncome of + Just income -> + jsonObject [("income", Json.Number . fromIntegral . incomeAmount $ income)] + Nothing -> + jsonObject [] + ) + +setIncome :: Int -> ActionM () +setIncome amount = + Secure.loggedAction (\user -> + (liftIO . runDb $ I.setIncome (entityKey user) amount) >> status ok200 ) |