From 5ecdc27fe4fc6911d2e71895627d71b10e34ec2f Mon Sep 17 00:00:00 2001
From: Jean-Paul Calderone <exarkun@twistedmatrix.com>
Date: Tue, 19 Nov 2019 13:13:06 -0500
Subject: [PATCH] Generate recognizable unpaid and double-spend responses
---
src/PaymentServer/Redemption.hs | 43 ++++++++++++++++++++++-----------
1 file changed, 29 insertions(+), 14 deletions(-)
diff --git a/src/PaymentServer/Redemption.hs b/src/PaymentServer/Redemption.hs
index e75cb0f..f12b247 100644
--- a/src/PaymentServer/Redemption.hs
+++ b/src/PaymentServer/Redemption.hs
@@ -8,7 +8,6 @@
module PaymentServer.Redemption
( RedemptionAPI
, Redeem(Redeem)
- , Result(Failed, Succeeded)
, redemptionServer
) where
@@ -19,7 +18,8 @@ import Control.Monad.IO.Class
( liftIO
)
import Data.Text
- ( pack
+ ( Text
+ , pack
)
import qualified Data.Text.IO as TextIO
import Data.Text.Encoding
@@ -69,7 +69,9 @@ import PaymentServer.Issuer
)
data Result
- = Failed
+ = Unpaid -- ^ A voucher has not been paid for.
+ | DoubleSpend -- ^ A voucher has already been redeemed.
+ | OtherFailure Text -- ^ Some other unrecognized failure mode.
| Succeeded PublicKey [Signature] Proof
deriving (Show, Eq)
@@ -87,7 +89,18 @@ instance ToJSON Redeem where
toEncoding = genericToEncoding defaultOptions
instance ToJSON Result where
- toJSON Failed = object [ "success" .= False ]
+ toJSON Unpaid = object
+ [ "success" .= False
+ , "reason" .= ("unpaid" :: Text)
+ ]
+ toJSON DoubleSpend = object
+ [ "success" .= False
+ , "reason" .= ("double-spend" :: Text)
+ ]
+ toJSON (OtherFailure description) = object
+ [ "success" .= False
+ , "reason" .= description
+ ]
toJSON (Succeeded key signatures proof) = object
[ "success" .= True
, "public-key" .= key
@@ -103,13 +116,18 @@ instance FromJSON Result where
<$> v .: "public-key"
<*> v .: "signatures"
<*> v .: "proof"
- else
- return Failed
+ else do
+ reason <- v .: "reason"
+ if reason == "unpaid"
+ then return Unpaid
+ else if reason == "double-spend"
+ then return DoubleSpend
+ else return $ OtherFailure reason
type RedemptionAPI = ReqBody '[JSON] Redeem :> Post '[JSON] Result
-jsonErr400 = err400
- { errBody = encode Failed
+jsonErr400 reason = err400
+ { errBody = encode reason
, errHeaders = [ ("Content-Type", "application/json;charset=utf-8") ]
}
@@ -125,17 +143,14 @@ redeem issue database (Redeem voucher tokens) = do
result <- liftIO $ PaymentServer.Persistence.redeemVoucher database voucher fingerprint
case result of
Left NotPaid -> do
- liftIO $ putStrLn "Attempt to redeem unpaid voucher"
- throwError jsonErr400
+ throwError $ jsonErr400 Unpaid
Left AlreadyRedeemed -> do
- liftIO $ putStrLn "Attempt to double-spend paid voucher"
- throwError jsonErr400
+ throwError $ jsonErr400 DoubleSpend
Right () -> do
let result = issue tokens
case result of
Left reason -> do
- liftIO $ TextIO.putStrLn reason
- throwError jsonErr400
+ throwError $ jsonErr400 $ OtherFailure reason
Right (ChallengeBypass key signatures proof) ->
return $ Succeeded key signatures proof
--
GitLab