Add Haskell client library for MailGun

Whichever package is on nixpkgs right now is broken, so I'm using `fetchGit` and
`callCabal2nix`.

Create Email module exposing a simplifies `send` function that partially applies
some of the configuration options.

2 files changed, 52 insertions, 0 deletions

diff --git a/shell.nix b/shell.nix
index bd31438b1957..811061186e2e 100644
--- a/shell.nix
+++ b/shell.nix
@@ -1,5 +1,10 @@
 let
   pkgs = import <nixpkgs> {};
+  hailgun-src = builtins.fetchGit {
+    url = "https://bitbucket.org/echo_rm/hailgun.git";
+    rev = "9d5da7c902b2399e0fcf3d494ee04cf2bbfe7c9e";
+  };
+  hailgun = pkgs.haskellPackages.callCabal2nix "hailgun" hailgun-src {};
 in pkgs.mkShell {
   buildInputs = with pkgs; [
     (haskellPackages.ghcWithPackages (hpkgs: with hpkgs; [
@@ -11,6 +16,7 @@ in pkgs.mkShell {
       hpkgs.cryptonite
       hpkgs.uuid
       hpkgs.envy
+      hailgun
     ]))
   ];
 }
diff --git a/src/Email.hs b/src/Email.hs
new file mode 100644
index 000000000000..439b15d0ed4b
--- /dev/null
+++ b/src/Email.hs
@@ -0,0 +1,46 @@
+{-# LANGUAGE OverloadedStrings #-}
+--------------------------------------------------------------------------------
+module Email where
+--------------------------------------------------------------------------------
+import Data.Text
+import Data.String.Conversions (cs)
+import Utils
+
+import qualified Mail.Hailgun as MG
+import qualified Types as T
+--------------------------------------------------------------------------------
+
+newtype SendSuccess = SendSuccess MG.HailgunSendResponse
+
+data SendError
+  = MessageError MG.HailgunErrorMessage
+  | ResponseError MG.HailgunErrorResponse
+
+-- | Attempt to send an email with `subject` and with message, `body`.
+send :: Text
+     -> Text
+     -> Text
+     -> T.Email
+     -> IO (Either SendError SendSuccess)
+send apiKey subject body (T.Email to) = do
+  case mkMsg of
+    Left e -> pure $ Left (MessageError e)
+    Right x -> do
+      res <- MG.sendEmail ctx x
+      case res of
+        Left e -> pure $ Left (ResponseError e)
+        Right x -> pure $ Right (SendSuccess x)
+  where
+    ctx = MG.HailgunContext { MG.hailgunDomain = "sandboxda5038873f924b50af2f82a0f05cffdf.mailgun.org"
+                            , MG.hailgunApiKey = cs apiKey
+                            , MG.hailgunProxy = Nothing
+                            }
+    mkMsg = MG.hailgunMessage
+            subject
+            (body |> cs |> MG.TextOnly)
+            "mailgun@sandboxda5038873f924b50af2f82a0f05cffdf.mailgun.org"
+            (MG.MessageRecipients { MG.recipientsTo = [cs to]
+                                  , MG.recipientsCC = []
+                                  , MG.recipientsBCC = []
+                                  })
+            []