src/server/Controller/Payment.hs


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

{-# LANGUAGE OverloadedStrings #-}

module Controller.Payment
  ( list
  , create
  , editOwn
  , deleteOwn
  ) where

import Web.Scotty

import Network.HTTP.Types.Status (ok200, badRequest400)

import Database.Persist

import Control.Monad.IO.Class (liftIO)

import Data.Text (Text)

import qualified Secure

import Json (jsonId)

import Model.Database
import qualified Model.Payment as Payment
import qualified Model.PaymentCategory as PaymentCategory
import qualified Model.Json.CreatePayment as Json
import qualified Model.Json.EditPayment as Json

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

create :: Json.CreatePayment -> ActionM ()
create (Json.CreatePayment name cost date category frequency) =
  Secure.loggedAction (\user ->
    (liftIO . runDb $ do
      PaymentCategory.set name category
      Payment.create (entityKey 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 . runDb $ do
      mbPayment <- fmap entityVal <$> Payment.find paymentId
      case mbPayment of
        Just payment -> do
          edited <- Payment.editOwn (entityKey user) paymentId name cost date frequency
          if edited
            then PaymentCategory.edit (paymentName payment) name category >> return True
            else return edited
        _ ->
          return False
    if updated
      then status ok200
      else status badRequest400
  )

deleteOwn :: Text -> ActionM ()
deleteOwn paymentId =
  Secure.loggedAction (\user -> do
    deleted <- liftIO . runDb $ Payment.deleteOwn (entityKey user) (textToKey paymentId)
    if deleted
      then status ok200
      else status badRequest400
  )