diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,27 @@ +Copyright (c) 2012, Mark Hibberd +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + 3. Neither the name of the nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ""AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,3 @@ +#!/usr/bin/env runhaskell +import Distribution.Simple +main = defaultMain diff --git a/postmark.cabal b/postmark.cabal new file mode 100644 --- /dev/null +++ b/postmark.cabal @@ -0,0 +1,49 @@ +Name: postmark +Version: 0.0.1 +License: BSD3 +License-File: LICENSE +Author: Mark Hibberd +Maintainer: Mark Hibberd +Copyright: (c) 2012 Mark Hibberd +Synopsis: Library for postmarkapp.com HTTP Api +Category: Network APIs +Homepage: https://github.com/apiengine/postmark +Bug-reports: https://github.com/apiengine/postmark/issues +Cabal-Version: >= 1.8 +Build-Type: Simple +Description: + postmark + +Source-Repository head + Type: git + Location: https://github.com/apiengine/postmark.git + +Flag small_base + Description: Choose the new, split-up base package. + +Library + Build-Depends: + base >= 3 && < 5 + , aeson >= 0.6 + , attoparsec >= 0.10 + , bytestring >= 0.9 + , containers >= 0.4 + , http-conduit >= 1.4 + , http-types >= 0.6 + , time >= 1.2 + , timerep >= 1.0.3 + , text >= 0.11 + , network-api-support >= 0.0.2 + + + GHC-Options: + -Wall -fno-warn-orphans + + Hs-Source-Dirs: + src + + Exposed-Modules: + Network.Api.Postmark + Network.Api.Postmark.Core + Network.Api.Postmark.Data + Network.Api.Postmark.Defaults diff --git a/src/Network/Api/Postmark.hs b/src/Network/Api/Postmark.hs new file mode 100644 --- /dev/null +++ b/src/Network/Api/Postmark.hs @@ -0,0 +1,14 @@ +-- | +-- Module: Network.Postmark +-- Copyright: (c) 2012 Mark Hibberd +-- License: BSD3 +-- Maintainer: Mark Hibberd +-- Portability: portable +-- +-- Library for postmarkapp.com HTTP Api +-- +module Network.Api.Postmark (module X) where + +import Network.Api.Postmark.Core as X +import Network.Api.Postmark.Data as X +import Network.Api.Postmark.Defaults as X diff --git a/src/Network/Api/Postmark/Core.hs b/src/Network/Api/Postmark/Core.hs new file mode 100644 --- /dev/null +++ b/src/Network/Api/Postmark/Core.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE OverloadedStrings #-} +module Network.Api.Postmark.Core ( + sendEmail +) where + +import qualified Data.ByteString.Lazy as BL +import Data.Text.Encoding + +import Network.Api.Support +import Network.Api.Postmark.Data +import Network.HTTP.Conduit +import Network.HTTP.Types + + +-- FIX add sendBulkEmail + +sendEmail :: PostmarkRequest Email -> IO PostmarkResponse +sendEmail req = + runRequest def POST (toUrl req "email") ( + setHeaders [ + ("Accept", "application/json") + , ("Content-Type", "application/json") + , ("X-Postmark-Server-Token", encodeUtf8 $ postmarkToken req) + ] <> + setJson (postmarkEmail req) + ) (basicResponder responder) + +responder :: Int -> BL.ByteString -> PostmarkResponse +responder 200 body = parseBodyWith body (syntaxErr 200 body) (decodeErr 200 body) successDataToResponse +responder 401 _ = PostmarkResponseUnauthorized +responder 422 body = parseBodyWith body (syntaxErr 200 body) (decodeErr 200 body) successDataToResponse +responder 500 body = PostmarkResponseServerError (toText body) +responder c body = PostmarkResponseInvalidResponseCode c (toText body) diff --git a/src/Network/Api/Postmark/Data.hs b/src/Network/Api/Postmark/Data.hs new file mode 100644 --- /dev/null +++ b/src/Network/Api/Postmark/Data.hs @@ -0,0 +1,202 @@ +{-# LANGUAGE OverloadedStrings #-} +module Network.Api.Postmark.Data where + +import Control.Applicative + +import qualified Data.ByteString.Lazy as BL +import qualified Data.Text.Lazy as LT +import qualified Data.Text.Lazy.Encoding as LE + +import Data.Aeson +import Data.Map as M +import Data.Maybe +import Data.Monoid (mappend) +import Data.Text as T hiding (null) +import Data.List as L + +-- FIX add default implementations for all data for convenient construction + +type BatchEmail = [Email] + +data Email = Email { + emailFrom :: Text + , emailTo :: [Text] + , emailCc :: [Text] + , emailBcc :: [Text] + , emailSubject :: Text + , emailTag :: Maybe Text + , emailHtml :: Maybe Text + , emailText :: Maybe Text + , emailReplyTo :: Text + , emailHeaders :: Map Text Text + , emailAttachments :: [Attachment] + } + +data Attachment = Attachment { + attachmentName :: Text + , attachmentContent :: Text + , attachmentContentType :: Text + } + +data PostmarkRequest a = + HttpPostmarkRequest Text a + | HttpsPostmarkRequest Text a + +data PostmarkResponseSuccessData = + PostmarkResponseSuccessData Text Text Text + +data PostmarkResponseErrorData = + PostmarkResponseErrorData Int Text + + +-- FIX consider smarter selectors for pulling out the data as a UTCTime or ZonedTime +data PostmarkResponse = + PostmarkResponseSuccess { + postmarkMessageId :: Text + , postmarkSubmittedAt :: Text + , postmarkTo :: Text + } + | PostmarkResponseUnauthorized + | PostmarkResponseUnprocessible PostmarkError Text + | PostmarkResponseServerError Text + | PostmarkResponseInvalidResponseCode Int Text + | PostmarkResponseJsonSyntaxError Int Text Text + | PostmarkResponseJsonFormatError Int Text Text + deriving (Eq, Show) + +data PostmarkError = + PostmarkBadApiToken + | PostmarkInvalidEmail + | PostmarkSenderNotFound + | PostmarkSenderNotConfirmed + | PostmarkInvalidJson + | PostmarkIncompatibleJson + | PostmarkNotAllowed + | PostmarkInactive + | PostmarkBounceNotFound + | PostmarkBounceQueryException + | PostmarkJsonRequired + | PostmarkTooManyMessages + | PostmarkUnkownError Int + deriving Eq + +instance ToJSON Email where + toJSON v = object ([ + "From" .= (emailFrom v) + , "To" .= T.intercalate "," (emailTo v) + , "Subject" .= emailSubject v + , "ReplyTo" .= emailReplyTo v + ] ++ catMaybes [ + ojson "HtmlBody" (emailHtml v) + , ojson "TextBody" (emailText v) + , ojson "Tag" (emailTag v) + , oljson "Cc" (emailCc v) (T.intercalate ",") + , oljson "Bcc" (emailBcc v) (T.intercalate ",") + , omjson "Headers" (emailHeaders v) + , oljson "Attachments" (emailAttachments v) id + ]) + +instance ToJSON Attachment where + toJSON v = object [ + "Name" .= attachmentName v + , "Content" .= attachmentContent v + , "ContentType" .= attachmentContentType v + ] + +instance FromJSON PostmarkResponseSuccessData where + parseJSON (Object o) = PostmarkResponseSuccessData + <$> o .: "MessageID" + <*> o .: "SubmittedAt" + <*> o .: "To" + parseJSON _ = fail "Invalid Postmark Success Response" + +instance FromJSON PostmarkResponseErrorData where + parseJSON (Object o) = PostmarkResponseErrorData + <$> o .: "ErrorCode" + <*> o .: "Message" + parseJSON _ = fail "Invalid Postmark Error Response" + + +instance Show PostmarkError where + show PostmarkBadApiToken = + "Your request did not submit the correct API token in the X-Postmark-Server-Token header." + show PostmarkInvalidEmail = + "Validation failed for the email request JSON data that you provided." + show PostmarkSenderNotFound = + "You are trying to send email with a From address that does not have a sender signature." + show PostmarkSenderNotConfirmed = + "You are trying to send email with a From address that does not have a corresponding confirmed sender signature." + show PostmarkInvalidJson = + "The JSON input you provided is syntactically incorrect." + show PostmarkIncompatibleJson = + "The JSON input you provided is syntactically correct, but still not the one we expect." + show PostmarkNotAllowed = + "You ran out of credits." + show PostmarkInactive = + "You tried to send to a recipient that has been marked as inactive. Inactive recipients are ones that have generated a hard bounce or a spam complaint." + show PostmarkBounceNotFound = + "You requested a bounce by ID, but we could not find an entry in our database." + show PostmarkBounceQueryException = + "You provided bad arguments as a bounces filter." + show PostmarkJsonRequired = + "Your HTTP request does not have the Accept and Content-Type headers set to application/json." + show PostmarkTooManyMessages = + "Your batched request contains more than 500 messages." + show (PostmarkUnkownError code) = + "An unexpected error code [" ++ show code ++ "] was retured from postmark." + +toPostmarkError :: Int -> PostmarkError +toPostmarkError 0 = PostmarkBadApiToken +toPostmarkError 300 = PostmarkInvalidEmail +toPostmarkError 400 = PostmarkSenderNotFound +toPostmarkError 401 = PostmarkSenderNotConfirmed +toPostmarkError 402 = PostmarkInvalidJson +toPostmarkError 403 = PostmarkIncompatibleJson +toPostmarkError 405 = PostmarkNotAllowed +toPostmarkError 406 = PostmarkInactive +toPostmarkError 407 = PostmarkBounceNotFound +toPostmarkError 408 = PostmarkBounceQueryException +toPostmarkError 409 = PostmarkJsonRequired +toPostmarkError 410 = PostmarkTooManyMessages +toPostmarkError code = PostmarkUnkownError code + +toBaseUrl :: PostmarkRequest a -> Text +toBaseUrl (HttpPostmarkRequest _ _) = "http://api.postmarkapp.com/" +toBaseUrl (HttpsPostmarkRequest _ _) = "https://api.postmarkapp.com/" + +toUrl :: PostmarkRequest a -> Text -> Text +toUrl req suffix = toBaseUrl req `mappend` suffix + +postmarkToken :: PostmarkRequest a -> Text +postmarkToken (HttpPostmarkRequest t _) = t +postmarkToken (HttpsPostmarkRequest t _) = t + +postmarkEmail :: PostmarkRequest a -> a +postmarkEmail (HttpPostmarkRequest _ e) = e +postmarkEmail (HttpsPostmarkRequest _ e) = e + +successDataToResponse :: PostmarkResponseSuccessData -> PostmarkResponse +successDataToResponse (PostmarkResponseSuccessData ident at to) = + PostmarkResponseSuccess ident at to + +errorDataToResponse :: PostmarkResponseErrorData -> PostmarkResponse +errorDataToResponse (PostmarkResponseErrorData code message) = + PostmarkResponseUnprocessible (toPostmarkError code) message + +syntaxErr :: Int -> BL.ByteString -> Text -> PostmarkResponse +syntaxErr code body msg = PostmarkResponseJsonSyntaxError code msg (toText body) + +decodeErr :: Int -> BL.ByteString -> Text -> PostmarkResponse +decodeErr code body msg = PostmarkResponseJsonFormatError code msg (toText body) + +ojson :: ToJSON a => Text -> Maybe a -> Maybe (Text, Value) +ojson k = fmap (k .=) + +oljson :: ToJSON b => Text -> [a] -> ([a] -> b) -> Maybe (Text, Value) +oljson k vs f = if L.null vs then Nothing else Just (k .= f vs) + +omjson :: (ToJSON a) => Text -> Map Text a -> Maybe (Text, Value) +omjson k vs = if M.null vs then Nothing else Just (k .= vs) + +toText :: BL.ByteString -> Text +toText = LT.toStrict . LE.decodeUtf8 diff --git a/src/Network/Api/Postmark/Defaults.hs b/src/Network/Api/Postmark/Defaults.hs new file mode 100644 --- /dev/null +++ b/src/Network/Api/Postmark/Defaults.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE OverloadedStrings #-} +module Network.Api.Postmark.Defaults where + +import qualified Data.Map as M +import Data.Text + +import Network.Api.Postmark.Data + +testKey :: Text +testKey = "POSTMARK_API_TEST" + +defaultEmail :: Email +defaultEmail = Email { + emailFrom = "" + , emailTo = [] + , emailCc = [] + , emailBcc = [] + , emailSubject = "" + , emailTag = Nothing + , emailHtml = Nothing + , emailText = Nothing + , emailReplyTo = "" + , emailHeaders = M.empty + , emailAttachments = [] + }