packages feed

postmark 0.0.1 → 0.0.2

raw patch · 9 files changed

+235/−172 lines, 9 filesdep ~network-api-support

Dependency ranges changed: network-api-support

Files

postmark.cabal view
@@ -1,5 +1,5 @@ Name:               postmark-Version:            0.0.1+Version:            0.0.2 License:            BSD3 License-File:       LICENSE Author:             Mark Hibberd <mark@hibberd.id.au>@@ -33,7 +33,7 @@                     , time                          >= 1.2                     , timerep                       >= 1.0.3                     , text                          >= 0.11-                    , network-api-support           >= 0.0.2+                    , network-api-support           >= 0.0.3     GHC-Options:@@ -46,4 +46,7 @@                     Network.Api.Postmark                     Network.Api.Postmark.Core                     Network.Api.Postmark.Data-                    Network.Api.Postmark.Defaults+                    Network.Api.Postmark.Error+                    Network.Api.Postmark.Request+                    Network.Api.Postmark.Response+                    Network.Api.Postmark.Settings
src/Network/Api/Postmark.hs view
@@ -10,5 +10,8 @@ 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+import Network.Api.Postmark.Data as X hiding (ojson, oljson, omjson, toText)+import Network.Api.Postmark.Error as X+import Network.Api.Postmark.Request as X+import Network.Api.Postmark.Response as X+import Network.Api.Postmark.Settings as X
src/Network/Api/Postmark/Core.hs view
@@ -1,33 +1,51 @@ {-# LANGUAGE OverloadedStrings #-} module Network.Api.Postmark.Core (-  sendEmail+  email,+  emails,+  request ) where  import qualified Data.ByteString.Lazy as BL+import Data.Aeson import Data.Text.Encoding  import Network.Api.Support import Network.Api.Postmark.Data+import Network.Api.Postmark.Request+import Network.Api.Postmark.Response+import Network.Api.Postmark.Settings import Network.HTTP.Conduit import Network.HTTP.Types +-- * Api endpoints --- 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)+-- | Send a single email: http://developer.postmarkapp.com/developer-build.html+email :: Email -> PostmarkRequest' Sent+email e = PostmarkRequest POST "/email" $ setJson e++-- | Bulk send emails: http://developer.postmarkapp.com/developer-build.html#batching-messages+emails :: [Email] -> PostmarkRequest' [Sent]+emails es = PostmarkRequest POST "/email/batch" $ setJson es+++-- * Run a request++-- | Run the specified request with the specified settings.+request :: PostmarkSettings -> PostmarkRequest e a -> IO (PostmarkResponse e a)+request settings (PostmarkRequest stdmethod url transform) =+  runRequest def stdmethod (apiUrl settings <> url) (+    addHeader ("Accept", "application/json") <>+    addHeader ("X-Postmark-Server-Token", encodeUtf8 $  apiToken settings) <>+    transform   ) (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)++-- Low level error handling++responder :: (FromJSON e, FromJSON a) => Int -> BL.ByteString -> PostmarkResponse e a+responder 200 body = parseBodyWith body (syntaxErr 200 body) (formatErr 200 body) PostmarkSuccess+responder 401 _    = PostmarkUnauthorized+responder 422 body = parseBodyWith body (syntaxErr 422 body) (formatErr 422 body) PostmarkFailure+responder 500 body = PostmarkUnexpected ServerError 500 (Just . toText $ body) Nothing+responder c   body = PostmarkUnexpected UnexpectedResponseCode c (Just . toText $ body) Nothing
src/Network/Api/Postmark/Data.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings, GADTSyntax #-} module Network.Api.Postmark.Data where  import Control.Applicative@@ -10,14 +10,19 @@ 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]+-- * Request types +-- | Email data type. It is recommended that you use the defaultEmail+--   function and selector syntax to build an email, e.g.:+--+-- > defaultEmail {+-- >     emailFrom = "you@yourdomain.com"+-- >   , emailTo = "person@example.com"+-- >   , emailSubject = "This is an example email!"+-- >   } data Email = Email {     emailFrom :: Text   , emailTo :: [Text]@@ -38,48 +43,22 @@   , attachmentContentType :: Text   } -data PostmarkRequest a =-    HttpPostmarkRequest Text a-  | HttpsPostmarkRequest Text a--data PostmarkResponseSuccessData =-    PostmarkResponseSuccessData Text Text Text--data PostmarkResponseErrorData =-    PostmarkResponseErrorData Int Text+defaultEmail :: Email+defaultEmail = Email {+    emailFrom = ""+  , emailTo = []+  , emailCc = []+  , emailBcc = []+  , emailSubject = ""+  , emailTag = Nothing+  , emailHtml = Nothing+  , emailText = Nothing+  , emailReplyTo = ""+  , emailHeaders = M.empty+  , emailAttachments = []+  }  --- 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)@@ -103,91 +82,24 @@     , "ContentType" .= attachmentContentType v     ] -instance FromJSON PostmarkResponseSuccessData where-  parseJSON (Object o) = PostmarkResponseSuccessData+-- * Response types++data Sent =+  Sent {+      postmarkMessageId :: Text+    , postmarkSubmittedAt :: Text+    , postmarkTo :: Text+    } deriving (Eq, Show)++instance FromJSON Sent where+  parseJSON (Object o) = Sent     <$> 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"+  parseJSON _ = fail "Invalid `Sent` Json"  -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)+-- * Internal Json tools  ojson :: ToJSON a => Text -> Maybe a -> Maybe (Text, Value) ojson k = fmap (k .=)
− src/Network/Api/Postmark/Defaults.hs 
@@ -1,25 +0,0 @@-{-# 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 = []-  }
+ src/Network/Api/Postmark/Error.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE OverloadedStrings, GADTSyntax #-}+module Network.Api.Postmark.Error where++import Control.Applicative++import Data.Aeson+import Data.Text++-- * Error types++data PostmarkError =+  PostmarkError {+      errorType :: PostmarkErrorType+    , errorMessage :: Text+    } deriving (Eq, Show)++data PostmarkErrorType =+    PostmarkBadApiToken+  | PostmarkInvalidEmail+  | PostmarkSenderNotFound+  | PostmarkSenderNotConfirmed+  | PostmarkInvalidJson+  | PostmarkIncompatibleJson+  | PostmarkNotAllowed+  | PostmarkInactive+  | PostmarkBounceNotFound+  | PostmarkBounceQueryException+  | PostmarkJsonRequired+  | PostmarkTooManyMessages+  | PostmarkUnkownError Int+  deriving Eq+++instance FromJSON PostmarkError where+  parseJSON (Object o) = PostmarkError+    <$> (fmap (\code -> case code of+          0 -> PostmarkBadApiToken+          300 -> PostmarkInvalidEmail+          400 -> PostmarkSenderNotFound+          401 -> PostmarkSenderNotConfirmed+          402 -> PostmarkInvalidJson+          403 -> PostmarkIncompatibleJson+          405 -> PostmarkNotAllowed+          406 -> PostmarkInactive+          407 -> PostmarkBounceNotFound+          408 -> PostmarkBounceQueryException+          409 -> PostmarkJsonRequired+          410 -> PostmarkTooManyMessages+          _ -> PostmarkUnkownError code) (o .: "ErrorCode"))+    <*> (o .: "Message")+  parseJSON _ = fail "Invalid Postmark Error Response"++instance Show PostmarkErrorType 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."
+ src/Network/Api/Postmark/Request.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE GADTs, GADTSyntax #-}+module Network.Api.Postmark.Request where++import Network.Api.Postmark.Error++import Data.Aeson+import Data.Text++import Network.Api.Support+import Network.HTTP.Types++data PostmarkRequest e a where+  PostmarkRequest :: (FromJSON e, FromJSON a) => StdMethod -> Text -> RequestTransformer IO -> PostmarkRequest e a++type PostmarkRequest' a =+  PostmarkRequest PostmarkError a
+ src/Network/Api/Postmark/Response.hs view
@@ -0,0 +1,32 @@+module Network.Api.Postmark.Response where++import qualified Data.ByteString.Lazy as BL+import Data.Text++import Network.Api.Postmark.Data (toText)+import Network.Api.Postmark.Error++data PostmarkResponse e a =+    PostmarkSuccess a+  | PostmarkUnauthorized+  | PostmarkFailure e+  | PostmarkUnexpected PostmarkUnexpectedType Int (Maybe Text) (Maybe Text)+  deriving (Eq, Show)++data PostmarkUnexpectedType =+    ServerError+  | UnexpectedResponseCode+  | JsonSyntaxError+  | JsonFormatError+  deriving (Eq, Show)++type PostmarkResponse' a =+  PostmarkResponse PostmarkError a++++syntaxErr :: Int -> BL.ByteString -> Text -> PostmarkResponse e a+syntaxErr code body msg = PostmarkUnexpected JsonSyntaxError code (Just . toText $ body) (Just msg)++formatErr :: Int -> BL.ByteString -> Text -> PostmarkResponse e a+formatErr code body msg = PostmarkUnexpected JsonFormatError code (Just . toText $ body) (Just msg)
+ src/Network/Api/Postmark/Settings.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE OverloadedStrings #-}+module Network.Api.Postmark.Settings where++import Data.Text++data PostmarkSettings =+  PostmarkSettings {+      apiUrl :: Text+    , apiToken :: Text+    }++postmarkTestToken :: Text+postmarkTestToken = "POSTMARK_API_TEST"++postmarkHttpTest :: PostmarkSettings+postmarkHttpTest = postmarkHttp postmarkTestToken++postmarkHttpsTest :: PostmarkSettings+postmarkHttpsTest = postmarkHttps postmarkTestToken++postmarkHttp :: Text -> PostmarkSettings+postmarkHttp = PostmarkSettings "http://api.postmarkapp.com"++postmarkHttps :: Text -> PostmarkSettings+postmarkHttps = PostmarkSettings "https://api.postmarkapp.com"