diff --git a/PaymentServer.cabal b/PaymentServer.cabal
index 037d14b1b1792d62306ad50d30c28a248a6fa634..165887ef0111186ff8eda3db078cdda6c634fc6d 100644
--- a/PaymentServer.cabal
+++ b/PaymentServer.cabal
@@ -16,12 +16,14 @@ cabal-version: >=1.10
library
hs-source-dirs: src
exposed-modules: PaymentServer.Processors.Stripe
+ , PaymentServer.Ristretto
, PaymentServer.Issuer
, PaymentServer.Persistence
, PaymentServer.Redemption
, PaymentServer.Server
, PaymentServer.Main
build-depends: base >= 4.7 && < 5
+ , optparse-applicative
, aeson
, servant
, servant-server
@@ -45,6 +47,15 @@ executable PaymentServer-exe
, PaymentServer
default-language: Haskell2010
+executable PaymentServer-generate-key
+ hs-source-dirs: generate-key
+ main-is: Main.hs
+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wmissing-import-lists -Wunused-imports
+ build-depends: base
+ , text
+ , PaymentServer
+ default-language: Haskell2010
+
source-repository head
type: git
location: https://github.com/privatestorageio/PaymentServer
diff --git a/generate-key/Main.hs b/generate-key/Main.hs
new file mode 100644
index 0000000000000000000000000000000000000000..723c9aae211ddb03d50bfc218d3cec299cd13e1c
--- /dev/null
+++ b/generate-key/Main.hs
@@ -0,0 +1,19 @@
+-- | Generate a random Ristretto-flavored PrivacyPass signing key.
+module Main
+ ( main
+ ) where
+
+import Prelude hiding
+ ( putStrLn
+ )
+
+import Data.Text.IO
+ ( putStrLn
+ )
+
+import PaymentServer.Ristretto
+ ( randomSigningKey
+ )
+
+main :: IO ()
+main = randomSigningKey >>= putStrLn
diff --git a/nix/PaymentServer.nix b/nix/PaymentServer.nix
new file mode 100644
index 0000000000000000000000000000000000000000..ec9fe4474bab6c9190d1d61dcf1d1a1d0a90b718
--- /dev/null
+++ b/nix/PaymentServer.nix
@@ -0,0 +1,93 @@
+let
+ buildDepError = pkg:
+ builtins.throw ''
+ The Haskell package set does not contain the package: ${pkg} (build dependency).
+
+ If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix.
+ '';
+ sysDepError = pkg:
+ builtins.throw ''
+ The Nixpkgs package set does not contain the package: ${pkg} (system dependency).
+
+ You may need to augment the system package mapping in haskell.nix so that it can be found.
+ '';
+ pkgConfDepError = pkg:
+ builtins.throw ''
+ The pkg-conf packages does not contain the package: ${pkg} (pkg-conf dependency).
+
+ You may need to augment the pkg-conf package mapping in haskell.nix so that it can be found.
+ '';
+ exeDepError = pkg:
+ builtins.throw ''
+ The local executable components do not include the component: ${pkg} (executable dependency).
+ '';
+ legacyExeDepError = pkg:
+ builtins.throw ''
+ The Haskell package set does not contain the package: ${pkg} (executable dependency).
+
+ If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix.
+ '';
+ buildToolDepError = pkg:
+ builtins.throw ''
+ Neither the Haskell package set or the Nixpkgs package set contain the package: ${pkg} (build tool dependency).
+
+ If this is a system dependency:
+ You may need to augment the system package mapping in haskell.nix so that it can be found.
+
+ If this is a Haskell dependency:
+ If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix.
+ '';
+in { system, compiler, flags, pkgs, hsPkgs, pkgconfPkgs, ... }:
+ {
+ flags = {};
+ package = {
+ specVersion = "1.10";
+ identifier = { name = "PaymentServer"; version = "0.1.0.0"; };
+ license = "Apache-2.0";
+ copyright = "2019 Private Storage.io, LLC.";
+ maintainer = "support@privatestorage.io";
+ author = "Jean-Paul Calderone";
+ homepage = "https://github.com/privatestorageio/PaymentServer#readme";
+ url = "";
+ synopsis = "Coordinate entities for the purchase of PrivateStorage.io vouchers.";
+ description = "";
+ buildType = "Simple";
+ };
+ components = {
+ "library" = {
+ depends = [
+ (hsPkgs."base" or (buildDepError "base"))
+ (hsPkgs."optparse-applicative" or (buildDepError "optparse-applicative"))
+ (hsPkgs."aeson" or (buildDepError "aeson"))
+ (hsPkgs."servant" or (buildDepError "servant"))
+ (hsPkgs."servant-server" or (buildDepError "servant-server"))
+ (hsPkgs."wai" or (buildDepError "wai"))
+ (hsPkgs."wai-extra" or (buildDepError "wai-extra"))
+ (hsPkgs."data-default" or (buildDepError "data-default"))
+ (hsPkgs."warp" or (buildDepError "warp"))
+ (hsPkgs."stripe-core" or (buildDepError "stripe-core"))
+ (hsPkgs."text" or (buildDepError "text"))
+ (hsPkgs."containers" or (buildDepError "containers"))
+ (hsPkgs."cryptonite" or (buildDepError "cryptonite"))
+ ];
+ pkgconfig = [
+ (pkgconfPkgs."ristretto" or (pkgConfDepError "ristretto"))
+ ];
+ };
+ exes = {
+ "PaymentServer-exe" = {
+ depends = [
+ (hsPkgs."base" or (buildDepError "base"))
+ (hsPkgs."PaymentServer" or (buildDepError "PaymentServer"))
+ ];
+ };
+ "PaymentServer-generate-key" = {
+ depends = [
+ (hsPkgs."base" or (buildDepError "base"))
+ (hsPkgs."text" or (buildDepError "text"))
+ (hsPkgs."PaymentServer" or (buildDepError "PaymentServer"))
+ ];
+ };
+ };
+ };
+ } // rec { src = (pkgs.lib).mkDefault ../.; }
\ No newline at end of file
diff --git a/nix/README b/nix/README
new file mode 100644
index 0000000000000000000000000000000000000000..d4de15ba9c275f6882e3ed8fe5c597e312c27370
--- /dev/null
+++ b/nix/README
@@ -0,0 +1,8 @@
+This directory contains expressions for packaging PaymentServer on NixOS.
+The contents of this directory are almost entirely automatically generated by stack-to-nix.
+Editing them is probably a bad idea since it will make future automated updates more difficult.
+
+However, I did edit default.nix to replace the master tarball of haskell.nix with a particular revision.
+Read the comment there for details.
+
+See https://github.com/input-output-hk/haskell.nix for details of stack-to-nix.
diff --git a/nix/default.nix b/nix/default.nix
new file mode 100644
index 0000000000000000000000000000000000000000..9605b5b0c6e1a7ab470edbce26fa13aee556cd2b
--- /dev/null
+++ b/nix/default.nix
@@ -0,0 +1,18 @@
+{ pkgs ? import <nixpkgs> {} }:
+
+let
+ # Pin a particular version of haskell.nix. The particular version isn't
+ # special. It's just recent at the time this expression was written and it
+ # is known to work with PaymentServer. It could be bumped if necessary but
+ # this would probably only happen as a result of bumping the resolver in
+ # stack.yaml.
+ haskell = import (builtins.fetchTarball https://github.com/input-output-hk/haskell.nix/archive/0cb32e695d7014908fb01fd7e3d225ea33dbdc98.tar.gz) { inherit pkgs; };
+
+ pkgSet = haskell.mkStackPkgSet {
+ stack-pkgs = import ./pkgs.nix;
+ pkg-def-extras = [];
+ modules = [];
+ };
+
+in
+ pkgSet.config.hsPkgs
diff --git a/nix/pkgs.nix b/nix/pkgs.nix
new file mode 100644
index 0000000000000000000000000000000000000000..26ae4881edad1f52e936df5fe53ff4d23f3ab841
--- /dev/null
+++ b/nix/pkgs.nix
@@ -0,0 +1,9 @@
+{
+ extras = hackage:
+ {
+ packages = ({
+ "stripe-core" = (((hackage.stripe-core)."2.5.0").revisions).default;
+ } // { PaymentServer = ./PaymentServer.nix; }) // {};
+ };
+ resolver = "lts-14.1";
+ }
\ No newline at end of file
diff --git a/src/PaymentServer/Issuer.hs b/src/PaymentServer/Issuer.hs
index 0f47c47a2807523663269cab63db9183bd2c5f72..1041d768d4479b03e45cd69af01fe3fac328d7c2 100644
--- a/src/PaymentServer/Issuer.hs
+++ b/src/PaymentServer/Issuer.hs
@@ -10,13 +10,23 @@ module PaymentServer.Issuer
, ChallengeBypass(ChallengeBypass)
, Issuer
, trivialIssue
+ , ristrettoIssue
) where
+import PaymentServer.Ristretto
+ ( Issuance(Issuance)
+ , ristretto
+ )
+
import Data.Text
( Text
+ , pack
)
--- | A public key corresponding to our private key.
+-- | A private key for signing.
+type SigningKey = Text
+
+-- | A public key corresponding to a SigningKey.
type PublicKey = Text
-- | A cryptographic signature of a blinded token created using our private
@@ -38,13 +48,26 @@ 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] -> 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 =
+ Right $
ChallengeBypass
"fake-public-key"
(replicate (length tokens) "fake-signature")
"fake-proof"
+
+-- | ristrettoIssue uses Ristretto-flavored PrivacyPass (aka
+-- `challenge-bypass-ristretto`) to create token signatures in a
+-- privacy-preserving manner.
+ristrettoIssue
+ :: SigningKey -- ^ The key to provide to the PrivacyPass signer.
+ -> Issuer -- ^ An issuer using the given key.
+ristrettoIssue signingKey tokens = do
+ let issuance = ristretto signingKey tokens
+ case issuance of
+ Right (Issuance publicKey tokens proof) -> Right $ ChallengeBypass publicKey tokens proof
+ Left err -> Left . pack . show $ err
diff --git a/src/PaymentServer/Main.hs b/src/PaymentServer/Main.hs
index 7d9ee2a744eb96d4f977e728298e21da1385742a..8c52604b95aa793cf9f539e9884b19e09c43ad36 100644
--- a/src/PaymentServer/Main.hs
+++ b/src/PaymentServer/Main.hs
@@ -1,8 +1,17 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+
-- | This module implements the main entrypoint to the PaymentServer.
module PaymentServer.Main
( main
) where
+import Text.Printf
+ ( printf
+ )
+import Data.Text
+ ( Text
+ )
import Data.Default
( def
)
@@ -17,13 +26,111 @@ import Network.Wai.Middleware.RequestLogger
import PaymentServer.Persistence
( memory
)
+import PaymentServer.Issuer
+ ( trivialIssue
+ , ristrettoIssue
+ )
import PaymentServer.Server
( paymentServerApp
)
+import Options.Applicative
+ ( Parser
+ , ParserInfo
+ , option
+ , auto
+ , str
+ , optional
+ , long
+ , help
+ , value
+ , showDefault
+ , execParser
+ , info
+ , helper
+ , fullDesc
+ , progDesc
+ , header
+ , (<**>)
+ )
+import System.Exit
+ ( exitFailure
+ )
+import Data.Semigroup ((<>))
+
+data Issuer =
+ Trivial
+ | Ristretto
+ deriving (Show, Eq, Ord, Read)
+
+data Database =
+ Memory
+ | SQLite3
+ deriving (Show, Eq, Ord, Read)
+
+data ServerConfig = ServerConfig
+ { issuer :: Issuer
+ , signingKey :: Maybe Text
+ , database :: Database
+ , databasePath :: Maybe Text
+ }
+ deriving (Show, Eq)
+
+sample :: Parser ServerConfig
+sample = ServerConfig
+ <$> option auto
+ ( long "issuer"
+ <> help "Which issuer to use: trivial or ristretto"
+ <> showDefault
+ <> value Trivial )
+ <*> optional (option str
+ ( long "signing-key"
+ <> help "The base64 encoded signing key (ristretto only)"
+ <> showDefault ) )
+ <*> option auto
+ ( long "database"
+ <> help "Which database to use: sqlite3 or memory"
+ <> showDefault
+ <> value Memory )
+ <*> optional ( option str
+ ( long "database-path"
+ <> help "Path to on-disk database (sqlite3 only)"
+ <> showDefault ) )
+
+opts :: ParserInfo ServerConfig
+opts = info (sample <**> helper)
+ ( fullDesc
+ <> progDesc ""
+ <> header ""
+ )
+
main :: IO ()
-main = do
- db <- memory
- let app = paymentServerApp db
- logger <- mkRequestLogger $ def { outputFormat = Detailed True}
- run 8081 $ logger app
+main =
+ let
+ getIssuer ServerConfig{ issuer, signingKey } =
+ case (issuer, signingKey) of
+ (Trivial, Nothing) -> Right trivialIssue
+ (Ristretto, Just key) -> Right $ ristrettoIssue key
+ _ -> Left "invalid options"
+ getDatabase ServerConfig{ database, databasePath } =
+ case (database, databasePath) of
+ (Memory, Nothing) -> Right memory
+ _ -> Left "invalid options"
+ in do
+ config <- execParser opts
+ case getIssuer config of
+ Left err -> do
+ print err
+ exitFailure
+ Right issuer ->
+ case getDatabase config of
+ Left err ->do
+ print err
+ exitFailure
+ Right getDB -> do
+ db <- getDB
+ let port = 8081
+ let app = paymentServerApp issuer db
+ logger <- mkRequestLogger (def { outputFormat = Detailed True})
+ putStrLn (printf "Listening on %d" port :: String)
+ run port $ logger app
diff --git a/src/PaymentServer/Redemption.hs b/src/PaymentServer/Redemption.hs
index c2cbe06f077bb5682c7a36139ab82921d0f92330..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
)
@@ -54,6 +55,7 @@ import Crypto.Hash
)
import PaymentServer.Persistence
( VoucherDatabase(redeemVoucher)
+ , RedeemError(NotPaid, AlreadyRedeemed)
, Fingerprint
, Voucher
)
@@ -122,12 +124,20 @@ 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 () ->
- let
- (ChallengeBypass key signatures proof) = issue tokens
- in
- return $ Succeeded key signatures proof
+ Left NotPaid -> do
+ liftIO $ putStrLn "Attempt to redeem unpaid voucher"
+ throwError jsonErr400
+ Left AlreadyRedeemed -> do
+ liftIO $ putStrLn "Attempt to double-spend paid voucher"
+ throwError jsonErr400
+ Right () -> do
+ let result = issue tokens
+ case result of
+ 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.
diff --git a/src/PaymentServer/Ristretto.hs b/src/PaymentServer/Ristretto.hs
new file mode 100644
index 0000000000000000000000000000000000000000..a2968331eb42368772901ade53344f447ff7b84b
--- /dev/null
+++ b/src/PaymentServer/Ristretto.hs
@@ -0,0 +1,163 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE EmptyDataDecls #-}
+
+module PaymentServer.Ristretto
+ ( Issuance(Issuance)
+ , randomSigningKey
+ , ristretto
+ ) where
+
+import Control.Exception
+ ( bracket
+ , assert
+ )
+import System.IO.Unsafe
+ ( unsafePerformIO
+ )
+import Data.Text
+ ( Text
+ , unpack
+ , pack
+ )
+
+import Foreign.Ptr
+ ( Ptr
+ , nullPtr
+ )
+import Foreign.C.String
+ ( CString
+ , withCString
+ , newCString
+ , peekCString
+ )
+import Foreign.Marshal.Alloc
+ ( free
+ )
+import Foreign.Marshal.Array
+ ( withArray
+ )
+
+data C_BlindedToken
+data C_SignedToken
+data C_SigningKey
+data C_PublicKey
+data C_BatchDLEQProof
+
+foreign import ccall "blinded_token_decode_base64" blinded_token_decode_base64 :: CString -> IO (Ptr C_BlindedToken)
+foreign import ccall "blinded_token_destroy" blinded_token_destroy :: Ptr C_BlindedToken -> IO ()
+
+foreign import ccall "public_key_encode_base64" public_key_encode_base64 :: Ptr C_PublicKey -> IO CString
+
+foreign import ccall "signing_key_random" signing_key_random :: IO (Ptr C_SigningKey)
+foreign import ccall "signing_key_decode_base64" signing_key_decode_base64 :: CString -> IO (Ptr C_SigningKey)
+foreign import ccall "signing_key_encode_base64" signing_key_encode_base64 :: Ptr C_SigningKey -> IO CString
+foreign import ccall "signing_key_destroy" signing_key_destroy :: Ptr C_SigningKey -> IO ()
+foreign import ccall "signing_key_get_public_key" signing_key_get_public_key :: Ptr C_SigningKey -> IO (Ptr C_PublicKey)
+foreign import ccall "signing_key_sign" signing_key_sign :: Ptr C_SigningKey -> Ptr C_BlindedToken -> IO (Ptr C_SignedToken)
+
+foreign import ccall "signed_token_encode_base64" signed_token_encode_base64 :: Ptr C_SignedToken -> IO CString
+
+foreign import ccall "batch_dleq_proof_new" batch_dleq_proof_new :: Ptr (Ptr C_BlindedToken) -> Ptr (Ptr C_SignedToken) -> Int -> Ptr C_SigningKey -> IO (Ptr C_BatchDLEQProof)
+foreign import ccall "batch_dleq_proof_encode_base64" batch_dleq_proof_encode_base64 :: Ptr C_BatchDLEQProof -> IO CString
+foreign import ccall "batch_dleq_proof_destroy" batch_dleq_proof_destroy :: Ptr C_BatchDLEQProof -> IO ()
+
+-- | Private type to represent the return value of ristretto.
+data Issuance =
+ Issuance
+ { publicKey :: Text -- ^ The base64-encoded public key corresponding to the
+ -- signing key which generated the signatures.
+ , signatures :: [Text] -- ^ A list of base64-encoded token signatures.
+ , proof :: Text -- ^ The base64-encoded batch DLEQ proof that the signatures
+ -- were made with the signing key corresponding to the public
+ -- key.
+ }
+
+data RistrettoFailure
+ = SigningKeyAllocation
+ | SigningKeyDecoding
+ | BlindedTokenAllocation
+ | BlindedTokenDecoding
+ | SignedTokenAllocation
+ | TokenSigning
+ | SignedTokenEncoding
+ | ProofCreation
+ | SignedTokenPeek
+ | PublicKeyLookup
+ | PublicKeyEncoding
+ deriving (Show, Eq)
+
+ristretto
+ :: Text -- ^ The base64 encoded signing key.
+ -> [Text] -- ^ A list of the base64 blinded tokens.
+ -> Either RistrettoFailure Issuance -- ^ Left for an error, otherwise
+ -- Right with the ristretto results
+ristretto textSigningKey textTokens =
+ let
+ newProof blindedTokens signedTokens signingKey =
+ withArray blindedTokens $ \cBlindedTokensArray ->
+ withArray signedTokens $ \cSignedTokensArray ->
+ batch_dleq_proof_new cBlindedTokensArray cSignedTokensArray (length blindedTokens) signingKey
+
+ newEncodedProof blindedTokens signedTokens signingKey =
+ bracket (newProof blindedTokens signedTokens signingKey) batch_dleq_proof_destroy $ \proof ->
+ bracket (batch_dleq_proof_encode_base64 proof) free peekCString
+
+ stringSigningKey = unpack textSigningKey
+ stringTokens = map unpack textTokens
+
+ extractKeyMaterial :: String -> IO (Either RistrettoFailure (Ptr C_SigningKey, Ptr C_PublicKey))
+ extractKeyMaterial stringSigningKey = do
+ cStringSigningKey <- newCString stringSigningKey
+ if cStringSigningKey == nullPtr
+ then return $ Left SigningKeyAllocation
+ else do
+ signingKey <- signing_key_decode_base64 cStringSigningKey
+ if signingKey == nullPtr
+ then return $ Left SigningKeyDecoding
+ else do
+ publicKey <- signing_key_get_public_key signingKey
+ if publicKey == nullPtr
+ then return $ Left PublicKeyLookup
+ else return $ Right (signingKey, publicKey)
+ in
+ unsafePerformIO $ do
+ keys <- extractKeyMaterial stringSigningKey
+ case keys of
+ Left err -> return $ Left err
+ Right (signingKey, publicKey) -> do
+ cStringEncodedPublicKey <- public_key_encode_base64 publicKey
+ if cStringEncodedPublicKey == nullPtr
+ then return $ Left PublicKeyEncoding
+ else do
+ encodedPublicKey <- peekCString cStringEncodedPublicKey
+ cStringTokens <- mapM newCString stringTokens
+ if nullPtr `elem` cStringTokens
+ then return $ Left BlindedTokenAllocation
+ else do
+ blindedTokens <- mapM blinded_token_decode_base64 cStringTokens
+ if nullPtr `elem` blindedTokens
+ then return $ Left BlindedTokenDecoding
+ else do
+ signedTokens <- mapM (signing_key_sign signingKey) blindedTokens
+ if nullPtr `elem` signedTokens
+ then return $ Left TokenSigning
+ else do
+ encodedCStringSignedTokens <- mapM signed_token_encode_base64 signedTokens
+ if nullPtr `elem` encodedCStringSignedTokens
+ then return $ Left SignedTokenEncoding
+ else do
+ encodedSignedTokens <- mapM peekCString encodedCStringSignedTokens
+ encodedProof <- newEncodedProof blindedTokens signedTokens signingKey
+ return . Right $ Issuance (pack encodedPublicKey) (map pack encodedSignedTokens) (pack encodedProof)
+
+
+-- | randomSigningKey generates a new signing key at random and returns it
+-- encoded as a base64 string.
+randomSigningKey :: IO Text
+randomSigningKey = do
+ cSigningKey <- signing_key_random
+ cString <- signing_key_encode_base64 cSigningKey
+ signing_key_destroy cSigningKey
+ result <- peekCString cString
+ free cString
+ return $ pack result
diff --git a/src/PaymentServer/Server.hs b/src/PaymentServer/Server.hs
index 6eea6abed47c088abf55b9aea4b66bb3658c53c7..973ef126d9d005873016d075dedff5276796e8b9 100644
--- a/src/PaymentServer/Server.hs
+++ b/src/PaymentServer/Server.hs
@@ -24,7 +24,7 @@ import PaymentServer.Redemption
, redemptionServer
)
import PaymentServer.Issuer
- ( trivialIssue
+ ( Issuer
)
import PaymentServer.Persistence
( VoucherDatabase
@@ -36,15 +36,15 @@ type PaymentServerAPI
:<|> "v1" :> "redeem" :> RedemptionAPI
-- | Create a server which uses the given database.
-paymentServer :: VoucherDatabase d => d -> Server PaymentServerAPI
-paymentServer d =
- stripeServer d
- :<|> redemptionServer trivialIssue d
+paymentServer :: VoucherDatabase d => Issuer -> d -> Server PaymentServerAPI
+paymentServer issuer database =
+ stripeServer database
+ :<|> redemptionServer issuer database
paymentServerAPI :: Proxy PaymentServerAPI
paymentServerAPI = Proxy
-- | Create a Servant Application which serves the payment server API using
-- the given database.
-paymentServerApp :: VoucherDatabase d => d -> Application
-paymentServerApp = serve paymentServerAPI . paymentServer
+paymentServerApp :: VoucherDatabase d => Issuer -> d -> Application
+paymentServerApp issuer = serve paymentServerAPI . paymentServer issuer