@@ -13,6 +13,7 @@ import Data.Aeson ((.:))
1313import qualified Data.Aeson as Json
1414import qualified Data.ByteString as BS
1515import qualified Data.ByteString.Builder as B
16+import qualified Data.ByteString.Base64 as Base64
1617import qualified Data.ByteString.Char8 as BSC
1718import qualified Data.ByteString.Lazy as LBS
1819import qualified Data.Text as T
@@ -41,13 +42,17 @@ allowedOrigins =
4142-- GET MANAGER
4243
4344
44−newtype Manager =
45− Manager Http.Manager
45+data Manager =
46+ Manager
47+ { _manager :: Http.Manager
48+ , _authToken :: BS.ByteString
49+ }
4650
4751
48−getManager :: IO Manager
49−getManager =
50− Manager <$> Http.newManager Http.tlsManagerSettings
52+getManager :: String -> IO Manager
53+getManager secret =
54+ do manager <- Http.newManager Http.tlsManagerSettings
55+ return (Manager manager ("Basic " <> Base64.encode (BSC.pack secret)))
5156
5257
5358
@@ -55,7 +60,7 @@ getManager =
5560
5661
5762endpoint :: Manager -> Snap ()
58−endpoint (Manager manager) =
63+endpoint manager =
5964 Cors.allow POST allowedOrigins $
6065 do amount <- requireParameter "amount" toAmount
6166 frequency <- requireParameter "frequency" toFrequency
@@ -102,16 +107,31 @@ newtype StripeCheckoutSession =
102107 StripeCheckoutSession { _id :: T.Text }
103108
104109
105−getStripeCheckoutSessionID :: Http.Manager -> Int -> IO (Maybe StripeCheckoutSession)
106−getStripeCheckoutSessionID manager amount =
110+getStripeCheckoutSessionID :: Manager -> Int -> IO (Maybe StripeCheckoutSession)
111+getStripeCheckoutSessionID (Manager manager authToken) amount =
107112 E.handle handleSomeException $
108113 do req0 <- Http.parseRequest "https://api.stripe.com/v1/checkout/sessions"
109− req1 <- Multi.formDataBody (toOneTimeParts amount) $ req0 { Http.method = Http.methodPost }
114+ req1 <- Multi.formDataBody (toOneTimeParts amount) (configureRequest authToken req0)
110115 Http.withResponse req1 manager $ \response ->
111116 do chunks <- Http.brConsume (Http.responseBody response)
112117 return $ Json.decode $ LBS.fromChunks chunks
113118
114119
120+-- The "Authorization" header is set based on combining these instructions:
121+--
122+-- https://stripe.com/docs/payments/checkout/one-time
123+-- https://stackoverflow.com/a/35442984
124+--
125+-- Setting the -u flag appears to add a base64 encoded "Authorization" header.
126+--
127+configureRequest :: BS.ByteString -> Http.Request -> Http.Request
128+configureRequest authToken req =
129+ req
130+ { Http.method = Http.methodPost
131+ , Http.requestHeaders = ("Authorization", authToken) : Http.requestHeaders req
132+ }
133+
134+
115135toOneTimeParts :: Int -> [Multi.Part]
116136toOneTimeParts amount =
117137 [ Multi.partBS "payment_method_types[]" "card"