postmark (empty) → 0.0.1
raw patch · 7 files changed
+353/−0 lines, 7 filesdep +aesondep +attoparsecdep +basesetup-changed
Dependencies added: aeson, attoparsec, base, bytestring, containers, http-conduit, http-types, network-api-support, text, time, timerep
Files
- LICENSE +27/−0
- Setup.hs +3/−0
- postmark.cabal +49/−0
- src/Network/Api/Postmark.hs +14/−0
- src/Network/Api/Postmark/Core.hs +33/−0
- src/Network/Api/Postmark/Data.hs +202/−0
- src/Network/Api/Postmark/Defaults.hs +25/−0
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) 2012, Mark Hibberd <mark@hibberd.id.au>+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 <ORGANIZATION> 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.
+ Setup.hs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+import Distribution.Simple+main = defaultMain
+ postmark.cabal view
@@ -0,0 +1,49 @@+Name: postmark+Version: 0.0.1+License: BSD3+License-File: LICENSE+Author: Mark Hibberd <mark@hibberd.id.au>+Maintainer: Mark Hibberd <mark@hibberd.id.au>+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
+ src/Network/Api/Postmark.hs view
@@ -0,0 +1,14 @@+-- |+-- Module: Network.Postmark+-- Copyright: (c) 2012 Mark Hibberd+-- License: BSD3+-- Maintainer: Mark Hibberd <mark@hibberd.id.au>+-- 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
+ src/Network/Api/Postmark/Core.hs view
@@ -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)
+ src/Network/Api/Postmark/Data.hs view
@@ -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
+ src/Network/Api/Postmark/Defaults.hs view
@@ -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 = []+ }