Merge pull request #42 from PrivateStorageio/configurable-stripe-endpoint

Configurable stripe endpoint

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-domain"
+    <> help "The domain name for the Stripe API HTTP endpoint."
+    <> value "api.stripe.com"
+    <> showDefault )
+  <*> option auto
+  ( long "stripe-endpoint-scheme"
+    <> 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

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,15 +147,17 @@ 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)]
         case result of
-          Left StripeError {} -> throwIO PaymentFailed
+          Left err -> do
+            print "Stripe createCharge failed:"
+            print err
+            throwIO PaymentFailed
           Right result -> return result
 
       checkVoucherMetadata :: MetaData -> Handler Acknowledgement

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)