Giving the payment id to the client

5 files changed, 24 insertions, 5 deletions

diff --git a/src/server/Controller/Payment.hs b/src/server/Controller/Payment.hs
index 1287825..219206a 100644
--- a/src/server/Controller/Payment.hs
+++ b/src/server/Controller/Payment.hs
@@ -11,10 +11,13 @@ import Control.Monad.IO.Class (liftIO)
 
 import Data.Text (Text)
 
+import Database.Persist.Sqlite (unSqlBackendKey)
+
 import qualified Secure
 
 import Model.Database
 import Model.Payment
+import Model.Json.Message
 
 getPaymentsAction :: ActionM ()
 getPaymentsAction =
@@ -26,6 +29,6 @@ getPaymentsAction =
 createPaymentAction :: Text -> Int -> ActionM ()
 createPaymentAction name cost =
   Secure.loggedAction (\user -> do
-    _ <- liftIO . runDb $ createPayment (entityKey user) name cost
-    return ()
+    paymentKey <- liftIO . runDb $ createPayment (entityKey user) name cost
+    json . Message . paymentKeyToText $ paymentKey
   )
diff --git a/src/server/Design/Global.hs b/src/server/Design/Global.hs
index 76db6dd..54533c2 100644
--- a/src/server/Design/Global.hs
+++ b/src/server/Design/Global.hs
@@ -72,6 +72,7 @@ global = do
           lineHeight (px inputHeight)
           fontSize (px 22)
           verticalAlign middle
+          cursor cursorText
         input ? defaultInput inputHeight
         "input:focus + label" ? backgroundColor C.grey
 
diff --git a/src/server/Model/Database.hs b/src/server/Model/Database.hs
index e5fd075..7f1777a 100644
--- a/src/server/Model/Database.hs
+++ b/src/server/Model/Database.hs
@@ -16,6 +16,7 @@ import Control.Monad.Trans.Resource (runResourceT, ResourceT)
 
 import Data.Text
 import Data.Time.Clock (UTCTime)
+import Data.Int (Int64)
 
 import Database.Persist.Sqlite
 import Database.Persist.TH
@@ -49,3 +50,6 @@ 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)
diff --git a/src/server/Model/Json/Payment.hs b/src/server/Model/Json/Payment.hs
index de6beb9..f22c8cf 100644
--- a/src/server/Model/Json/Payment.hs
+++ b/src/server/Model/Json/Payment.hs
@@ -11,7 +11,8 @@ import Data.Text (Text)
 import Data.Aeson
 
 data Payment = Payment
-  { creation :: UTCTime
+  { id :: Text
+  , creation :: UTCTime
   , name :: Text
   , cost :: Int
   , userName :: Text
diff --git a/src/server/Model/Payment.hs b/src/server/Model/Payment.hs
index ad1c261..2e191b9 100644
--- a/src/server/Model/Payment.hs
+++ b/src/server/Model/Payment.hs
@@ -1,9 +1,11 @@
 module Model.Payment
   ( getPayments
   , createPayment
+  , paymentKeyToText
   ) where
 
 import Data.Text (Text)
+import qualified Data.Text as T
 import Data.Time.Clock (getCurrentTime)
 
 import Control.Monad.IO.Class (liftIO)
@@ -27,8 +29,16 @@ getJsonPayment :: (Entity Payment, Entity User) -> P.Payment
 getJsonPayment (paymentEntity, userEntity) =
   let payment = entityVal paymentEntity
       user = entityVal userEntity
-  in  P.Payment (paymentCreation payment) (paymentName payment) (paymentCost payment) (userName user)
-
+  in  P.Payment
+        { P.id = paymentKeyToText . entityKey $ paymentEntity
+        , P.creation = paymentCreation payment
+        , P.name = paymentName payment
+        , P.cost = paymentCost payment
+        , P.userName = userName user
+        }
+
+paymentKeyToText :: Key Payment -> Text
+paymentKeyToText = T.pack . show . unSqlBackendKey . unPaymentKey
 
 createPayment :: UserId -> Text -> Int -> Persist PaymentId
 createPayment userId name cost = do