From 0981bb0e485675346045005cc5ba31e97c32ea28 Mon Sep 17 00:00:00 2001
From: Ramakrishnan Muthukrishnan <ram@rkrishnan.org>
Date: Thu, 17 Oct 2019 15:06:01 +0530
Subject: [PATCH] persistence: WIP of sqlite based persistence
---
PaymentServer.cabal | 1 +
src/PaymentServer/Persistence.hs | 37 ++++++++++++++++++++++++++++++++
2 files changed, 38 insertions(+)
diff --git a/PaymentServer.cabal b/PaymentServer.cabal
index 165887e..2746523 100644
--- a/PaymentServer.cabal
+++ b/PaymentServer.cabal
@@ -35,6 +35,7 @@ library
, text
, containers
, cryptonite
+ , sqlite-simple
default-language: Haskell2010
ghc-options: -Wmissing-import-lists -Wunused-imports
pkgconfig-depends: ristretto
diff --git a/src/PaymentServer/Persistence.hs b/src/PaymentServer/Persistence.hs
index d08f12a..d13414d 100644
--- a/src/PaymentServer/Persistence.hs
+++ b/src/PaymentServer/Persistence.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeSynonymInstances #-}
module PaymentServer.Persistence
( Voucher
, Fingerprint
@@ -21,6 +23,10 @@ import Data.IORef
, modifyIORef
, readIORef
)
+import qualified Database.SQLite.Simple as Sqlite
+import Database.SQLite.Simple.FromRow
+ ( FromRow(fromRow)
+ )
-- | A voucher is a unique identifier which can be associated with a payment.
-- A paid voucher can be redeemed for ZKAPs which can themselves be exchanged
@@ -103,3 +109,34 @@ memory = do
paid <- newIORef mempty
redeemed <- newIORef mempty
return $ Memory paid redeemed
+
+instance VoucherDatabase Sqlite.Connection where
+ -- payForVoucher :: Sqlite.Connection -> Voucher -> IO ()
+ payForVoucher dbConn voucher = do
+ undefined
+ -- redeemVoucher :: Sqlite.Connection -> Voucher -> Fingerprint -> IO (Either RedeemError ())
+ redeemVoucher dbConn voucher fingerprint = do
+ unpaid <- Set.notMember voucher <$> getPaidVouchers dbConn
+ existingFingerprint <- getVoucherFingerprint dbConn voucher
+ case (unpaid, existingFingerprint) of
+ (True, _) ->
+ return $ Left NotPaid
+ (False, []) ->
+ -- TODO: insert voucher and fingerprint into the redeemed table
+ return $ Right ()
+ (False, [fingerprint']) ->
+ if fingerprint == fingerprint' then
+ return $ Right ()
+ else
+ return $ Left AlreadyRedeemed
+
+instance FromRow Fingerprint where
+ fromRow = Sqlite.field
+
+getPaidVouchers :: Sqlite.Connection -> IO (Set.Set Voucher)
+getPaidVouchers dbConn = Set.fromList <$>
+ Sqlite.query_ dbConn "SELECT DISTINCT name FROM vouchers"
+
+getVoucherFingerprint :: Sqlite.Connection -> Voucher -> IO [Fingerprint]
+getVoucherFingerprint dbConn voucher = do
+ Sqlite.query dbConn "SELECT redeemed.fingerprint FROM vouchers INNER JOIN redeemed ON vouchers.id = redeemed.voucher_id AND vouchers.name = ?" (Sqlite.Only voucher)
--
GitLab