aboutsummaryrefslogtreecommitdiff
path: root/src/server/Controller
diff options
context:
space:
mode:
Diffstat (limited to 'src/server/Controller')
-rw-r--r--src/server/Controller/Category.hs53
-rw-r--r--src/server/Controller/Income.hs49
-rw-r--r--src/server/Controller/Index.hs84
-rw-r--r--src/server/Controller/Payment.hs61
-rw-r--r--src/server/Controller/SignIn.hs51
-rw-r--r--src/server/Controller/User.hs20
6 files changed, 0 insertions, 318 deletions
diff --git a/src/server/Controller/Category.hs b/src/server/Controller/Category.hs
deleted file mode 100644
index 3f800da..0000000
--- a/src/server/Controller/Category.hs
+++ /dev/null
@@ -1,53 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module Controller.Category
- ( create
- , edit
- , delete
- ) where
-
-import Control.Monad.IO.Class (liftIO)
-import Network.HTTP.Types.Status (ok200, badRequest400)
-import qualified Data.Text.Lazy as TL
-import Web.Scotty hiding (delete)
-
-import Json (jsonId)
-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 . Query.run $ Category.create name color) >>= jsonId
- )
-
-edit :: Json.EditCategory -> ActionM ()
-edit (Json.EditCategory categoryId name color) =
- Secure.loggedAction (\_ -> do
- updated <- liftIO . Query.run $ Category.edit categoryId name color
- if updated
- then status ok200
- else status badRequest400
- )
-
-delete :: CategoryId -> ActionM ()
-delete categoryId =
- Secure.loggedAction (\_ -> do
- deleted <- liftIO . Query.run $ do
- paymentCategories <- PaymentCategory.listByCategory categoryId
- if null paymentCategories
- then Category.delete categoryId
- else return False
- if deleted
- then
- status ok200
- else do
- status badRequest400
- text . TL.pack . show $ Key.CategoryNotDeleted
- )
diff --git a/src/server/Controller/Income.hs b/src/server/Controller/Income.hs
deleted file mode 100644
index 18394d0..0000000
--- a/src/server/Controller/Income.hs
+++ /dev/null
@@ -1,49 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module Controller.Income
- ( create
- , editOwn
- , deleteOwn
- ) where
-
-import Control.Monad.IO.Class (liftIO)
-import Network.HTTP.Types.Status (ok200, badRequest400)
-import qualified Data.Text.Lazy as TL
-import Web.Scotty
-
-import Json (jsonId)
-import Model.Income (IncomeId)
-import qualified Model.Income as Income
-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 . 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 . Query.run $ Income.editOwn (User.id user) incomeId date amount
- if updated
- then status ok200
- else status badRequest400
- )
-
-deleteOwn :: IncomeId -> ActionM ()
-deleteOwn incomeId =
- Secure.loggedAction (\user -> do
- deleted <- liftIO . Query.run $ Income.deleteOwn user incomeId
- if deleted
- then
- status ok200
- else do
- status badRequest400
- text . TL.pack . show $ Key.IncomeNotDeleted
- )
diff --git a/src/server/Controller/Index.hs b/src/server/Controller/Index.hs
deleted file mode 100644
index 9fb2aa0..0000000
--- a/src/server/Controller/Index.hs
+++ /dev/null
@@ -1,84 +0,0 @@
-module Controller.Index
- ( get
- , signOut
- ) where
-
-import Control.Monad.IO.Class (liftIO)
-import Data.Text (Text)
-import Data.Time.Clock (getCurrentTime, diffUTCTime)
-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 qualified Model.Json.Conf as M
-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 ()
-get conf mbToken = do
- initResult <- case mbToken of
- Just token -> do
- userOrError <- validateSignIn conf token
- case userOrError of
- Left errorKey ->
- return . InitError $ errorKey
- Right user ->
- liftIO . Query.run . fmap InitSuccess . getInit $ user
- Nothing -> do
- mbLoggedUser <- getLoggedUser
- case mbLoggedUser of
- Nothing ->
- return InitEmpty
- Just user ->
- liftIO . Query.run . fmap InitSuccess . getInit $ user
- html $ page (M.Conf { M.currency = currency conf }) initResult
-
-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 . Query.run $ SignIn.getSignIn textToken
- now <- liftIO getCurrentTime
- case mbSignIn of
- Nothing ->
- return . Left $ SignInInvalid
- Just signIn ->
- if SignIn.isUsed signIn
- then
- return . Left $ SignInUsed
- else
- let diffTime = now `diffUTCTime` (SignIn.creation signIn)
- in if diffTime > signInExpiration conf
- then
- return . Left $ SignInExpired
- else do
- 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 User)
-getLoggedUser = do
- mbToken <- LoginSession.get
- case mbToken of
- Nothing ->
- return Nothing
- Just token -> do
- 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
deleted file mode 100644
index d71b451..0000000
--- a/src/server/Controller/Payment.hs
+++ /dev/null
@@ -1,61 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module Controller.Payment
- ( list
- , create
- , editOwn
- , deleteOwn
- ) where
-
-import Control.Monad.IO.Class (liftIO)
-import Network.HTTP.Types.Status (ok200, badRequest400)
-import Web.Scotty
-
-import Json (jsonId)
-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 . Query.run $ map Json.fromPayment <$> Payment.list) >>= json
- )
-
-create :: Json.CreatePayment -> ActionM ()
-create (Json.CreatePayment name cost date category frequency) =
- Secure.loggedAction (\user ->
- (liftIO . Query.run $ do
- PaymentCategory.save name category
- 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 . Query.run $ do
- edited <- Payment.editOwn (User.id user) paymentId name cost date frequency
- _ <- if edited
- then PaymentCategory.save name category >> return ()
- else return ()
- return edited
- if updated
- then status ok200
- else status badRequest400
- )
-
-deleteOwn :: PaymentId -> ActionM ()
-deleteOwn paymentId =
- Secure.loggedAction (\user -> do
- 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
deleted file mode 100644
index 152168c..0000000
--- a/src/server/Controller/SignIn.hs
+++ /dev/null
@@ -1,51 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module Controller.SignIn
- ( signIn
- ) where
-
-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.Encoding as TE
-import qualified Data.Text.Lazy as TL
-import Web.Scotty
-
-import Conf (Conf)
-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 . Query.run $ User.getUser login
- case maybeUser of
- Just user -> do
- 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.sendMail $ SignIn.mail conf user url [login]
- case maybeSentMail of
- Right _ ->
- status ok200
- Left _ -> do
- status badRequest400
- text . TL.pack . show $ SendEmailFail
- Nothing -> do
- status badRequest400
- text . TL.pack . show $ UnauthorizedSignIn
- else do
- status badRequest400
- text . TL.pack . show $ EnterValidEmail
diff --git a/src/server/Controller/User.hs b/src/server/Controller/User.hs
deleted file mode 100644
index d8604ac..0000000
--- a/src/server/Controller/User.hs
+++ /dev/null
@@ -1,20 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module Controller.User
- ( getUsers
- ) where
-
-import Web.Scotty
-
-import Control.Monad.IO.Class (liftIO)
-
-import qualified Secure
-
-import Model.Database
-import qualified Model.User as User
-
-getUsers :: ActionM ()
-getUsers =
- Secure.loggedAction (\_ ->
- (liftIO $ map User.getJsonUser <$> runDb User.list) >>= json
- )
generated by cgit v1.2.3 (git 2.25.1) at 2024-09-06 06:15:19 +0000