add code for loading in secret

Author: evancz

worker/elm.cabal

@@ -174,6 +174,7 @@ Executable worker
         ansi-terminal >= 0.8 && < 0.9,
         ansi-wl-pprint >= 0.6.8 && < 0.7,
         base >=4.11 && <5,
+        base64-bytestring,
         binary >= 0.8 && < 0.9,
         bytestring >= 0.9 && < 0.11,
         containers >= 0.5.8.2 && < 0.6,

worker/src/Endpoint/Donate.hs

@@ -13,6 +13,7 @@ import Data.Aeson ((.:))
 import qualified Data.Aeson as Json
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Builder as B
+import qualified Data.ByteString.Base64 as Base64
 import qualified Data.ByteString.Char8 as BSC
 import qualified Data.ByteString.Lazy as LBS
 import qualified Data.Text as T
@@ -41,21 +42,25 @@ allowedOrigins =
 -- GET MANAGER
 
 
-newtype Manager =
-  Manager Http.Manager
+data Manager =
+  Manager
+    { _manager :: Http.Manager
+    , _authToken :: BS.ByteString
+    }
 
 
-getManager :: IO Manager
-getManager =
-  Manager <$> Http.newManager Http.tlsManagerSettings
+getManager :: String -> IO Manager
+getManager secret =
+  do  manager <- Http.newManager Http.tlsManagerSettings
+      return (Manager manager ("Basic " <> Base64.encode (BSC.pack secret)))
 
 
 
 -- ENDPOINT
 
 
 endpoint :: Manager -> Snap ()
-endpoint (Manager manager) =
+endpoint manager =
   Cors.allow POST allowedOrigins $
     do  amount <- requireParameter "amount" toAmount
         frequency <- requireParameter "frequency" toFrequency
@@ -102,16 +107,31 @@ newtype StripeCheckoutSession =
   StripeCheckoutSession { _id :: T.Text }
 
 
-getStripeCheckoutSessionID :: Http.Manager -> Int -> IO (Maybe StripeCheckoutSession)
-getStripeCheckoutSessionID manager amount =
+getStripeCheckoutSessionID :: Manager -> Int -> IO (Maybe StripeCheckoutSession)
+getStripeCheckoutSessionID (Manager manager authToken) amount =
   E.handle handleSomeException $
   do  req0 <- Http.parseRequest "https://api.stripe.com/v1/checkout/sessions"
-      req1 <- Multi.formDataBody (toOneTimeParts amount) $ req0 { Http.method = Http.methodPost }
+      req1 <- Multi.formDataBody (toOneTimeParts amount) (configureRequest authToken req0)
       Http.withResponse req1 manager $ \response ->
         do  chunks <- Http.brConsume (Http.responseBody response)
             return $ Json.decode $ LBS.fromChunks chunks
 
 
+-- The "Authorization" header is set based on combining these instructions:
+--
+--   https://stripe.com/docs/payments/checkout/one-time
+--   https://stackoverflow.com/a/35442984
+--
+-- Setting the -u flag appears to add a base64 encoded "Authorization" header.
+--
+configureRequest :: BS.ByteString -> Http.Request -> Http.Request
+configureRequest authToken req =
+  req
+    { Http.method = Http.methodPost
+    , Http.requestHeaders = ("Authorization", authToken) : Http.requestHeaders req
+    }
+
+
 toOneTimeParts :: Int -> [Multi.Part]
 toOneTimeParts amount =
   [ Multi.partBS "payment_method_types[]" "card"

worker/src/Main.hs

@@ -10,6 +10,9 @@ import Control.Monad (msum)
 import qualified Data.ByteString as BS
 import Snap.Core
 import Snap.Http.Server
+import qualified System.Environment as Env
+import qualified System.Exit as Exit
+import qualified System.IO as IO
 
 import qualified Artifacts
 import qualified Cors
@@ -27,7 +30,7 @@ main =
   do  rArtifacts <- Artifacts.loadRepl
       cArtifacts <- Artifacts.loadCompile
       errorJS <- Compile.loadErrorJS
-      manager <- Donate.getManager
+      manager <- Donate.getManager =<< getSecret
       let depsInfo = Artifacts.toDepsInfo cArtifacts
 
       httpServe config $ msum $
@@ -70,3 +73,24 @@ serveDepsInfo json =
   Cors.allow GET ["https://elm-lang.org"] $
     do  modifyResponse $ setContentType "application/json"
         writeBS json
+
+
+
+-- GET SECRET
+
+
+getSecret :: IO String
+getSecret =
+  do  args <- Env.getArgs
+      case args of
+        [secret] ->
+          return secret
+
+        _ ->
+          do  IO.hPutStrLn IO.stderr
+                "Expecting a secret for /donate page:\n\
+                \\n\
+                \    ./run-worker sk_test_abcdefghijklmnopqrstuvwxyz\n\
+                \\n\
+                \Needed for handling donations with Stripe."
+              Exit.exitFailure