From 4e01a5433a87c9fc476fbf21ca9c0ae953fc6c47 Mon Sep 17 00:00:00 2001
From: Ramakrishnan Muthukrishnan <ram@leastauthority.com>
Date: Sun, 20 Oct 2019 12:59:44 +0530
Subject: [PATCH] Move the `Database' data type into PaymentServer library
Rename the `Memory' constructor that constructs MemoryVoucherDatabase
into `MemoryDB' to avoid conflict.
---
src/PaymentServer/Main.hs | 8 ++------
src/PaymentServer/Persistence.hs | 14 ++++++++++----
2 files changed, 12 insertions(+), 10 deletions(-)
diff --git a/src/PaymentServer/Main.hs b/src/PaymentServer/Main.hs
index 8c52604..336cd6f 100644
--- a/src/PaymentServer/Main.hs
+++ b/src/PaymentServer/Main.hs
@@ -25,6 +25,7 @@ import Network.Wai.Middleware.RequestLogger
)
import PaymentServer.Persistence
( memory
+ , Database(Memory, SQLite3)
)
import PaymentServer.Issuer
( trivialIssue
@@ -63,11 +64,6 @@ data Issuer =
| Ristretto
deriving (Show, Eq, Ord, Read)
-data Database =
- Memory
- | SQLite3
- deriving (Show, Eq, Ord, Read)
-
data ServerConfig = ServerConfig
{ issuer :: Issuer
, signingKey :: Maybe Text
@@ -91,7 +87,7 @@ sample = ServerConfig
( long "database"
<> help "Which database to use: sqlite3 or memory"
<> showDefault
- <> value Memory )
+ <> value SQLite3 )
<*> optional ( option str
( long "database-path"
<> help "Path to on-disk database (sqlite3 only)"
diff --git a/src/PaymentServer/Persistence.hs b/src/PaymentServer/Persistence.hs
index 3ad0226..81cb74d 100644
--- a/src/PaymentServer/Persistence.hs
+++ b/src/PaymentServer/Persistence.hs
@@ -4,6 +4,7 @@ module PaymentServer.Persistence
( Voucher
, Fingerprint
, RedeemError(NotPaid, AlreadyRedeemed)
+ , Database(Memory, SQLite3)
, VoucherDatabase(payForVoucher, redeemVoucher)
, MemoryVoucherDatabase
, memory
@@ -49,6 +50,11 @@ data RedeemError =
| AlreadyRedeemed
deriving (Show, Eq)
+data Database =
+ Memory
+ | SQLite3
+ deriving (Show, Eq, Ord, Read)
+
-- | A fingerprint cryptographically identifies a redemption of a voucher.
-- When a voucher is redeemed, a number of random tokens are received
-- alongside it. These tokens are signed to create ZKAPs to return to the
@@ -82,7 +88,7 @@ class VoucherDatabase d where
-- even the MemoryVoucherDatabase value). This is primarily useful for
-- testing.
data MemoryVoucherDatabase =
- Memory {
+ MemoryDB {
-- | A set of vouchers which have been paid for.
paid :: IORef (Set.Set Voucher)
-- | A mapping from redeemed vouchers to fingerprints associated with the
@@ -91,11 +97,11 @@ data MemoryVoucherDatabase =
}
instance VoucherDatabase MemoryVoucherDatabase where
- payForVoucher Memory{ paid = paid, redeemed = redeemed } voucher = do
+ payForVoucher MemoryDB{ paid = paid, redeemed = redeemed } voucher = do
modifyIORef paid (Set.insert voucher)
return ()
- redeemVoucher Memory{ paid = paid, redeemed = redeemed } voucher fingerprint = do
+ redeemVoucher MemoryDB{ paid = paid, redeemed = redeemed } voucher fingerprint = do
unpaid <- Set.notMember voucher <$> readIORef paid
existingFingerprint <- Map.lookup voucher <$> readIORef redeemed
case (unpaid, existingFingerprint) of
@@ -115,7 +121,7 @@ memory :: IO MemoryVoucherDatabase
memory = do
paid <- newIORef mempty
redeemed <- newIORef mempty
- return $ Memory paid redeemed
+ return $ MemoryDB paid redeemed
instance VoucherDatabase Sqlite.Connection where
-- payForVoucher :: Sqlite.Connection -> Voucher -> IO ()
--
GitLab