From 1bb8b935658929d377859404d04c0b2db50f5c4b Mon Sep 17 00:00:00 2001
From: Jean-Paul Calderone <exarkun@twistedmatrix.com>
Date: Thu, 5 Sep 2019 10:52:42 -0400
Subject: [PATCH] Get key/signatures/proof values into a result
---
PaymentServer.cabal | 1 +
src/PaymentServer/Issuer.hs | 50 +++++++++++++++++++++++++++++++++
src/PaymentServer/Redemption.hs | 33 +++++++++-------------
test/SpecRedemption.hs | 21 +++++++++-----
4 files changed, 79 insertions(+), 26 deletions(-)
create mode 100644 src/PaymentServer/Issuer.hs
diff --git a/PaymentServer.cabal b/PaymentServer.cabal
index 56d7c01..5910ce7 100644
--- a/PaymentServer.cabal
+++ b/PaymentServer.cabal
@@ -16,6 +16,7 @@ cabal-version: >=1.10
library
hs-source-dirs: src
exposed-modules: PaymentServer.Processors.Stripe
+ , PaymentServer.Issuer
, PaymentServer.Persistence
, PaymentServer.Redemption
, PaymentServer.Server
diff --git a/src/PaymentServer/Issuer.hs b/src/PaymentServer/Issuer.hs
new file mode 100644
index 0000000..0f47c47
--- /dev/null
+++ b/src/PaymentServer/Issuer.hs
@@ -0,0 +1,50 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+-- | This module can issue signatures of blinded tokens which can be used to
+-- construct passes.
+module PaymentServer.Issuer
+ ( PublicKey
+ , Signature
+ , BlindedToken
+ , Proof
+ , ChallengeBypass(ChallengeBypass)
+ , Issuer
+ , trivialIssue
+ ) where
+
+import Data.Text
+ ( Text
+ )
+
+-- | A public key corresponding to our private key.
+type PublicKey = Text
+
+-- | A cryptographic signature of a blinded token created using our private
+-- key.
+type Signature = Text
+
+-- | This is the blinded token for which we create signatures.
+type BlindedToken = Text
+
+-- | A zero-knowledge proof that signatures were created of the corresponding
+-- blinded tokens using the corresponding public key's private key.
+type Proof = Text
+
+-- | This bundles up all of the values needed to verify the privacy-respecting
+-- operation of the issuer and then construct passes.
+data ChallengeBypass =
+ ChallengeBypass PublicKey [Signature] Proof
+
+-- | 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] -> ChallengeBypass
+
+-- | trivialIssue makes up and returns some nonsense values that satisfy the
+-- structural requirements but not the semantic ones.
+trivialIssue :: Issuer
+trivialIssue tokens =
+ ChallengeBypass
+ "fake-public-key"
+ (replicate (length tokens) "fake-signature")
+ "fake-proof"
diff --git a/src/PaymentServer/Redemption.hs b/src/PaymentServer/Redemption.hs
index 23dfbc8..96dcdaf 100644
--- a/src/PaymentServer/Redemption.hs
+++ b/src/PaymentServer/Redemption.hs
@@ -7,7 +7,6 @@
-- signatures.
module PaymentServer.Redemption
( RedemptionAPI
- , BlindedToken
, Redeem(Redeem)
, Result(Failed, Succeeded)
, redemptionServer
@@ -20,8 +19,7 @@ import Control.Monad.IO.Class
( liftIO
)
import Data.Text
- ( Text
- , pack
+ ( pack
)
import Data.Text.Encoding
( encodeUtf8
@@ -59,27 +57,20 @@ import PaymentServer.Persistence
, Fingerprint
, Voucher
)
-
--- | A cryptographic signature of a blinded token created using our private
--- key.
-type Signature = Text
-
--- | A public key corresponding to our private key.
-type PublicKey = Text
-
--- | A zero-knowledge proof that signatures were created of the corresponding
--- blinded tokens using the corresponding public key's private key.
-type Proof = Text
+import PaymentServer.Issuer
+ ( Signature
+ , PublicKey
+ , Proof
+ , BlindedToken
+ , ChallengeBypass(ChallengeBypass)
+ , trivialIssue
+ )
data Result
= Failed
| Succeeded PublicKey [Signature] Proof
deriving (Show, Eq)
--- | A blinded token is presented along with a voucher to be signed and the
--- signatures returned to the caller.
-type BlindedToken = Text
-
-- | A complete redemption attempt which can be presented at the redemption
-- endpoint.
data Redeem
@@ -132,7 +123,11 @@ redeem database (Redeem voucher tokens) = do
result <- liftIO $ PaymentServer.Persistence.redeemVoucher database voucher fingerprint
case result of
Left err -> throwError jsonErr400
- Right () -> return $ Succeeded "" [] ""
+ Right () ->
+ let
+ (ChallengeBypass key signatures proof) = trivialIssue tokens
+ in
+ 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.
diff --git a/test/SpecRedemption.hs b/test/SpecRedemption.hs
index e9c0510..1017fa1 100644
--- a/test/SpecRedemption.hs
+++ b/test/SpecRedemption.hs
@@ -52,9 +52,13 @@ import Util.Spec
import Util.WAI
( postJSON
)
+import PaymentServer.Issuer
+ ( BlindedToken
+ , ChallengeBypass(ChallengeBypass)
+ , trivialIssue
+ )
import PaymentServer.Redemption
( RedemptionAPI
- , BlindedToken
, Redeem(Redeem)
, Result(Failed, Succeeded)
, redemptionServer
@@ -138,12 +142,15 @@ spec_redemption = parallel $ do
with (return $ app PermitRedemption) $
it "receive a success response when redemption succeeds" $ property $
\(voucher :: Voucher) (tokens :: [BlindedToken]) ->
- propertyRedeem path voucher tokens 200
- -- TODO: Get some real crypto involved to be able to replace these
- -- dummy values.
- { matchBody = matchJSONBody $ Succeeded "" [] ""
- , matchHeaders = ["Content-Type" <:> "application/json;charset=utf-8"]
- }
+ let
+ (ChallengeBypass key signatures proof) = trivialIssue tokens
+ in
+ propertyRedeem path voucher tokens 200
+ -- TODO: Get some real crypto involved to be able to replace these
+ -- dummy values.
+ { matchBody = matchJSONBody $ Succeeded key signatures proof
+ , matchHeaders = ["Content-Type" <:> "application/json;charset=utf-8"]
+ }
-- it "receive 200 (OK) when the voucher is paid and previously redeemed with the same tokens" $
-- property $ \(voucher :: Voucher) (tokens :: [BlindedToken]) ->
--
GitLab