From fd86f021e88a00348ac0e03f03d81cb15bf3042b Mon Sep 17 00:00:00 2001
From: Joris
Date: Thu, 27 Aug 2015 20:36:18 +0200
Subject: Server payament delete

---
 src/server/Model/Payment.hs | 24 +++++++++++++++++++++---
 1 file changed, 21 insertions(+), 3 deletions(-)

(limited to 'src/server/Model/Payment.hs')

diff --git a/src/server/Model/Payment.hs b/src/server/Model/Payment.hs
index 2e191b9..51f09b9 100644
--- a/src/server/Model/Payment.hs
+++ b/src/server/Model/Payment.hs
@@ -2,6 +2,7 @@ module Model.Payment
   ( getPayments
   , createPayment
   , paymentKeyToText
+  , deleteOwnPayment
   ) where
 
 import Data.Text (Text)
@@ -11,6 +12,7 @@ import Data.Time.Clock (getCurrentTime)
 import Control.Monad.IO.Class (liftIO)
 
 import Database.Persist
+import qualified Database.Persist as P
 import Database.Esqueleto
 import qualified Database.Esqueleto as E
 
@@ -21,8 +23,9 @@ getPayments :: Persist [P.Payment]
 getPayments = do
   xs <- select $
         from $ \(payment `InnerJoin` user) -> do
-        on (payment ^. PaymentUserId E.==. user ^. UserId)
-        return (payment, user)
+          on (payment ^. PaymentUserId E.==. user ^. UserId)
+          where_ (isNothing (payment ^. PaymentDeletedAt))
+          return (payment, user)
   return (map getJsonPayment xs)
 
 getJsonPayment :: (Entity Payment, Entity User) -> P.Payment
@@ -43,4 +46,19 @@ paymentKeyToText = T.pack . show . unSqlBackendKey . unPaymentKey
 createPayment :: UserId -> Text -> Int -> Persist PaymentId
 createPayment userId name cost = do
   now <- liftIO getCurrentTime
-  insert $ Payment userId now name cost
+  insert $ Payment userId now name cost Nothing
+
+deleteOwnPayment :: Entity User -> PaymentId -> Persist Bool
+deleteOwnPayment user paymentId = do
+  mbPayment <- get paymentId
+  case mbPayment of
+    Just payment ->
+      if paymentUserId payment == entityKey user
+        then do
+          now <- liftIO getCurrentTime
+          P.update paymentId [PaymentDeletedAt P.=. Just now]
+          return True
+        else
+          return False
+    Nothing ->
+      return False
-- 
cgit v1.2.3