summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorandrewrademacher <>2014-04-01 20:54:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2014-04-01 20:54:00 (GMT)
commitaf799e283be6604c997d014016ae19124078e91b (patch)
tree27e47f99076bec3a00d6672bf8870d03a280bbaf
version 0.1.0.00.1.0.0
-rw-r--r--LICENSE21
-rw-r--r--Setup.hs2
-rw-r--r--mailgun.cabal48
-rw-r--r--src/Rackspace/MailGun.hs80
-rw-r--r--test/Send.hs23
-rw-r--r--test/SendMany.hs31
6 files changed, 205 insertions, 0 deletions
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..f6a8157
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,21 @@
+The MIT License (MIT)
+
+Copyright (c) 2014 Andrew Rademacher
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in
+all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+THE SOFTWARE.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/mailgun.cabal b/mailgun.cabal
new file mode 100644
index 0000000..a7cbdf1
--- /dev/null
+++ b/mailgun.cabal
@@ -0,0 +1,48 @@
+name: mailgun
+version: 0.1.0.0
+synopsis: Connector to Rackspace's Mailgun Service
+description: Allows users to directly access Rackspace's Mailgun service
+ without having to work with the underlying REST service.
+license: MIT
+license-file: LICENSE
+author: Andrew Rademacher
+maintainer: andrewrademacher@gmail.com
+category: Web
+build-type: Simple
+cabal-version: >=1.10
+
+library
+ exposed-modules: Rackspace.MailGun
+ -- other-modules:
+ -- other-extensions:
+ hs-source-dirs: src
+ default-language: Haskell2010
+ build-depends: base >=4.6 && <4.7
+ , text >=1.1.0.1
+ , conduit >=1.0.17.1
+ , http-conduit >=2.0.0.8
+ , bytestring >=0.10.0.2
+ , network >=2.4.2.2
+ , http-client-multipart >=0.2.0.0
+ , transformers >=0.3.0.0
+ , monad-control >=0.3.2.3
+ , http-client >=0.2.2.4
+ , failure >=0.2.0.2
+
+executable send
+ main-is: Send.hs
+ hs-source-dirs: test
+ default-language: Haskell2010
+ build-depends: base >=4.6 && <4.7
+ , text >=1.1.0.1
+ , mailgun
+
+executable sendmany
+ main-is: SendMany.hs
+ hs-source-dirs: test
+ default-language: Haskell2010
+ build-depends: base >=4.6 && <4.7
+ , text >=1.1.0.1
+ , http-conduit >=2.0.0.8
+ , transformers >=0.3.0.0
+ , mailgun
diff --git a/src/Rackspace/MailGun.hs b/src/Rackspace/MailGun.hs
new file mode 100644
index 0000000..fda50ba
--- /dev/null
+++ b/src/Rackspace/MailGun.hs
@@ -0,0 +1,80 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Rackspace.MailGun
+ ( Message (..)
+ , sendMessage
+ , sendWith
+ ) where
+
+import Control.Failure
+import Control.Monad.IO.Class
+import Control.Monad.Trans.Control
+import Data.ByteString.Char8 as BS (ByteString, pack,
+ putStrLn)
+import qualified Data.ByteString.Lazy.Char8 as LBS (ByteString)
+import Data.Conduit
+import qualified Data.Conduit.List as CL
+import Data.Text as T (Text, concat, pack)
+import Data.Text.Encoding (encodeUtf8)
+import Network (withSocketsDo)
+import Network.HTTP.Client.MultipartFormData
+import Network.HTTP.Conduit
+
+baseUrl :: String
+baseUrl = "https://api.mailgun.net/v2"
+
+data Message = TextMessage
+ { from :: Text
+ , to :: Text
+ , cc :: Maybe Text
+ , bcc :: Maybe Text
+ , subject :: Maybe Text
+ , text :: Text }
+ | HtmlMessage
+ { from :: Text
+ , to :: Text
+ , cc :: Maybe Text
+ , bcc :: Maybe Text
+ , subject :: Maybe Text
+ , html :: Text }
+ deriving (Eq, Show)
+
+partText :: Text -> Text -> [Part]
+partText name value = [ partBS name (encodeUtf8 value) ]
+
+partMaybeText :: Text -> Maybe Text -> [Part]
+partMaybeText name value = case value of
+ Just val -> [ partBS name (encodeUtf8 val) ]
+ Nothing -> []
+
+buildTail :: Message -> [Part]
+buildTail TextMessage{..} = partText "text" text
+buildTail HtmlMessage{..} = partText "html" html
+
+buildBase :: Message -> [Part]
+buildBase msg = partText "from" (from msg)
+ ++ partText "to" (to msg)
+ ++ partMaybeText "cc" (cc msg)
+ ++ partMaybeText "bcc" (bcc msg)
+ ++ partMaybeText "subject" (subject msg)
+ ++ buildTail msg
+
+sendMessage :: (Failure HttpException m, MonadBaseControl IO m, MonadIO m) =>
+ String -> String -> Message -> m (Response LBS.ByteString)
+sendMessage domain apiKey message = do
+ withManager $ \manager -> do
+ sendWith manager domain apiKey message
+
+sendWith :: (Failure HttpException m, MonadBaseControl IO m, MonadIO m) =>
+ Manager -> String -> String -> Message -> m (Response LBS.ByteString)
+sendWith manager domain apiKey message = do
+ initReq <- parseUrl $ baseUrl ++ "/" ++ domain ++ "/messages"
+ let authReq = applyBasicAuth "api" (BS.pack apiKey) initReq
+ postReq = authReq { method = "POST" }
+ res <- flip httpLbs manager =<<
+ (formDataBody (buildBase message) postReq)
+ return res
diff --git a/test/Send.hs b/test/Send.hs
new file mode 100644
index 0000000..94b47e8
--- /dev/null
+++ b/test/Send.hs
@@ -0,0 +1,23 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Main where
+
+import Data.Text as T (Text (..), pack)
+import Rackspace.MailGun
+import System.Environment
+
+main :: IO ()
+main = do
+ domain <- getEnv "MAILGUN_DOMAIN"
+ apiKey <- getEnv "MAILGUN_SECRET"
+ testAddr <- getEnv "MAILGUN_TEST_ADDRESS"
+
+ let message = TextMessage
+ { from = T.pack ("someone@" ++ domain)
+ , to = T.pack testAddr
+ , cc = Nothing
+ , bcc = Nothing
+ , subject = Just "Test Message"
+ , text = "Hello, this is a test message!" }
+ res <- sendMessage domain apiKey message
+ print res
diff --git a/test/SendMany.hs b/test/SendMany.hs
new file mode 100644
index 0000000..6ae9adc
--- /dev/null
+++ b/test/SendMany.hs
@@ -0,0 +1,31 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Main where
+
+import Control.Monad.IO.Class
+import Data.Text as T (Text (..), pack)
+import Network.HTTP.Conduit
+import Rackspace.MailGun
+import System.Environment
+
+main :: IO ()
+main = do
+ domain <- getEnv "MAILGUN_DOMAIN"
+ apiKey <- getEnv "MAILGUN_SECRET"
+ testAddr <- getEnv "MAILGUN_TEST_ADDRESS"
+
+ let message = TextMessage
+ { from = T.pack ("someone@" ++ domain)
+ , to = T.pack testAddr
+ , cc = Nothing
+ , bcc = Nothing
+ , subject = Just "Test Message"
+ , text = "Hello, this is a test message!" }
+ withManager $ \manager -> do
+ let sendW = sendWith manager
+ res1 <- sendW domain apiKey message
+ res2 <- sendW domain apiKey message
+ res3 <- sendW domain apiKey message
+ liftIO $ print res1
+ liftIO $ print res2
+ liftIO $ print res3