diff --git a/src/PaymentServer/Issuer.hs b/src/PaymentServer/Issuer.hs index dfc048d6e27c10655b85a421040f7d7c71361060..a3473b57c7d81044dc8604c8d18bc75979fabadd 100644 --- a/src/PaymentServer/Issuer.hs +++ b/src/PaymentServer/Issuer.hs @@ -19,6 +19,7 @@ import PaymentServer.Ristretto import Data.Text ( Text + , pack ) -- | A private key for signing. @@ -46,13 +47,13 @@ data ChallengeBypass = -- | An issuer accepts a list of blinded tokens and returns signatures of -- those tokens along with proof that it used a particular key to construct -- the signatures. -type Issuer = [BlindedToken] -> IO (Maybe ChallengeBypass) +type Issuer = [BlindedToken] -> (Either Text ChallengeBypass) -- | trivialIssue makes up and returns some nonsense values that satisfy the -- structural requirements but not the semantic ones. trivialIssue :: Issuer trivialIssue tokens = - return . Just $ + Right $ ChallengeBypass "fake-public-key" (replicate (length tokens) "fake-signature") @@ -67,7 +68,5 @@ ristrettoIssue ristrettoIssue signingKey tokens = do let issuance = ristretto signingKey tokens case issuance of - Right (publicKey, tokens, proof) -> return . Just $ ChallengeBypass publicKey tokens proof - Left err -> do - putStrLn . show $ err - return Nothing + Right (publicKey, tokens, proof) -> Right $ ChallengeBypass publicKey tokens proof + Left err -> Left . pack . show $ err diff --git a/src/PaymentServer/Redemption.hs b/src/PaymentServer/Redemption.hs index 4eb5b299c8deaf6fdd022310b4bdeaf9f5a94970..e75cb0f49f2b2456f7f41f6aae9a2c9b8703f2a3 100644 --- a/src/PaymentServer/Redemption.hs +++ b/src/PaymentServer/Redemption.hs @@ -21,6 +21,7 @@ import Control.Monad.IO.Class import Data.Text ( pack ) +import qualified Data.Text.IO as TextIO import Data.Text.Encoding ( encodeUtf8 ) @@ -130,12 +131,13 @@ redeem issue database (Redeem voucher tokens) = do liftIO $ putStrLn "Attempt to double-spend paid voucher" throwError jsonErr400 Right () -> do - result <- liftIO $ issue tokens + let result = issue tokens case result of - Just (ChallengeBypass key signatures proof) -> - return $ Succeeded key signatures proof - Nothing -> + Left reason -> do + liftIO $ TextIO.putStrLn reason throwError jsonErr400 + Right (ChallengeBypass key signatures proof) -> + return $ Succeeded key signatures proof -- | Compute a cryptographic hash (fingerprint) of a list of tokens which can -- be used as an identifier for this exact sequence of tokens.