aboutsummaryrefslogtreecommitdiff
path: root/server/src/Controller/Payment.hs
blob: ba9d1ba67b2381d476fcfa6f192d43426792e370 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
module Controller.Payment
  ( list
  , create
  , edit
  , delete
  ) 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                (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.Payment          as PaymentValidation

list :: ActionM ()
list =
  Secure.loggedAction (\_ ->
    (liftIO . Query.run $ PaymentPersistence.listActive) >>= json
  )

create :: CreatePaymentForm -> ActionM ()
create form =
  Secure.loggedAction (\user ->
    (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 . Right $ SavedPayment p pc
        Failure validationError ->
          return $ Left validationError
    ) >>= ControllerHelper.jsonOrBadRequest
  )

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 ()
delete paymentId =
  Secure.loggedAction (\user -> do
    deleted <- liftIO . Query.run $ do
      payment <- PaymentPersistence.find paymentId
      case payment of
        Just p | _payment_user p == _user_id user -> do
          PaymentPersistence.delete (_user_id user) paymentId
          PaymentCategoryPersistence.deleteIfUnused (_payment_name p)
          return True
        _ ->
          return False
    if deleted then
      status Status.ok200
    else
      status Status.badRequest400
  )