Get key/signatures/proof values into a result

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

src/PaymentServer/Issuer.hs

+{-# 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"

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.

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]) ->