Skip to content
Snippets Groups Projects
Commit 100c8d30 authored by Jean-Paul Calderone's avatar Jean-Paul Calderone
Browse files

Doc improvements

Also, explode the tuple that made its way into `redeemVoucherHelper`
parent 3feebd73
No related branches found
No related tags found
1 merge request!26Initial implementation of Persistence using sqlite
...@@ -99,21 +99,30 @@ instance VoucherDatabase VoucherDatabaseState where ...@@ -99,21 +99,30 @@ instance VoucherDatabase VoucherDatabaseState where
unpaid <- Set.notMember voucher <$> readIORef paid unpaid <- Set.notMember voucher <$> readIORef paid
existingFingerprint <- Map.lookup voucher <$> readIORef redeemed existingFingerprint <- Map.lookup voucher <$> readIORef redeemed
let insertFn = (modifyIORef redeemed .) . Map.insert let insertFn = (modifyIORef redeemed .) . Map.insert
redeemVoucherHelper (unpaid, existingFingerprint) voucher fingerprint insertFn redeemVoucherHelper unpaid existingFingerprint voucher fingerprint insertFn
redeemVoucher SQLiteDB { conn = conn } voucher fingerprint = Sqlite.withExclusiveTransaction conn $ do redeemVoucher SQLiteDB { conn = conn } voucher fingerprint = Sqlite.withExclusiveTransaction conn $ do
unpaid <- isVoucherUnpaid conn voucher unpaid <- isVoucherUnpaid conn voucher
existingFingerprint <- getVoucherFingerprint conn voucher existingFingerprint <- getVoucherFingerprint conn voucher
let insertFn = insertVoucherAndFingerprint conn let insertFn = insertVoucherAndFingerprint conn
redeemVoucherHelper (unpaid, existingFingerprint) voucher fingerprint insertFn redeemVoucherHelper unpaid existingFingerprint voucher fingerprint insertFn
-- | Allow a voucher to be redeemed if it has been paid for and not redeemed
-- before or redeemed with the same fingerprint.
redeemVoucherHelper redeemVoucherHelper
:: (Bool, Maybe Fingerprint) :: Bool -- ^ Has the voucher been paid for?
-> Voucher -> Maybe Fingerprint -- ^ If it has been redeemed before,
-> Fingerprint -- with what fingerprint?
-> (Voucher -> Fingerprint -> IO ()) -> Voucher -- ^ The voucher in question.
-> IO (Either RedeemError ()) -> Fingerprint -- ^ The fingerprint associated with
redeemVoucherHelper (unpaid, existingFingerprint) voucher fingerprint insertFn = -- the new redemption attempt.
-> (Voucher -> Fingerprint -> IO ()) -- ^ A function to mark the voucher
-- as redeemed if this redemption
-- should succeed.
-> IO (Either RedeemError ()) -- ^ Right for successful redemption,
-- left with details about why it
-- failed.
redeemVoucherHelper unpaid existingFingerprint voucher fingerprint insertFn =
case (unpaid, existingFingerprint) of case (unpaid, existingFingerprint) of
(True, _) -> (True, _) ->
return $ Left NotPaid return $ Left NotPaid
...@@ -141,20 +150,25 @@ isVoucherUnpaid :: Sqlite.Connection -> Voucher -> IO Bool ...@@ -141,20 +150,25 @@ isVoucherUnpaid :: Sqlite.Connection -> Voucher -> IO Bool
isVoucherUnpaid dbConn voucher = isVoucherUnpaid dbConn voucher =
null <$> (Sqlite.query dbConn "SELECT 1 FROM vouchers WHERE vouchers.name = ? LIMIT 1" (Sqlite.Only voucher) :: IO [Sqlite.Only Int]) null <$> (Sqlite.query dbConn "SELECT 1 FROM vouchers WHERE vouchers.name = ? LIMIT 1" (Sqlite.Only voucher) :: IO [Sqlite.Only Int])
-- | Retrieve an existing redemption fingerprint for the given voucher, if
-- there is one.
getVoucherFingerprint :: Sqlite.Connection -> Voucher -> IO (Maybe Fingerprint) getVoucherFingerprint :: Sqlite.Connection -> Voucher -> IO (Maybe Fingerprint)
getVoucherFingerprint dbConn voucher = getVoucherFingerprint dbConn voucher =
listToMaybe <$> Sqlite.query dbConn "SELECT redeemed.fingerprint FROM vouchers INNER JOIN redeemed ON vouchers.id = redeemed.voucher_id AND vouchers.name = ?" (Sqlite.Only voucher) listToMaybe <$> Sqlite.query dbConn "SELECT redeemed.fingerprint FROM vouchers INNER JOIN redeemed ON vouchers.id = redeemed.voucher_id AND vouchers.name = ?" (Sqlite.Only voucher)
-- | Mark the given voucher as paid in the database.
insertVoucher :: Sqlite.Connection -> Voucher -> IO () insertVoucher :: Sqlite.Connection -> Voucher -> IO ()
insertVoucher dbConn voucher = insertVoucher dbConn voucher =
Sqlite.execute dbConn "INSERT INTO vouchers (name) VALUES (?)" (Sqlite.Only voucher) Sqlite.execute dbConn "INSERT INTO vouchers (name) VALUES (?)" (Sqlite.Only voucher)
-- | Mark the given voucher as having been redeemed (with the given
-- fingerprint) in the database.
insertVoucherAndFingerprint :: Sqlite.Connection -> Voucher -> Fingerprint -> IO () insertVoucherAndFingerprint :: Sqlite.Connection -> Voucher -> Fingerprint -> IO ()
insertVoucherAndFingerprint dbConn voucher fingerprint = insertVoucherAndFingerprint dbConn voucher fingerprint =
Sqlite.execute dbConn "INSERT INTO redeemed (voucher_id, fingerprint) VALUES ((SELECT id FROM vouchers WHERE name = ?), ?)" (voucher, fingerprint) Sqlite.execute dbConn "INSERT INTO redeemed (voucher_id, fingerprint) VALUES ((SELECT id FROM vouchers WHERE name = ?), ?)" (voucher, fingerprint)
-- | create and open a database with a given `name` and create the `voucher` table -- | Create and open a database with a given `name` and create the `voucher`
-- and `redeemed` table with the provided schema -- table and `redeemed` table with the provided schema.
getDBConnection :: Text -> IO VoucherDatabaseState getDBConnection :: Text -> IO VoucherDatabaseState
getDBConnection path = do getDBConnection path = do
dbConn <- Sqlite.open (unpack path) dbConn <- Sqlite.open (unpack path)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment