Server payament delete

8 files changed, 80 insertions, 28 deletions

diff --git a/src/client/ServerCommunication.elm b/src/client/ServerCommunication.elm
index b4b547d..010b3df 100644
--- a/src/client/ServerCommunication.elm
+++ b/src/client/ServerCommunication.elm
@@ -11,6 +11,7 @@ import Json.Decode exposing (..)
 import Date
 
 import Model.Message exposing (messageDecoder)
+import Model.Payment exposing (PaymentId)
 
 import Update as U
 import Update.SignIn exposing (..)
@@ -20,6 +21,7 @@ type Communication =
   NoCommunication
   | SignIn String
   | AddPayment String Int
+  | DeletePayment PaymentId
   | SignOut
 
 serverCommunications : Signal.Mailbox Communication
@@ -40,26 +42,21 @@ getRequest communication =
     NoCommunication ->
       Nothing
     SignIn login ->
-      Just
-        { verb = "post"
-        , headers = []
-        , url = "/signIn?login=" ++ login
-        , body = Http.empty
-        }
+      Just (simplePost ("/signIn?login=" ++ login))
     AddPayment name cost ->
-      Just
-        { verb = "post"
-        , headers = []
-        , url = "/payment/add?name=" ++ name ++ "&cost=" ++ (toString cost)
-        , body = Http.empty
-        }
+      Just (simplePost ("/payment/add?name=" ++ name ++ "&cost=" ++ (toString cost)))
+    DeletePayment paymentId ->
+      Just (simplePost ("payment/delete?id=" ++ paymentId))
     SignOut ->
-      Just
-        { verb = "post"
-        , headers = []
-        , url = "/signOut"
-        , body = Http.empty
-        }
+      Just (simplePost  "/signout")
+
+simplePost : String -> Http.Request
+simplePost url =
+  { verb = "post"
+  , headers = []
+  , url = url
+  , body = Http.empty
+  }
 
 communicationToAction : Communication -> Http.Response -> U.Action
 communicationToAction communication response =
@@ -74,6 +71,8 @@ communicationToAction communication response =
           decodeResponse
             response
             (\id -> U.UpdatePayment (UP.AddPayment id name cost))
+        DeletePayment id ->
+          U.UpdatePayment (UP.Remove id)
         SignOut ->
           U.GoSignInView
     else
diff --git a/src/client/View/Payments/Table.elm b/src/client/View/Payments/Table.elm
index 9033db8..50dd151 100644
--- a/src/client/View/Payments/Table.elm
+++ b/src/client/View/Payments/Table.elm
@@ -16,6 +16,8 @@ import Model exposing (Model)
 import Model.Payment exposing (..)
 import Model.View.PaymentView exposing (PaymentView)
 
+import ServerCommunication as SC exposing (serverCommunications)
+
 import Update exposing (..)
 import Update.Payment exposing (..)
 
@@ -54,9 +56,13 @@ paymentLine model paymentView (id, payment) =
     , div [ class "cell" ] [ text ((toString payment.cost) ++ " €") ]
     , div [ class "cell" ] [ text payment.userName ]
     , div [ class "cell" ] [ text (renderDate payment.creation model.translations) ]
-    , div
-        [ class "cell remove"
-        , onClick actions.address (UpdatePayment (Remove id))
-        ]
-        [ renderIcon "times" ]
+    , if paymentView.userName == payment.userName
+        then
+          div
+            [ class "cell remove"
+            , onClick serverCommunications.address (SC.DeletePayment id)
+            ]
+            [ renderIcon "times" ]
+        else
+          div [ class "cell" ] []
     ]
diff --git a/src/server/Controller/Payment.hs b/src/server/Controller/Payment.hs
index 141aed0..cbd342a 100644
--- a/src/server/Controller/Payment.hs
+++ b/src/server/Controller/Payment.hs
@@ -1,10 +1,13 @@
 module Controller.Payment
   ( getPaymentsAction
   , createPaymentAction
+  , deletePaymentAction
   ) where
 
 import Web.Scotty
 
+import Network.HTTP.Types.Status (ok200, badRequest400)
+
 import Database.Persist
 
 import Control.Monad.IO.Class (liftIO)
@@ -16,6 +19,8 @@ import qualified Secure
 import Model.Database
 import Model.Payment
 import Model.Json.Message
+import Model.Message
+import Model.Message.Key (Key(PaymentNotDeleted))
 
 getPaymentsAction :: ActionM ()
 getPaymentsAction =
@@ -30,3 +35,15 @@ createPaymentAction name cost =
     paymentKey <- liftIO . runDb $ createPayment (entityKey user) name cost
     json . Message . paymentKeyToText $ paymentKey
   )
+
+deletePaymentAction :: Text -> ActionM ()
+deletePaymentAction paymentId =
+  Secure.loggedAction (\user -> do
+    deleted <- liftIO . runDb $ deleteOwnPayment user (textToKey paymentId)
+    if deleted
+      then
+        status ok200
+      else do
+        status badRequest400
+        json . Message . getMessage $ PaymentNotDeleted
+  )
diff --git a/src/server/Main.hs b/src/server/Main.hs
index 0828e0d..1363f33 100644
--- a/src/server/Main.hs
+++ b/src/server/Main.hs
@@ -50,6 +50,10 @@ main = do
           cost <- param "cost" :: ActionM Int
           createPaymentAction name cost
 
+        post "/payment/delete" $ do
+          paymentId <- param "id" :: ActionM Text
+          deletePaymentAction paymentId
+
         post "/signOut" $
           signOutAction
 
diff --git a/src/server/Model/Database.hs b/src/server/Model/Database.hs
index 7f1777a..8715ca1 100644
--- a/src/server/Model/Database.hs
+++ b/src/server/Model/Database.hs
@@ -27,12 +27,14 @@ User
   email Text
   name Text
   EmailKey email
+  UniqName name
   deriving Show
 Payment
   userId UserId
   creation UTCTime
   name Text
   cost Int
+  deletedAt UTCTime Maybe
   deriving Show
 SignIn
   token Text
@@ -51,5 +53,5 @@ runDb = runNoLoggingT . runResourceT . withSqliteConn "database" . runSqlConn
 runMigrations :: IO ()
 runMigrations = runDb $ runMigration migrateAll
 
-textToKey :: (ToBackendKey SqlBackend a) => String -> Key a
-textToKey text = toSqlKey (read text :: Int64)
+textToKey :: (ToBackendKey SqlBackend a) => Text -> Key a
+textToKey text = toSqlKey (read (unpack text) :: Int64)
diff --git a/src/server/Model/Message/Key.hs b/src/server/Model/Message/Key.hs
index 9b5c69e..b5ea45b 100644
--- a/src/server/Model/Message/Key.hs
+++ b/src/server/Model/Message/Key.hs
@@ -49,5 +49,6 @@ data Key =
   -- Payments
 
   | Add
+  | PaymentNotDeleted
 
   deriving (Enum, Bounded, Show)
diff --git a/src/server/Model/Message/Translations.hs b/src/server/Model/Message/Translations.hs
index 62381a7..c0f9d3c 100644
--- a/src/server/Model/Message/Translations.hs
+++ b/src/server/Model/Message/Translations.hs
@@ -184,3 +184,8 @@ m l Add =
   case l of
     English -> "Add"
     French  -> "Ajouter"
+
+m l PaymentNotDeleted =
+  case l of
+    English -> "The payment could not have been deleted."
+    French  -> "Le paiement n'a pas pu être supprimé."
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