diff options
author | Joris Guyonvarch | 2015-08-13 22:55:41 +0200 |
---|---|---|
committer | Joris Guyonvarch | 2015-08-13 22:55:41 +0200 |
commit | 359f837511597354bc6462cfc4200f54d647d728 (patch) | |
tree | 13d896bd1280a735945609e890faa606abd135fa /src/server/Model | |
parent | 35557ae09d10aa6388b79e2e19ee7702efb28bc6 (diff) |
Giving the payment id to the client
Diffstat (limited to 'src/server/Model')
-rw-r--r-- | src/server/Model/Database.hs | 4 | ||||
-rw-r--r-- | src/server/Model/Json/Payment.hs | 3 | ||||
-rw-r--r-- | src/server/Model/Payment.hs | 14 |
3 files changed, 18 insertions, 3 deletions
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 |