aboutsummaryrefslogtreecommitdiff
path: root/src/server/Controller
diff options
context:
space:
mode:
Diffstat (limited to 'src/server/Controller')
-rw-r--r--src/server/Controller/Category.hs17
-rw-r--r--src/server/Controller/Income.hs28
-rw-r--r--src/server/Controller/Index.hs52
-rw-r--r--src/server/Controller/Payment.hs22
-rw-r--r--src/server/Controller/SignIn.hs33
5 files changed, 65 insertions, 87 deletions
diff --git a/src/server/Controller/Category.hs b/src/server/Controller/Category.hs
index 19109a3..3f800da 100644
--- a/src/server/Controller/Category.hs
+++ b/src/server/Controller/Category.hs
@@ -7,43 +7,42 @@ module Controller.Category
) where
import Control.Monad.IO.Class (liftIO)
-
-import Data.Text (Text)
import Network.HTTP.Types.Status (ok200, badRequest400)
import qualified Data.Text.Lazy as TL
import Web.Scotty hiding (delete)
import Json (jsonId)
-import Model.Database
+import Model.Category (CategoryId)
import qualified Model.Category as Category
import qualified Model.Json.CreateCategory as Json
import qualified Model.Json.EditCategory as Json
import qualified Model.Message.Key as Key
import qualified Model.PaymentCategory as PaymentCategory
+import qualified Model.Query as Query
import qualified Secure
create :: Json.CreateCategory -> ActionM ()
create (Json.CreateCategory name color) =
Secure.loggedAction (\_ ->
- (liftIO . runDb $ Category.create name color) >>= jsonId
+ (liftIO . Query.run $ Category.create name color) >>= jsonId
)
edit :: Json.EditCategory -> ActionM ()
edit (Json.EditCategory categoryId name color) =
Secure.loggedAction (\_ -> do
- updated <- liftIO . runDb $ Category.edit categoryId name color
+ updated <- liftIO . Query.run $ Category.edit categoryId name color
if updated
then status ok200
else status badRequest400
)
-delete :: Text -> ActionM ()
+delete :: CategoryId -> ActionM ()
delete categoryId =
Secure.loggedAction (\_ -> do
- deleted <- liftIO . runDb $ do
- paymentCategories <- PaymentCategory.listByCategory (textToKey categoryId)
+ deleted <- liftIO . Query.run $ do
+ paymentCategories <- PaymentCategory.listByCategory categoryId
if null paymentCategories
- then Category.delete (textToKey categoryId)
+ then Category.delete categoryId
else return False
if deleted
then
diff --git a/src/server/Controller/Income.hs b/src/server/Controller/Income.hs
index ff3e75d..18394d0 100644
--- a/src/server/Controller/Income.hs
+++ b/src/server/Controller/Income.hs
@@ -6,46 +6,40 @@ module Controller.Income
, deleteOwn
) where
-import Web.Scotty
-
-import Network.HTTP.Types.Status (ok200, badRequest400)
-
import Control.Monad.IO.Class (liftIO)
-
-import Database.Persist
-
-import Data.Text (Text)
+import Network.HTTP.Types.Status (ok200, badRequest400)
import qualified Data.Text.Lazy as TL
-
-import qualified Secure
+import Web.Scotty
import Json (jsonId)
-
-import Model.Database
+import Model.Income (IncomeId)
import qualified Model.Income as Income
-import qualified Model.Message.Key as Key
import qualified Model.Json.CreateIncome as Json
import qualified Model.Json.EditIncome as Json
+import qualified Model.Message.Key as Key
+import qualified Model.Query as Query
+import qualified Model.User as User
+import qualified Secure
create :: Json.CreateIncome -> ActionM ()
create (Json.CreateIncome date amount) =
Secure.loggedAction (\user ->
- (liftIO . runDb $ Income.create (entityKey user) date amount) >>= jsonId
+ (liftIO . Query.run $ Income.create (User.id user) date amount) >>= jsonId
)
editOwn :: Json.EditIncome -> ActionM ()
editOwn (Json.EditIncome incomeId date amount) =
Secure.loggedAction (\user -> do
- updated <- liftIO . runDb $ Income.editOwn (entityKey user) incomeId date amount
+ updated <- liftIO . Query.run $ Income.editOwn (User.id user) incomeId date amount
if updated
then status ok200
else status badRequest400
)
-deleteOwn :: Text -> ActionM ()
+deleteOwn :: IncomeId -> ActionM ()
deleteOwn incomeId =
Secure.loggedAction (\user -> do
- deleted <- liftIO . runDb $ Income.deleteOwn user (textToKey incomeId)
+ deleted <- liftIO . Query.run $ Income.deleteOwn user incomeId
if deleted
then
status ok200
diff --git a/src/server/Controller/Index.hs b/src/server/Controller/Index.hs
index 96d0a49..9fb2aa0 100644
--- a/src/server/Controller/Index.hs
+++ b/src/server/Controller/Index.hs
@@ -4,28 +4,22 @@ module Controller.Index
) where
import Control.Monad.IO.Class (liftIO)
-
-import Web.Scotty hiding (get)
-
-import Network.HTTP.Types.Status (ok200)
-
import Data.Text (Text)
import Data.Time.Clock (getCurrentTime, diffUTCTime)
-
-import Database.Persist hiding (Key, get)
+import Network.HTTP.Types.Status (ok200)
+import Web.Scotty hiding (get)
import Conf (Conf(..))
+import Model.Init (getInit)
+import Model.Json.Init (InitResult(..))
+import Model.Message.Key
+import Model.User (User)
import qualified LoginSession
-import Secure (getUserFromToken)
-
-import Model.Database hiding (Key)
import qualified Model.Json.Conf as M
-import Model.User (getUser)
-import Model.Message.Key
-import Model.SignIn (getSignIn, signInTokenToUsed)
-import Model.Json.Init (InitResult(..))
-import Model.Init (getInit)
-
+import qualified Model.Query as Query
+import qualified Model.SignIn as SignIn
+import qualified Model.User as User
+import Secure (getUserFromToken)
import View.Page (page)
get :: Conf -> Maybe Text -> ActionM ()
@@ -37,54 +31,54 @@ get conf mbToken = do
Left errorKey ->
return . InitError $ errorKey
Right user ->
- liftIO . runDb . fmap InitSuccess . getInit $ user
+ liftIO . Query.run . fmap InitSuccess . getInit $ user
Nothing -> do
mbLoggedUser <- getLoggedUser
case mbLoggedUser of
Nothing ->
return InitEmpty
Just user ->
- liftIO . runDb . fmap InitSuccess . getInit $ user
+ liftIO . Query.run . fmap InitSuccess . getInit $ user
html $ page (M.Conf { M.currency = currency conf }) initResult
-validateSignIn :: Conf -> Text -> ActionM (Either Key (Entity User))
+validateSignIn :: Conf -> Text -> ActionM (Either Key User)
validateSignIn conf textToken = do
mbLoggedUser <- getLoggedUser
case mbLoggedUser of
Just loggedUser ->
return . Right $ loggedUser
Nothing -> do
- mbSignIn <- liftIO . runDb $ getSignIn textToken
+ mbSignIn <- liftIO . Query.run $ SignIn.getSignIn textToken
now <- liftIO getCurrentTime
case mbSignIn of
Nothing ->
return . Left $ SignInInvalid
- Just signInValue ->
- if signInIsUsed . entityVal $ signInValue
+ Just signIn ->
+ if SignIn.isUsed signIn
then
return . Left $ SignInUsed
else
- let diffTime = now `diffUTCTime` (signInCreation . entityVal $ signInValue)
+ let diffTime = now `diffUTCTime` (SignIn.creation signIn)
in if diffTime > signInExpiration conf
then
return . Left $ SignInExpired
else do
- LoginSession.put conf (signInToken . entityVal $ signInValue)
- mbUser <- liftIO . runDb $ do
- signInTokenToUsed . entityKey $ signInValue
- getUser . signInEmail . entityVal $ signInValue
+ LoginSession.put conf (SignIn.token signIn)
+ mbUser <- liftIO . Query.run $ do
+ SignIn.signInTokenToUsed . SignIn.id $ signIn
+ User.getUser . SignIn.email $ signIn
return $ case mbUser of
Nothing -> Left UnauthorizedSignIn
Just user -> Right user
-getLoggedUser :: ActionM (Maybe (Entity User))
+getLoggedUser :: ActionM (Maybe User)
getLoggedUser = do
mbToken <- LoginSession.get
case mbToken of
Nothing ->
return Nothing
Just token -> do
- liftIO . runDb . getUserFromToken $ token
+ liftIO . Query.run . getUserFromToken $ token
signOut :: Conf -> ActionM ()
signOut conf = LoginSession.delete conf >> status ok200
diff --git a/src/server/Controller/Payment.hs b/src/server/Controller/Payment.hs
index 831abbf..d71b451 100644
--- a/src/server/Controller/Payment.hs
+++ b/src/server/Controller/Payment.hs
@@ -8,40 +8,40 @@ module Controller.Payment
) where
import Control.Monad.IO.Class (liftIO)
-
-import Data.Text (Text)
-import Database.Persist
import Network.HTTP.Types.Status (ok200, badRequest400)
import Web.Scotty
import Json (jsonId)
-import Model.Database
+import Model.Payment (PaymentId)
import qualified Model.Json.CreatePayment as Json
import qualified Model.Json.EditPayment as Json
+import qualified Model.Json.Payment as Json
import qualified Model.Payment as Payment
import qualified Model.PaymentCategory as PaymentCategory
+import qualified Model.Query as Query
+import qualified Model.User as User
import qualified Secure
list :: ActionM ()
list =
Secure.loggedAction (\_ ->
- (liftIO $ runDb Payment.list) >>= json
+ (liftIO . Query.run $ map Json.fromPayment <$> Payment.list) >>= json
)
create :: Json.CreatePayment -> ActionM ()
create (Json.CreatePayment name cost date category frequency) =
Secure.loggedAction (\user ->
- (liftIO . runDb $ do
+ (liftIO . Query.run $ do
PaymentCategory.save name category
- Payment.create (entityKey user) name cost date frequency
+ Payment.create (User.id user) name cost date frequency
) >>= jsonId
)
editOwn :: Json.EditPayment -> ActionM ()
editOwn (Json.EditPayment paymentId name cost date category frequency) =
Secure.loggedAction (\user -> do
- updated <- liftIO . runDb $ do
- edited <- Payment.editOwn (entityKey user) paymentId name cost date frequency
+ updated <- liftIO . Query.run $ do
+ edited <- Payment.editOwn (User.id user) paymentId name cost date frequency
_ <- if edited
then PaymentCategory.save name category >> return ()
else return ()
@@ -51,10 +51,10 @@ editOwn (Json.EditPayment paymentId name cost date category frequency) =
else status badRequest400
)
-deleteOwn :: Text -> ActionM ()
+deleteOwn :: PaymentId -> ActionM ()
deleteOwn paymentId =
Secure.loggedAction (\user -> do
- deleted <- liftIO . runDb $ Payment.deleteOwn (entityKey user) (textToKey paymentId)
+ deleted <- liftIO . Query.run $ Payment.deleteOwn (User.id user) paymentId
if deleted
then status ok200
else status badRequest400
diff --git a/src/server/Controller/SignIn.hs b/src/server/Controller/SignIn.hs
index 1b8121d..152168c 100644
--- a/src/server/Controller/SignIn.hs
+++ b/src/server/Controller/SignIn.hs
@@ -4,48 +4,39 @@ module Controller.SignIn
( signIn
) where
-import Web.Scotty
-
-import Network.HTTP.Types.Status (ok200, badRequest400)
-
-import Database.Persist hiding (Key)
-
import Control.Monad.IO.Class (liftIO)
-
import Data.Text (Text)
+import Network.HTTP.Types.Status (ok200, badRequest400)
import qualified Data.Text as T
-import qualified Data.Text.Lazy as TL
import qualified Data.Text.Encoding as TE
+import qualified Data.Text.Lazy as TL
+import Web.Scotty
import Conf (Conf)
-import qualified Conf
-
-import SendMail
-
-import Text.Email.Validate as Email
-
-import Model.Database
-import Model.User
-import Model.SignIn
import Model.Message.Key
-
+import qualified Conf
+import qualified Model.Query as Query
+import qualified Model.SignIn as SignIn
+import qualified Model.User as User
+import qualified SendMail
+import qualified Text.Email.Validate as Email
import qualified View.Mail.SignIn as SignIn
signIn :: Conf -> Text -> ActionM ()
signIn conf login =
if Email.isValid (TE.encodeUtf8 login)
then do
- maybeUser <- liftIO . runDb $ getUser login
+ maybeUser <- liftIO . Query.run $ User.getUser login
case maybeUser of
Just user -> do
- token <- liftIO . runDb $ createSignInToken login
+ token <- liftIO . Query.run $ SignIn.createSignInToken login
let url = T.concat [
if Conf.https conf then "https://" else "http://",
Conf.hostname conf,
"?signInToken=",
token
]
- maybeSentMail <- liftIO . sendMail $ SignIn.mail conf (entityVal user) url [login]
+ maybeSentMail <- liftIO . SendMail.sendMail $ SignIn.mail conf user url [login]
case maybeSentMail of
Right _ ->
status ok200
generated by cgit v1.2.3 (git 2.25.1) at 2025-10-24 22:26:48 +0000