Skip to content
Snippets Groups Projects
Unverified Commit 76391944 authored by Jean-Paul Calderone's avatar Jean-Paul Calderone Committed by GitHub
Browse files

Merge pull request #34 from PrivateStorageio/33.unpaid-response

Generate recognizable unpaid and double-spend responses
parents 94fcbc6c 5ecdc27f
No related branches found
No related tags found
No related merge requests found
...@@ -8,7 +8,6 @@ ...@@ -8,7 +8,6 @@
module PaymentServer.Redemption module PaymentServer.Redemption
( RedemptionAPI ( RedemptionAPI
, Redeem(Redeem) , Redeem(Redeem)
, Result(Failed, Succeeded)
, redemptionServer , redemptionServer
) where ) where
...@@ -19,7 +18,8 @@ import Control.Monad.IO.Class ...@@ -19,7 +18,8 @@ import Control.Monad.IO.Class
( liftIO ( liftIO
) )
import Data.Text import Data.Text
( pack ( Text
, pack
) )
import qualified Data.Text.IO as TextIO import qualified Data.Text.IO as TextIO
import Data.Text.Encoding import Data.Text.Encoding
...@@ -69,7 +69,9 @@ import PaymentServer.Issuer ...@@ -69,7 +69,9 @@ import PaymentServer.Issuer
) )
data Result 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 | Succeeded PublicKey [Signature] Proof
deriving (Show, Eq) deriving (Show, Eq)
...@@ -87,7 +89,18 @@ instance ToJSON Redeem where ...@@ -87,7 +89,18 @@ instance ToJSON Redeem where
toEncoding = genericToEncoding defaultOptions toEncoding = genericToEncoding defaultOptions
instance ToJSON Result where 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 toJSON (Succeeded key signatures proof) = object
[ "success" .= True [ "success" .= True
, "public-key" .= key , "public-key" .= key
...@@ -103,13 +116,18 @@ instance FromJSON Result where ...@@ -103,13 +116,18 @@ instance FromJSON Result where
<$> v .: "public-key" <$> v .: "public-key"
<*> v .: "signatures" <*> v .: "signatures"
<*> v .: "proof" <*> v .: "proof"
else else do
return Failed 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 type RedemptionAPI = ReqBody '[JSON] Redeem :> Post '[JSON] Result
jsonErr400 = err400 jsonErr400 reason = err400
{ errBody = encode Failed { errBody = encode reason
, errHeaders = [ ("Content-Type", "application/json;charset=utf-8") ] , errHeaders = [ ("Content-Type", "application/json;charset=utf-8") ]
} }
...@@ -125,17 +143,14 @@ redeem issue database (Redeem voucher tokens) = do ...@@ -125,17 +143,14 @@ redeem issue database (Redeem voucher tokens) = do
result <- liftIO $ PaymentServer.Persistence.redeemVoucher database voucher fingerprint result <- liftIO $ PaymentServer.Persistence.redeemVoucher database voucher fingerprint
case result of case result of
Left NotPaid -> do Left NotPaid -> do
liftIO $ putStrLn "Attempt to redeem unpaid voucher" throwError $ jsonErr400 Unpaid
throwError jsonErr400
Left AlreadyRedeemed -> do Left AlreadyRedeemed -> do
liftIO $ putStrLn "Attempt to double-spend paid voucher" throwError $ jsonErr400 DoubleSpend
throwError jsonErr400
Right () -> do Right () -> do
let result = issue tokens let result = issue tokens
case result of case result of
Left reason -> do Left reason -> do
liftIO $ TextIO.putStrLn reason throwError $ jsonErr400 $ OtherFailure reason
throwError jsonErr400
Right (ChallengeBypass key signatures proof) -> Right (ChallengeBypass key signatures proof) ->
return $ Succeeded key signatures proof return $ Succeeded key signatures proof
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment