From 3a7eee69dfd63cf5b53fcd06d4e9501fec424c10 Mon Sep 17 00:00:00 2001
From: Evan Czaplicki <evancz@users.noreply.github.com>
Date: Tue, 6 Sep 2022 08:42:33 +0200
Subject: [PATCH] add Endpoint.Slack for invitations to the Elm Slack

---
 worker/src/Endpoint/Slack.hs | 69 ++++++++++++++++++++++++++++++++++++
 1 file changed, 69 insertions(+)
 create mode 100644 worker/src/Endpoint/Slack.hs

diff --git a/worker/src/Endpoint/Slack.hs b/worker/src/Endpoint/Slack.hs
new file mode 100644
index 000000000..19e51e98a
--- /dev/null
+++ b/worker/src/Endpoint/Slack.hs
@@ -0,0 +1,69 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Endpoint.Slack
+  ( Token(..)
+  , endpoint
+  )
+  where
+
+
+-- Send invitations to the Elm Slack to whoever asks.
+--
+-- NOTE: The API to invite users is not officially documented, but the people
+-- here looked in the Network tab of Developer Tools to figure it out:
+--
+--   https://levels.io/slack-typeform-auto-invite-sign-ups/
+--   from https://github.com/outsideris/slack-invite-automation
+--
+
+
+
+-- ALLOWED ORIGINS
+
+
+allowedOrigins :: [String]
+allowedOrigins =
+  [ "https://elm-lang.org"
+  ]
+
+
+
+-- ENDPOINT
+
+
+newtype Token =
+  Token BS.ByteString
+
+
+endpoint :: Token -> Snap ()
+endpoint (Token token) =
+  Cors.allow POST allowedOrigins $
+    do  req <- getRequest
+        case Map.lookup "email" (rqQueryParams req) of
+          [email] ->
+            withResponse (request email) manager handler
+
+          _ ->
+          do  modifyResponse $ setResponseStatus 400 "Bad Request"
+              modifyResponse $ setContentType "text/html; charset=utf-8"
+              writeBS "expecting query parameter like ?email=you@example.com"
+  where
+    request email =
+      urlEncodedBody
+        [ ("email", email)
+        , ("token", token)
+        , ("set_active","true")
+        ]
+        (parseRequest_ "https://elmlang.slack.com/api/users.admin.invite")
+
+    handler response =
+      do  modifyResponse $ setContentType "application/json"
+          loop (responseBody response)
+      where
+        loop body =
+          do  chunk <- brRead body
+              if BS.null chunk
+                then return ()
+                else
+                  do  writeBS chunk
+                      loop body
+