{-# 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