From 7e81985ee21a208cd79b35f81bed9f87e08c75a9 Mon Sep 17 00:00:00 2001
From: Jean-Paul Calderone <exarkun@twistedmatrix.com>
Date: Tue, 26 Nov 2019 14:22:39 -0500
Subject: [PATCH] Command line options to configure Stripe API endpoint
---
src/PaymentServer/Main.hs | 60 ++++++++++++++++++++++----
src/PaymentServer/Processors/Stripe.hs | 14 +++---
src/PaymentServer/Server.hs | 18 +++++---
3 files changed, 67 insertions(+), 25 deletions(-)
diff --git a/src/PaymentServer/Main.hs b/src/PaymentServer/Main.hs
index 07c3521..65afc14 100644
--- a/src/PaymentServer/Main.hs
+++ b/src/PaymentServer/Main.hs
@@ -18,6 +18,9 @@ import Data.Maybe
import Data.Text
( Text
)
+import Data.ByteString
+ ( ByteString
+ )
import Data.Default
( def
)
@@ -50,6 +53,14 @@ import Network.Wai.Middleware.RequestLogger
, outputFormat
, mkRequestLogger
)
+
+import Web.Stripe.Client
+ ( Protocol(HTTPS)
+ , StripeConfig(StripeConfig)
+ , StripeKey(StripeKey)
+ )
+import qualified Web.Stripe.Client as Stripe
+
import PaymentServer.Persistence
( memory
, getDBConnection
@@ -103,13 +114,16 @@ data Database =
deriving (Show, Eq, Ord, Read)
data ServerConfig = ServerConfig
- { issuer :: Issuer
- , signingKeyPath :: Maybe FilePath
- , database :: Database
- , databasePath :: Maybe Text
- , endpoint :: Endpoint
- , stripeKeyPath :: FilePath
- , corsOrigins :: [Origin]
+ { issuer :: Issuer
+ , signingKeyPath :: Maybe FilePath
+ , database :: Database
+ , databasePath :: Maybe Text
+ , endpoint :: Endpoint
+ , stripeKeyPath :: FilePath
+ , stripeEndpointUrl :: ByteString
+ , stripeEndpointProtocol :: Protocol
+ , stripeEndpointPort :: Int
+ , corsOrigins :: [Origin]
}
deriving (Show, Eq)
@@ -182,6 +196,21 @@ sample = ServerConfig
<*> option str
( long "stripe-key-path"
<> help "Path to Stripe Secret key" )
+ <*> option str
+ ( long "stripe-endpoint-url"
+ <> help "The root endpoint of the Stripe HTTP API"
+ <> value "api.stripe.com"
+ <> showDefault )
+ <*> option auto
+ ( long "stripe-endpoint-protocol"
+ <> help "The Stripe HTTP API protocol (HTTP or HTTPS)."
+ <> value HTTPS
+ <> showDefault )
+ <*> option auto
+ ( long "stripe-endpoint-port"
+ <> help "The Stripe HTTP API endpoint port number."
+ <> value 443
+ <> showDefault )
<*> many ( option str
( long "cors-origin"
<> help "An allowed `Origin` for the purposes of CORS (zero or more)." ) )
@@ -252,6 +281,19 @@ getApp config =
(Memory, Nothing) -> Right memory
(SQLite3, Just path) -> Right (getDBConnection path)
_ -> Left "invalid options"
+
+ stripeConfig ServerConfig
+ { stripeKeyPath
+ , stripeEndpointUrl
+ , stripeEndpointProtocol
+ , stripeEndpointPort
+ } =
+ do
+ key <- B.readFile stripeKeyPath
+ return $
+ StripeConfig
+ (StripeKey key)
+ (Just $ Stripe.Endpoint stripeEndpointUrl stripeEndpointProtocol stripeEndpointPort)
in do
issuer <- getIssuer config
case issuer of
@@ -265,9 +307,9 @@ getApp config =
exitFailure
Right getDB -> do
db <- getDB
- key <- B.readFile (stripeKeyPath config)
+ stripeConfig' <- stripeConfig config
let
origins = corsOrigins config
- app = paymentServerApp origins key issuer db
+ app = paymentServerApp origins stripeConfig' issuer db
logger <- mkRequestLogger (def { outputFormat = Detailed True})
return $ logger app
diff --git a/src/PaymentServer/Processors/Stripe.hs b/src/PaymentServer/Processors/Stripe.hs
index 25a63fe..2c80548 100644
--- a/src/PaymentServer/Processors/Stripe.hs
+++ b/src/PaymentServer/Processors/Stripe.hs
@@ -6,7 +6,6 @@ module PaymentServer.Processors.Stripe
( StripeAPI
, stripeServer
, getVoucher
- , StripeSecretKey
) where
import Control.Monad.IO.Class
@@ -87,8 +86,6 @@ import PaymentServer.Persistence
, PaymentError(AlreadyPaid, PaymentFailed)
)
-type StripeSecretKey = ByteString
-
data Acknowledgement = Ok
instance ToJSON Acknowledgement where
@@ -105,8 +102,8 @@ getVoucher (MetaData []) = Nothing
getVoucher (MetaData (("Voucher", value):xs)) = Just value
getVoucher (MetaData (x:xs)) = getVoucher (MetaData xs)
-stripeServer :: VoucherDatabase d => StripeSecretKey -> d -> Server StripeAPI
-stripeServer key d = charge d key
+stripeServer :: VoucherDatabase d => StripeConfig -> d -> Server StripeAPI
+stripeServer stripeConfig d = charge d stripeConfig
-- | Browser facing API that takes token, voucher and a few other information
-- and calls stripe charges API. If payment succeeds, then the voucher is stored
@@ -132,8 +129,8 @@ instance FromJSON Charges where
-- | call the stripe Charge API (with token, voucher in metadata, amount, currency etc
-- and if the Charge is okay, then set the voucher as "paid" in the database.
-charge :: VoucherDatabase d => d -> StripeSecretKey -> Charges -> Handler Acknowledgement
-charge d key (Charges token voucher amount currency) = do
+charge :: VoucherDatabase d => d -> StripeConfig -> Charges -> Handler Acknowledgement
+charge d stripeConfig (Charges token voucher amount currency) = do
currency' <- getCurrency currency
result <- liftIO (try (payForVoucher d voucher (completeStripeCharge currency')))
case result of
@@ -150,10 +147,9 @@ charge d key (Charges token voucher amount currency) = do
Just currency' -> return currency'
Nothing -> throwError unsupportedCurrency
- config = StripeConfig (StripeKey key) Nothing
tokenId = TokenId token
completeStripeCharge currency' = do
- result <- stripe config $
+ result <- stripe stripeConfig $
createCharge (Amount amount) currency'
-&- tokenId
-&- MetaData [("Voucher", voucher)]
diff --git a/src/PaymentServer/Server.hs b/src/PaymentServer/Server.hs
index ee07b2c..a789f38 100644
--- a/src/PaymentServer/Server.hs
+++ b/src/PaymentServer/Server.hs
@@ -22,9 +22,13 @@ import Servant
, (:>)
, (:<|>)((:<|>))
)
+
+import Web.Stripe.Client
+ ( StripeConfig
+ )
+
import PaymentServer.Processors.Stripe
( StripeAPI
- , StripeSecretKey
, stripeServer
)
import PaymentServer.Redemption
@@ -44,9 +48,9 @@ type PaymentServerAPI
:<|> "v1" :> "redeem" :> RedemptionAPI
-- | Create a server which uses the given database.
-paymentServer :: VoucherDatabase d => StripeSecretKey -> Issuer -> d -> Server PaymentServerAPI
-paymentServer key issuer database =
- stripeServer key database
+paymentServer :: VoucherDatabase d => StripeConfig -> Issuer -> d -> Server PaymentServerAPI
+paymentServer stripeConfig issuer database =
+ stripeServer stripeConfig database
:<|> redemptionServer issuer database
paymentServerAPI :: Proxy PaymentServerAPI
@@ -57,13 +61,13 @@ paymentServerAPI = Proxy
paymentServerApp
:: VoucherDatabase d
=> [Origin] -- ^ A list of CORS Origins to accept.
- -> StripeSecretKey
+ -> StripeConfig
-> Issuer
-> d
-> Application
-paymentServerApp corsOrigins key issuer =
+paymentServerApp corsOrigins stripeConfig issuer =
let
- app = serve paymentServerAPI . paymentServer key issuer
+ app = serve paymentServerAPI . paymentServer stripeConfig issuer
withCredentials = False
corsResourcePolicy = simpleCorsResourcePolicy
{ corsOrigins = Just (corsOrigins, withCredentials)
--
GitLab