From 7529a18ff0ac443e7f9764b5e2d0f57a5d3a850b Mon Sep 17 00:00:00 2001 From: Joris Date: Wed, 9 Oct 2019 23:16:00 +0200 Subject: Use common payment validation in the backend Remove deprecated backend validation --- server/src/Controller/Helper.hs | 17 ++++++++ server/src/Controller/Payment.hs | 73 +++++++++++++++++++--------------- server/src/Model/CreatePayment.hs | 16 ++++++++ server/src/Model/EditPayment.hs | 17 ++++++++ server/src/Validation/Atomic.hs | 32 --------------- server/src/Validation/CreatePayment.hs | 25 ------------ server/src/Validation/Payment.hs | 33 +++++++++++++++ 7 files changed, 123 insertions(+), 90 deletions(-) create mode 100644 server/src/Controller/Helper.hs create mode 100644 server/src/Model/CreatePayment.hs create mode 100644 server/src/Model/EditPayment.hs delete mode 100644 server/src/Validation/Atomic.hs delete mode 100644 server/src/Validation/CreatePayment.hs create mode 100644 server/src/Validation/Payment.hs (limited to 'server/src') diff --git a/server/src/Controller/Helper.hs b/server/src/Controller/Helper.hs new file mode 100644 index 0000000..fd0d2bb --- /dev/null +++ b/server/src/Controller/Helper.hs @@ -0,0 +1,17 @@ +module Controller.Helper + ( jsonOrBadRequest + ) where + +import Data.Aeson (ToJSON) +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 + +jsonOrBadRequest :: forall a. (ToJSON a) => Either Text a -> ActionM () +jsonOrBadRequest (Left message) = do + S.status Status.badRequest400 + S.text (LT.fromStrict message) +jsonOrBadRequest (Right a) = + S.json a diff --git a/server/src/Controller/Payment.hs b/server/src/Controller/Payment.hs index 38c1c19..ba9d1ba 100644 --- a/server/src/Controller/Payment.hs +++ b/server/src/Controller/Payment.hs @@ -6,18 +6,25 @@ module Controller.Payment ) where import Control.Monad.IO.Class (liftIO) +import Data.Validation (Validation (Failure, Success)) import qualified Network.HTTP.Types.Status as Status import Web.Scotty hiding (delete) -import Common.Model (CreatePayment (..), - EditPayment (..), Payment (..), - PaymentId, SavedPayment (..), - User (..)) +import Common.Model (Category (..), + CreatePaymentForm (..), + EditPaymentForm (..), + Payment (..), PaymentId, + SavedPayment (..), 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 Persistence.Category as CategoryPersistence import qualified Persistence.Payment as PaymentPersistence import qualified Persistence.PaymentCategory as PaymentCategoryPersistence import qualified Secure -import qualified Validation.CreatePayment as CreatePaymentValidation +import qualified Validation.Payment as PaymentValidation list :: ActionM () list = @@ -25,39 +32,39 @@ list = (liftIO . Query.run $ PaymentPersistence.listActive) >>= json ) -create :: CreatePayment -> ActionM () -create createPayment@(CreatePayment name cost date category frequency) = +create :: CreatePaymentForm -> ActionM () +create form = Secure.loggedAction (\user -> - case CreatePaymentValidation.validate createPayment of - Nothing -> - (liftIO . Query.run $ do + (liftIO . Query.run $ do + cs <- map _category_id <$> CategoryPersistence.list + case PaymentValidation.createPayment cs form of + Success (CreatePayment name cost date category frequency) -> do pc <- PaymentCategoryPersistence.save name category p <- PaymentPersistence.create (_user_id user) name cost date frequency - return $ SavedPayment p pc - ) >>= json - Just validationError -> - do - status Status.badRequest400 - json validationError + return . Right $ SavedPayment p pc + Failure validationError -> + return $ Left validationError + ) >>= ControllerHelper.jsonOrBadRequest ) -edit :: EditPayment -> ActionM () -edit (EditPayment paymentId name cost date category frequency) = - Secure.loggedAction (\user -> do - result <- liftIO . Query.run $ do - editedPayment <- PaymentPersistence.edit (_user_id user) paymentId name cost date frequency - case editedPayment of - Just (old, new) -> do - pc <- PaymentCategoryPersistence.save name category - PaymentCategoryPersistence.deleteIfUnused (_payment_name old) - return $ Just (new, pc) - Nothing -> - return Nothing - case result of - Just (p, pc) -> - json $ SavedPayment p pc - Nothing -> - status Status.badRequest400 +edit :: EditPaymentForm -> ActionM () +edit form = + Secure.loggedAction (\user -> + (liftIO . Query.run $ do + cs <- map _category_id <$> CategoryPersistence.list + case PaymentValidation.editPayment cs form of + Success (EditPayment paymentId name cost date category frequency) -> do + editedPayment <- PaymentPersistence.edit (_user_id user) paymentId name cost date frequency + case editedPayment of + Just (old, new) -> do + pc <- PaymentCategoryPersistence.save name category + PaymentCategoryPersistence.deleteIfUnused (_payment_name old) + return . Right $ SavedPayment new pc + Nothing -> + return . Left $ Msg.get Msg.Error_PaymentEdit + Failure validationError -> + return $ Left validationError + ) >>= ControllerHelper.jsonOrBadRequest ) delete :: PaymentId -> ActionM () diff --git a/server/src/Model/CreatePayment.hs b/server/src/Model/CreatePayment.hs new file mode 100644 index 0000000..b25d2a4 --- /dev/null +++ b/server/src/Model/CreatePayment.hs @@ -0,0 +1,16 @@ +module Model.CreatePayment + ( CreatePayment(..) + ) where + +import Data.Text (Text) +import Data.Time.Calendar (Day) + +import Common.Model (CategoryId, Frequency) + +data CreatePayment = CreatePayment + { _createPayment_name :: Text + , _createPayment_cost :: Int + , _createPayment_date :: Day + , _createPayment_category :: CategoryId + , _createPayment_frequency :: Frequency + } deriving (Show) diff --git a/server/src/Model/EditPayment.hs b/server/src/Model/EditPayment.hs new file mode 100644 index 0000000..ac4c906 --- /dev/null +++ b/server/src/Model/EditPayment.hs @@ -0,0 +1,17 @@ +module Model.EditPayment + ( EditPayment(..) + ) where + +import Data.Text (Text) +import Data.Time.Calendar (Day) + +import Common.Model (CategoryId, Frequency, PaymentId) + +data EditPayment = EditPayment + { _editPayment_id :: PaymentId + , _editPayment_name :: Text + , _editPayment_cost :: Int + , _editPayment_date :: Day + , _editPayment_category :: CategoryId + , _editPayment_frequency :: Frequency + } deriving (Show) diff --git a/server/src/Validation/Atomic.hs b/server/src/Validation/Atomic.hs deleted file mode 100644 index 7a7351a..0000000 --- a/server/src/Validation/Atomic.hs +++ /dev/null @@ -1,32 +0,0 @@ -module Validation.Atomic - ( nonEmpty - , nonNullNumber - -- , number - ) where - -import Data.Text (Text) -import qualified Data.Text as T - -import qualified Common.Msg as Msg - -nonEmpty :: Text -> Maybe Text -nonEmpty str = - if T.null str - then Just $ Msg.get Msg.Form_NonEmpty - else Nothing - -nonNullNumber :: Int -> Maybe Text -nonNullNumber n = - if n == 0 - then Just $ Msg.get Msg.Form_NonNullNumber - else Nothing - --- number :: (Int -> Bool) -> Text -> Maybe Int --- number numberForm str = --- case reads (T.unpack str) :: [(Int, String)] of --- (num, _) : _ -> --- if numberForm num --- then Just num --- else Nothing --- _ -> --- Nothing diff --git a/server/src/Validation/CreatePayment.hs b/server/src/Validation/CreatePayment.hs deleted file mode 100644 index fbcdb7c..0000000 --- a/server/src/Validation/CreatePayment.hs +++ /dev/null @@ -1,25 +0,0 @@ -module Validation.CreatePayment - ( validate - ) where - -import Data.Maybe (catMaybes) - -import Common.Model.CreatePayment (CreatePayment (..), - CreatePaymentError (..)) -import qualified Validation.Atomic as Atomic - -validate :: CreatePayment -> Maybe CreatePaymentError -validate p = - if not . null . catMaybes $ [ nameError, costError ] - then Just createPaymentError - else Nothing - where - nameError = Atomic.nonEmpty . _createPayment_name $ p - costError = Atomic.nonNullNumber . _createPayment_cost $ p - createPaymentError = CreatePaymentError - { _createPaymentError_name = nameError - , _createPaymentError_cost = costError - , _createPaymentError_date = Nothing - , _createPaymentError_category = Nothing - , _createPaymentError_frequency = Nothing - } diff --git a/server/src/Validation/Payment.hs b/server/src/Validation/Payment.hs new file mode 100644 index 0000000..20e370e --- /dev/null +++ b/server/src/Validation/Payment.hs @@ -0,0 +1,33 @@ +module Validation.Payment + ( createPayment + , editPayment + ) where + +import Data.Text (Text) +import Data.Validation (Validation) +import qualified Data.Validation as V + +import Common.Model (CategoryId, CreatePaymentForm (..), + EditPaymentForm (..)) +import qualified Common.Validation.Payment as PaymentValidation +import Model.CreatePayment (CreatePayment (..)) +import Model.EditPayment (EditPayment (..)) + +createPayment :: [CategoryId] -> CreatePaymentForm -> Validation Text CreatePayment +createPayment categories form = + CreatePayment + <$> PaymentValidation.name (_createPaymentForm_name form) + <*> PaymentValidation.cost (_createPaymentForm_cost form) + <*> PaymentValidation.date (_createPaymentForm_date form) + <*> PaymentValidation.category categories (_createPaymentForm_category form) + <*> V.Success (_createPaymentForm_frequency form) + +editPayment :: [CategoryId] -> EditPaymentForm -> Validation Text EditPayment +editPayment categories form = + EditPayment + <$> V.Success (_editPaymentForm_id form) + <*> PaymentValidation.name (_editPaymentForm_name form) + <*> PaymentValidation.cost (_editPaymentForm_cost form) + <*> PaymentValidation.date (_editPaymentForm_date form) + <*> PaymentValidation.category categories (_editPaymentForm_category form) + <*> V.Success (_editPaymentForm_frequency form) -- cgit v1.2.3