From 11052951b74b9ad4b6a9412ae490086235f9154b Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 3 Jan 2021 13:40:40 +0100 Subject: Rewrite in Rust --- server/src/Controller/Category.hs | 88 --------------------------- server/src/Controller/Helper.hs | 16 ----- server/src/Controller/Income.hs | 90 --------------------------- server/src/Controller/Index.hs | 76 ----------------------- server/src/Controller/Payment.hs | 118 ------------------------------------ server/src/Controller/Statistics.hs | 21 ------- server/src/Controller/User.hs | 17 ------ 7 files changed, 426 deletions(-) delete mode 100644 server/src/Controller/Category.hs delete mode 100644 server/src/Controller/Helper.hs delete mode 100644 server/src/Controller/Income.hs delete mode 100644 server/src/Controller/Index.hs delete mode 100644 server/src/Controller/Payment.hs delete mode 100644 server/src/Controller/Statistics.hs delete mode 100644 server/src/Controller/User.hs (limited to 'server/src/Controller') diff --git a/server/src/Controller/Category.hs b/server/src/Controller/Category.hs deleted file mode 100644 index 371ba78..0000000 --- a/server/src/Controller/Category.hs +++ /dev/null @@ -1,88 +0,0 @@ -module Controller.Category - ( listAll - , list - , create - , edit - , delete - ) where - -import Control.Monad.IO.Class (liftIO) -import qualified Data.Text.Lazy as TL -import Data.Validation (Validation (..)) -import Network.HTTP.Types.Status (badRequest400, ok200) -import Web.Scotty hiding (delete) - -import Common.Model (CategoryId, CategoryPage (..), - CreateCategoryForm (..), - EditCategoryForm (..)) -import qualified Common.Msg as Msg - -import qualified Controller.Helper as ControllerHelper -import Model.CreateCategory (CreateCategory (..)) -import Model.EditCategory (EditCategory (..)) -import qualified Model.Query as Query -import qualified Persistence.Category as CategoryPersistence -import qualified Persistence.Payment as PaymentPersistence -import qualified Secure -import qualified Validation.Category as CategoryValidation - -listAll :: ActionM () -listAll = - Secure.loggedAction (\_ -> - (liftIO . Query.run $ CategoryPersistence.listAll) >>= json - ) - -list :: Int -> Int -> ActionM () -list page perPage = - Secure.loggedAction (\_ -> - (liftIO . Query.run $ do - categories <- CategoryPersistence.list page perPage - usedCategories <- PaymentPersistence.usedCategories - count <- CategoryPersistence.count - return $ CategoryPage page categories usedCategories count - ) >>= json - ) - -create :: CreateCategoryForm -> ActionM () -create form = - Secure.loggedAction (\_ -> - (liftIO . Query.run $ do - case CategoryValidation.createCategory form of - Success (CreateCategory name color) -> do - Right <$> (CategoryPersistence.create name color) - - Failure validationError -> - return $ Left validationError - ) >>= ControllerHelper.okOrBadRequest - ) - -edit :: EditCategoryForm -> ActionM () -edit form = - Secure.loggedAction (\_ -> - (liftIO . Query.run $ do - case CategoryValidation.editCategory form of - Success (EditCategory categoryId name color) -> - do - isSuccess <- CategoryPersistence.edit categoryId name color - return $ if isSuccess then - Right () - else - Left $ Msg.get Msg.Error_CategoryEdit - - Failure validationError -> - return $ Left validationError - ) >>= ControllerHelper.okOrBadRequest - ) - -delete :: CategoryId -> ActionM () -delete categoryId = - Secure.loggedAction (\_ -> do - deleted <- liftIO . Query.run $ do - CategoryPersistence.delete categoryId - if deleted - then - status ok200 - else do - status badRequest400 - text . TL.fromStrict $ Msg.get Msg.Category_NotDeleted - ) diff --git a/server/src/Controller/Helper.hs b/server/src/Controller/Helper.hs deleted file mode 100644 index dc9cbc4..0000000 --- a/server/src/Controller/Helper.hs +++ /dev/null @@ -1,16 +0,0 @@ -module Controller.Helper - ( okOrBadRequest - ) where - -import Data.Text (Text) -import qualified Data.Text.Lazy as LT -import qualified Network.HTTP.Types.Status as Status -import Web.Scotty (ActionM) -import qualified Web.Scotty as S - -okOrBadRequest :: Either Text () -> ActionM () -okOrBadRequest (Left message) = do - S.status Status.badRequest400 - S.text (LT.fromStrict message) -okOrBadRequest (Right ()) = - S.status Status.ok200 diff --git a/server/src/Controller/Income.hs b/server/src/Controller/Income.hs deleted file mode 100644 index 96ccbbc..0000000 --- a/server/src/Controller/Income.hs +++ /dev/null @@ -1,90 +0,0 @@ -module Controller.Income - ( list - , create - , edit - , delete - ) where - -import Control.Monad.IO.Class (liftIO) -import qualified Data.Map as M -import qualified Data.Time.Clock as Clock -import Data.Validation (Validation (..)) -import qualified Network.HTTP.Types.Status as Status -import Web.Scotty hiding (delete) - -import Common.Model (CreateIncomeForm (..), - EditIncomeForm (..), - IncomeHeader (..), IncomeId, - IncomePage (..), User (..)) -import qualified Common.Msg as Msg - -import qualified Controller.Helper as ControllerHelper -import Model.CreateIncome (CreateIncome (..)) -import Model.EditIncome (EditIncome (..)) -import qualified Model.Query as Query -import qualified Persistence.Income as IncomePersistence -import qualified Persistence.Payment as PaymentPersistence -import qualified Persistence.User as UserPersistence -import qualified Secure -import qualified Validation.Income as IncomeValidation - -list :: Int -> Int -> ActionM () -list page perPage = - Secure.loggedAction (\_ -> do - currentTime <- liftIO Clock.getCurrentTime - (liftIO . Query.run $ do - count <- IncomePersistence.count - - users <- UserPersistence.list - let userIds = _user_id <$> users - - paymentRange <- PaymentPersistence.getRange - incomeDefinedForAll <- IncomePersistence.definedForAll userIds - let since = max <$> (fst <$> paymentRange) <*> incomeDefinedForAll - - cumulativeIncome <- - case since of - Just s -> IncomePersistence.getCumulativeIncome s (Clock.utctDay currentTime) - Nothing -> return M.empty - - incomes <- IncomePersistence.list page perPage - return $ IncomePage page (IncomeHeader since cumulativeIncome) incomes count) >>= json - ) - -create :: CreateIncomeForm -> ActionM () -create form = - Secure.loggedAction (\user -> - (liftIO . Query.run $ do - case IncomeValidation.createIncome form of - Success (CreateIncome amount date) -> do - Right <$> (IncomePersistence.create (_user_id user) date amount) - - Failure validationError -> - return $ Left validationError - ) >>= ControllerHelper.okOrBadRequest - ) - -edit :: EditIncomeForm -> ActionM () -edit form = - Secure.loggedAction (\user -> - (liftIO . Query.run $ do - case IncomeValidation.editIncome form of - Success (EditIncome incomeId amount date) -> - do - isSuccess <- IncomePersistence.edit (_user_id user) incomeId date amount - return $ if isSuccess then - Right () - else - Left $ Msg.get Msg.Error_IncomeEdit - - Failure validationError -> - return $ Left validationError - ) >>= ControllerHelper.okOrBadRequest - ) - -delete :: IncomeId -> ActionM () -delete incomeId = - Secure.loggedAction (\user -> do - _ <- liftIO . Query.run $ IncomePersistence.delete (_user_id user) incomeId - status Status.ok200 - ) diff --git a/server/src/Controller/Index.hs b/server/src/Controller/Index.hs deleted file mode 100644 index 4f4ae77..0000000 --- a/server/src/Controller/Index.hs +++ /dev/null @@ -1,76 +0,0 @@ -module Controller.Index - ( get - , signIn - , signOut - ) where - -import Control.Monad.IO.Class (liftIO) -import Data.Text (Text) -import qualified Data.Text.Lazy as TL -import Data.Validation (Validation (..)) -import qualified Network.HTTP.Types.Status as Status -import Prelude hiding (error, init) -import Web.Scotty (ActionM) -import qualified Web.Scotty as S - -import Common.Model (Init (..), SignInForm (..), - User (..)) -import qualified Common.Msg as Msg - -import Conf (Conf (..)) -import qualified LoginSession -import Model.Query (Query) -import qualified Model.Query as Query -import Model.SignIn (SignIn (..)) -import qualified Persistence.User as UserPersistence -import qualified Validation.SignIn as SignInValidation -import View.Page (page) - -get :: Conf -> ActionM () -get conf = do - init <- do - mbToken <- LoginSession.get - case mbToken of - Nothing -> - return Nothing - Just token -> do - liftIO . Query.run $ getInit conf token - S.html $ page init - -signIn :: Conf -> SignInForm -> ActionM () -signIn conf form = - case SignInValidation.signIn form of - Failure _ -> - textKey Status.badRequest400 Msg.SignIn_InvalidCredentials - Success (SignIn email password) -> do - result <- liftIO . Query.run $ do - isPasswordValid <- UserPersistence.checkPassword email password - if isPasswordValid then - do - signInToken <- UserPersistence.createSignInToken email - init <- getInit conf signInToken - return $ Just (signInToken, init) - else - return Nothing - case result of - Just (signInToken, init) -> do - LoginSession.put conf signInToken - S.json init - - Nothing -> - textKey Status.badRequest400 Msg.SignIn_InvalidCredentials - where textKey st key = S.status st >> (S.text . TL.fromStrict $ Msg.get key) - -getInit :: Conf -> Text -> Query (Maybe Init) -getInit conf signInToken = do - user <- UserPersistence.get signInToken - case user of - Just u -> - do - users <- UserPersistence.list - return . Just $ Init users (_user_id u) (Conf.currency conf) - Nothing -> - return Nothing - -signOut :: Conf -> ActionM () -signOut conf = LoginSession.delete conf >> S.status Status.ok200 diff --git a/server/src/Controller/Payment.hs b/server/src/Controller/Payment.hs deleted file mode 100644 index 4fb4d54..0000000 --- a/server/src/Controller/Payment.hs +++ /dev/null @@ -1,118 +0,0 @@ -module Controller.Payment - ( list - , create - , edit - , delete - , searchCategory - ) where - -import Control.Monad.IO.Class (liftIO) -import qualified Data.Map as M -import Data.Text (Text) -import qualified Data.Time.Clock as Clock -import qualified Data.Time.Calendar as Calendar -import Data.Validation (Validation (Failure, Success)) -import Web.Scotty (ActionM) -import qualified Web.Scotty as S - -import Common.Model (Category (..), CreatePaymentForm (..), - EditPaymentForm (..), Frequency, - PaymentHeader (..), PaymentId, - PaymentPage (..), User (..)) -import qualified Common.Msg as Msg - -import qualified Controller.Helper as ControllerHelper -import Model.CreatePayment (CreatePayment (..)) -import Model.EditPayment (EditPayment (..)) -import qualified Model.Query as Query -import qualified Payer as Payer -import qualified Persistence.Category as CategoryPersistence -import qualified Persistence.Income as IncomePersistence -import qualified Persistence.Payment as PaymentPersistence -import qualified Persistence.User as UserPersistence -import qualified Secure -import qualified Validation.Payment as PaymentValidation - -list :: Frequency -> Int -> Int -> Text -> ActionM () -list frequency page perPage search = - Secure.loggedAction (\_ -> do - currentUtctDay <- liftIO $ Clock.utctDay <$> Clock.getCurrentTime - (liftIO . Query.run $ do - count <- PaymentPersistence.count frequency search - payments <- PaymentPersistence.listActivePage frequency page perPage search - - users <- UserPersistence.list - - paymentRange <- PaymentPersistence.getRange - incomeDefinedForAll <- IncomePersistence.definedForAll (_user_id <$> users) - - cumulativeIncome <- - case (incomeDefinedForAll, paymentRange) of - (Just incomeStart, Just (paymentStart, _)) -> - IncomePersistence.getCumulativeIncome (max incomeStart paymentStart) currentUtctDay - - _ -> - return M.empty - - searchRepartition <- - case paymentRange of - Just (from, to) -> - PaymentPersistence.repartition frequency search from (Calendar.addDays 1 to) - Nothing -> - return M.empty - - (preIncomeRepartition, postIncomeRepartition) <- - PaymentPersistence.getPreAndPostPaymentRepartition paymentRange users - - let exceedingPayers = Payer.getExceedingPayers users cumulativeIncome preIncomeRepartition postIncomeRepartition - - header = PaymentHeader - { _paymentHeader_exceedingPayers = exceedingPayers - , _paymentHeader_repartition = searchRepartition - } - - return $ PaymentPage page frequency header payments count) >>= S.json - ) - -create :: CreatePaymentForm -> ActionM () -create form = - Secure.loggedAction (\user -> - (liftIO . Query.run $ do - cs <- map _category_id <$> CategoryPersistence.listAll - case PaymentValidation.createPayment cs form of - Success (CreatePayment name cost date category frequency) -> - Right <$> PaymentPersistence.create (_user_id user) name cost date category frequency - Failure validationError -> - return $ Left validationError - ) >>= ControllerHelper.okOrBadRequest - ) - -edit :: EditPaymentForm -> ActionM () -edit form = - Secure.loggedAction (\user -> - (liftIO . Query.run $ do - cs <- map _category_id <$> CategoryPersistence.listAll - case PaymentValidation.editPayment cs form of - Success (EditPayment paymentId name cost date category frequency) -> do - isSuccess <- PaymentPersistence.edit (_user_id user) paymentId name cost date category frequency - return $ if isSuccess then - Right () - else - Left $ Msg.get Msg.Error_PaymentEdit - Failure validationError -> - return $ Left validationError - ) >>= ControllerHelper.okOrBadRequest - ) - -delete :: PaymentId -> ActionM () -delete paymentId = - Secure.loggedAction (\user -> - liftIO . Query.run $ PaymentPersistence.delete (_user_id user) paymentId - ) - -searchCategory :: Text -> ActionM () -searchCategory paymentName = - Secure.loggedAction (\_ -> do - (liftIO $ Query.run (PaymentPersistence.searchCategory paymentName)) - >>= S.json - ) diff --git a/server/src/Controller/Statistics.hs b/server/src/Controller/Statistics.hs deleted file mode 100644 index 500c93c..0000000 --- a/server/src/Controller/Statistics.hs +++ /dev/null @@ -1,21 +0,0 @@ -module Controller.Statistics - ( paymentsAndIncomes - ) where - -import Control.Monad.IO.Class (liftIO) -import Web.Scotty (ActionM) -import qualified Web.Scotty as S - -import qualified Model.Query as Query -import qualified Persistence.Income as IncomePersistence -import qualified Persistence.Payment as PaymentPersistence -import qualified Secure -import qualified Statistics - -paymentsAndIncomes :: ActionM () -paymentsAndIncomes = - Secure.loggedAction (\_ -> do - payments <- liftIO $ Query.run PaymentPersistence.listAllPunctual - incomes <- liftIO $ Query.run IncomePersistence.listAll - S.json (Statistics.paymentsAndIncomes payments incomes) - ) diff --git a/server/src/Controller/User.hs b/server/src/Controller/User.hs deleted file mode 100644 index a7bb136..0000000 --- a/server/src/Controller/User.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Controller.User - ( list - ) where - -import Control.Monad.IO.Class (liftIO) -import Web.Scotty (ActionM) -import qualified Web.Scotty as S - -import qualified Model.Query as Query -import qualified Persistence.User as UserPersistence -import qualified Secure - -list :: ActionM () -list = - Secure.loggedAction (\_ -> - (liftIO . Query.run $ UserPersistence.list) >>= S.json - ) -- cgit v1.2.3