diff --git a/PaymentServer.cabal b/PaymentServer.cabal
index 56d7c013c6bb0ec8b54d3506d5d9e0c64ddb7347..5910ce73ba57d00482ba7095a36ddf70fd4cc5bf 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 0000000000000000000000000000000000000000..0f47c47a2807523663269cab63db9183bd2c5f72
--- /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 23dfbc849b6699f61d1be229d85e3f7ae3535766..c2cbe06f077bb5682c7a36139ab82921d0f92330 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)
+ , Issuer
+ )
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
@@ -120,19 +111,23 @@ jsonErr400 = err400
, errHeaders = [ ("Content-Type", "application/json;charset=utf-8") ]
}
-redemptionServer :: VoucherDatabase d => d -> Server RedemptionAPI
+redemptionServer :: VoucherDatabase d => Issuer -> d -> Server RedemptionAPI
redemptionServer = redeem
-- | Handler for redemption requests. Use the database to try to redeem the
-- voucher and return signatures. Return a failure if this is not possible
-- (eg because the voucher was already redeemed).
-redeem :: VoucherDatabase d => d -> Redeem -> Handler Result
-redeem database (Redeem voucher tokens) = do
+redeem :: VoucherDatabase d => Issuer -> d -> Redeem -> Handler Result
+redeem issue database (Redeem voucher tokens) = do
let fingerprint = fingerprintFromTokens tokens
result <- liftIO $ PaymentServer.Persistence.redeemVoucher database voucher fingerprint
case result of
Left err -> throwError jsonErr400
- Right () -> return $ Succeeded "" [] ""
+ Right () ->
+ let
+ (ChallengeBypass key signatures proof) = issue 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/src/PaymentServer/Server.hs b/src/PaymentServer/Server.hs
index f55b779b99f7a3395a02aca78a0f636e358f2542..6eea6abed47c088abf55b9aea4b66bb3658c53c7 100644
--- a/src/PaymentServer/Server.hs
+++ b/src/PaymentServer/Server.hs
@@ -23,6 +23,9 @@ import PaymentServer.Redemption
( RedemptionAPI
, redemptionServer
)
+import PaymentServer.Issuer
+ ( trivialIssue
+ )
import PaymentServer.Persistence
( VoucherDatabase
)
@@ -36,7 +39,7 @@ type PaymentServerAPI
paymentServer :: VoucherDatabase d => d -> Server PaymentServerAPI
paymentServer d =
stripeServer d
- :<|> redemptionServer d
+ :<|> redemptionServer trivialIssue d
paymentServerAPI :: Proxy PaymentServerAPI
paymentServerAPI = Proxy
diff --git a/test/SpecRedemption.hs b/test/SpecRedemption.hs
index e9c05108d596bfc232cb7cf749026960587212db..d75ee75f9f37fbe30db45f91d8b7da6dbc64f1ac 100644
--- a/test/SpecRedemption.hs
+++ b/test/SpecRedemption.hs
@@ -52,9 +52,14 @@ import Util.Spec
import Util.WAI
( postJSON
)
+import PaymentServer.Issuer
+ ( BlindedToken
+ , ChallengeBypass(ChallengeBypass)
+ , Issuer
+ , trivialIssue
+ )
import PaymentServer.Redemption
( RedemptionAPI
- , BlindedToken
, Redeem(Redeem)
, Result(Failed, Succeeded)
, redemptionServer
@@ -69,8 +74,8 @@ import PaymentServer.Persistence
redemptionAPI :: Proxy RedemptionAPI
redemptionAPI = Proxy
-app :: VoucherDatabase d => d -> Application
-app = serve redemptionAPI . redemptionServer
+app :: VoucherDatabase d => Issuer -> d -> Application
+app issue = serve redemptionAPI . redemptionServer issue
path = "/"
@@ -96,7 +101,7 @@ instance VoucherDatabase VoucherDatabaseTestDouble where
spec_redemption :: Spec
spec_redemption = parallel $ do
database <- runIO memory
- with (return . app $ database) $
+ with (return $ app trivialIssue database) $
do
describe (printf "error behavior of POST %s" (show path)) $
do
@@ -124,7 +129,7 @@ spec_redemption = parallel $ do
describe "redemption" $ do
- with (return . app $ RefuseRedemption NotPaid) $
+ with (return $ app trivialIssue (RefuseRedemption NotPaid)) $
it "receives a failure response when the voucher is not paid" $ property $
\(voucher :: Voucher) (tokens :: [BlindedToken]) ->
propertyRedeem path voucher tokens 400
@@ -135,15 +140,18 @@ spec_redemption = parallel $ do
, matchHeaders = ["Content-Type" <:> "application/json;charset=utf-8"]
}
- with (return $ app PermitRedemption) $
+ with (return $ app trivialIssue 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]) ->