aboutsummaryrefslogtreecommitdiff
path: root/server/src/Controller/Payment.hs
blob: c6c874ab00b817e4efef7f9863b7847eed512ac3 (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
module Controller.Payment
  ( list
  , create
  , editOwn
  , deleteOwn
  ) where

import           Control.Monad.IO.Class    (liftIO)
import           Network.HTTP.Types.Status (badRequest400, ok200)
import           Web.Scotty

import           Common.Model              (CreatePayment (..),
                                            EditPayment (..), PaymentId,
                                            User (..))

import           Json                      (jsonId)
import qualified Model.Payment             as Payment
import qualified Model.PaymentCategory     as PaymentCategory
import qualified Model.Query               as Query
import qualified Secure

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

create :: CreatePayment -> ActionM ()
create (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 :: EditPayment -> ActionM ()
editOwn (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
  )