From 5d92a70e3d3da0f846aef59befea4c880a27f046 Mon Sep 17 00:00:00 2001
From: Jean-Paul Calderone <exarkun@twistedmatrix.com>
Date: Thu, 19 Sep 2019 12:31:22 -0400
Subject: [PATCH] Take `Issuer` out of the IO monad
Also change a Maybe to an Either so we can stop printing an error inside the
ristretto code and just propagate it up to the caller.
---
src/PaymentServer/Issuer.hs | 11 +++++------
src/PaymentServer/Redemption.hs | 10 ++++++----
2 files changed, 11 insertions(+), 10 deletions(-)
diff --git a/src/PaymentServer/Issuer.hs b/src/PaymentServer/Issuer.hs
index dfc048d..a3473b5 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 4eb5b29..e75cb0f 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.
--
GitLab