mailgun (empty) → 0.1.0.0
raw patch · 6 files changed
+205/−0 lines, 6 filesdep +basedep +bytestringdep +conduitsetup-changed
Dependencies added: base, bytestring, conduit, failure, http-client, http-client-multipart, http-conduit, mailgun, monad-control, network, text, transformers
Files
- LICENSE +21/−0
- Setup.hs +2/−0
- mailgun.cabal +48/−0
- src/Rackspace/MailGun.hs +80/−0
- test/Send.hs +23/−0
- test/SendMany.hs +31/−0
+ LICENSE view
@@ -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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ mailgun.cabal view
@@ -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
+ src/Rackspace/MailGun.hs view
@@ -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
+ test/Send.hs view
@@ -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
+ test/SendMany.hs view
@@ -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