diff --git a/PaymentServer.cabal b/PaymentServer.cabal index 6359ffb5741e451e2760100e14bb5b664da572ed..b6cd94e9b7bb2c86a72be8778c7f1c385d2ae295 100644 --- a/PaymentServer.cabal +++ b/PaymentServer.cabal @@ -25,6 +25,7 @@ library build-depends: base >= 4.7 && < 5 , optparse-applicative , aeson + , bytestring , servant , servant-server , wai @@ -32,6 +33,7 @@ library , data-default , warp , warp-tls + , stripe-haskell , stripe-core , text , containers diff --git a/src/PaymentServer/Processors/Stripe.hs b/src/PaymentServer/Processors/Stripe.hs index 9a23fcc2bb05694905a7da74383ee2d0bb98493a..a8a595ff2e290b7a1de5b005f07ae2e881c20460 100644 --- a/src/PaymentServer/Processors/Stripe.hs +++ b/src/PaymentServer/Processors/Stripe.hs @@ -14,8 +14,12 @@ import Control.Monad.IO.Class import Control.Monad ( mzero ) +import Data.ByteString + ( ByteString + ) import Data.Text ( Text + , unpack ) import Text.Printf ( printf @@ -52,7 +56,17 @@ import PaymentServer.Persistence ( Voucher , VoucherDatabase(payForVoucher) ) - +import Web.Stripe.Charge + ( createCharge + , Amount(..) + ) +import Web.Stripe.Client + ( StripeConfig(..) + , StripeKey(..) + ) +import Web.Stripe + ( stripe + ) data Acknowledgement = Ok @@ -60,7 +74,7 @@ instance ToJSON Acknowledgement where toJSON Ok = object [] type StripeAPI = WebhookAPI - :<|> ChargeAPI + :<|> ChargesAPI type WebhookAPI = "webhook" :> ReqBody '[JSON] Event :> Post '[JSON] Acknowledgement @@ -71,9 +85,9 @@ getVoucher (MetaData []) = Nothing getVoucher (MetaData (("Voucher", value):xs)) = Just value getVoucher (MetaData (x:xs)) = getVoucher (MetaData xs) -stripeServer :: VoucherDatabase d => d -> Server StripeAPI -stripeServer d = (webhook d) - :<|> (charge d) +stripeServer :: VoucherDatabase d => d -> ByteString -> Server StripeAPI +stripeServer d key = (webhook d) + :<|> (charge d key) -- | Process charge succeeded events webhook :: VoucherDatabase d => d -> Event -> Handler Acknowledgement @@ -101,20 +115,27 @@ webhook d _ = -- | 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 -- in the voucher database. -type ChargeAPI = "charge" :> ReqBody '[JSON] Token :> Post '[JSON] Acknowledgement +type ChargesAPI = "charge" :> ReqBody '[JSON] Charges :> Post '[JSON] Acknowledgement -data Token = Token +data Charges = Charges { token :: Text , voucher :: Voucher + , amount :: Int + , currency :: Text } deriving (Show, Eq) -instance FromJSON Token where - parseJSON (Object v) = Token <$> +instance FromJSON Charges where + parseJSON (Object v) = Charges <$> v .: "token" <*> - v .: "voucher" + v .: "voucher" <*> + v .: "amount" <*> + v .: "currency" parseJSON _ = mzero -charge :: VoucherDatabase d => d -> Token -> Handler Acknowledgement -charge d (Token token voucher) = - -- call the stripe Charge API +charge :: VoucherDatabase d => d -> ByteString -> Charges -> Handler Acknowledgement +charge d key (Charges token voucher amount currency) = do + -- call the stripe Charge API (with token, voucher in metadata, amount, currency etc + -- and if the Charge is okay, then return set the voucher as "paid" in the database. + let config = StripeConfig (StripeKey key) Nothing + result <- liftIO $ stripe config $ createCharge (Amount amount) (read (unpack currency)) return Ok diff --git a/src/PaymentServer/Server.hs b/src/PaymentServer/Server.hs index 973ef126d9d005873016d075dedff5276796e8b9..d8898e0ee462437530da0974a505643e594dd03b 100644 --- a/src/PaymentServer/Server.hs +++ b/src/PaymentServer/Server.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeOperators #-} +{-# LANGUAGE OverloadedStrings #-} -- | This module exposes a Servant-based Network.Wai server for payment -- interactions. @@ -38,7 +39,7 @@ type PaymentServerAPI -- | Create a server which uses the given database. paymentServer :: VoucherDatabase d => Issuer -> d -> Server PaymentServerAPI paymentServer issuer database = - stripeServer database + stripeServer database "test" :<|> redemptionServer issuer database paymentServerAPI :: Proxy PaymentServerAPI diff --git a/stack.yaml b/stack.yaml index c4bc68654c595b44ea24ca113b1b2973e7a3ade7..0af84a35031953cbffd353476578ffa00b37b01f 100644 --- a/stack.yaml +++ b/stack.yaml @@ -39,6 +39,8 @@ packages: # (e.g., acme-missiles-0.3) extra-deps: - "stripe-core-2.5.0" + - "stripe-haskell-2.5.0" + - "stripe-http-client-2.5.0" # Override default flag values for local packages and extra-deps # flags: {}