----------------------------------------------------------------------------------------------------
-- | Mailtrap API.
module Network.Mail.Mailtrap
  ( -- * Tokens
    Token (..)
  , Exception (..)
    -- * Accounts
  , AccountID (..)
  , Account (..)
  , getAllAccounts
    -- * Attachments
  , Disposition (..)
  , setDisposition
  , Attachment (..)
  , attachmentFromFile
    -- * Templates
  , Template (..)
  , template
  , setTemplateVariable
    -- * Testing inboxes
  , InboxID (..)
  , Inbox (..)
  , getInboxes
  , InboxMessageID (..)
  , InboxMessage (..)
  , getInboxMessages
  , downloadMessageRaw
  , downloadMessageEML
  , downloadMessageText
  , downloadMessageHTML
    -- * Sending e-mails
  , EmailAddress
  , parseEmailAddress
  , NamedEmailAddress (..)
  , MessageID (..)
  , Message (..)
  , EmailBody (..)
  , Email (..)
  , sendEmail
  , sendTestEmail
    ) where

-- base
import Control.Exception qualified as Base
import GHC.TypeLits (Symbol, KnownSymbol, symbolVal)
import Data.Proxy
import Data.String (fromString)
-- text
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
-- email-validate
import Text.Email.Validate (EmailAddress)
import Text.Email.Validate qualified as Email
-- bytestring
import Data.ByteString (ByteString)
import Data.ByteString qualified as ByteString
-- mime-types
import Network.Mime (MimeType, defaultMimeLookup)
-- aeson
import Data.Aeson (ToJSON, (.=), FromJSON, (.:))
import Data.Aeson qualified as JSON
#if MIN_VERSION_aeson(2,0,0)
import Data.Aeson.KeyMap qualified as KeyMap
import Data.Aeson.Key qualified as Key
#else
import Data.HashMap.Strict qualified as HashMap
#endif
-- base64
import Data.ByteString.Base64 (encodeBase64)
-- blaze-html
import Text.Blaze.Html (Html)
import Text.Blaze.Html.Renderer.Text (renderHtml)
-- uuid
import Data.UUID.Types (UUID)
-- http-conduit
import Network.HTTP.Simple qualified as HTTP
-- filepath
import System.FilePath (takeFileName)
-- time
import Data.Time.Clock (UTCTime)

-- | Authorization token.
newtype Token = Token Text deriving (Token -> Token -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Token -> Token -> Bool
$c/= :: Token -> Token -> Bool
== :: Token -> Token -> Bool
$c== :: Token -> Token -> Bool
Eq, Int -> Token -> ShowS
[Token] -> ShowS
Token -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Token] -> ShowS
$cshowList :: [Token] -> ShowS
show :: Token -> String
$cshow :: Token -> String
showsPrec :: Int -> Token -> ShowS
$cshowsPrec :: Int -> Token -> ShowS
Show)

-- | Exceptions thrown by functions from this module.
data Exception =
    -- | API request returned list of errors.
    --   HTTP status code and error messages.
    MultipleErrors Int [Text]
    -- | API request returned a single error message.
    --   HTTP status code and error message.
  | SingleError Int Text
    -- | Parsing failed.
    --   Input that failed to parse plus error message.
  | ParsingError ByteString String
    deriving Int -> Exception -> ShowS
[Exception] -> ShowS
Exception -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Exception] -> ShowS
$cshowList :: [Exception] -> ShowS
show :: Exception -> String
$cshow :: Exception -> String
showsPrec :: Int -> Exception -> ShowS
$cshowsPrec :: Int -> Exception -> ShowS
Show

instance Base.Exception Exception

-- | Constructor of simple error.
singleError :: Int -> JSONResp "error" Text -> Exception
singleError :: Int -> JSONResp "error" Text -> Exception
singleError Int
code (JSONResp Text
err) = Int -> Text -> Exception
SingleError Int
code Text
err

-- | Constructor of multiple errors.
multipleErrors :: Int -> JSONResp "errors" [Text] -> Exception
multipleErrors :: Int -> JSONResp "errors" [Text] -> Exception
multipleErrors Int
code (JSONResp [Text]
errs) = Int -> [Text] -> Exception
MultipleErrors Int
code [Text]
errs

-- | JSON object wrapper to help with parsing HTTP response.
data JSONResp (k :: Symbol) a = JSONResp { forall (k :: Symbol) a. JSONResp k a -> a
fromJSONResp :: a }

instance (KnownSymbol k, FromJSON a) => FromJSON (JSONResp k a) where
  parseJSON :: Value -> Parser (JSONResp k a)
parseJSON =
    let k :: Key
k = forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @k
    in  forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"JSONResp" forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (k :: Symbol) a. a -> JSONResp k a
JSONResp forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. FromJSON a => Object -> Key -> Parser a
.: Key
k)

-- | Wrapper that provides a text-based 'FromJSON' instance.
newtype AsText a = AsText { forall a. AsText a -> a
asText :: a }

instance FromJSON a => FromJSON (AsText a) where
  parseJSON :: Value -> Parser (AsText a)
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
JSON.withText String
"AsText" forall a b. (a -> b) -> a -> b
$
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => String -> m a
fail (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> AsText a
AsText) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => ByteString -> Either String a
JSON.eitherDecodeStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8

-- | Generic API query that returns JSON.
genericQuery
  :: (FromJSON err, ToJSON a, FromJSON b)
  => ByteString -- ^ HTTP method.
  -> ByteString -- ^ API URL.
  -> ByteString -- ^ HTTP path.
  -> Token -- ^ API token.
  -> (Int -> err -> Exception) -- ^ Error parsing.
  -> Maybe a -- ^ Body.
  -> IO b -- ^ Response.
genericQuery :: forall err a b.
(FromJSON err, ToJSON a, FromJSON b) =>
ByteString
-> ByteString
-> ByteString
-> Token
-> (Int -> err -> Exception)
-> Maybe a
-> IO b
genericQuery ByteString
method ByteString
url ByteString
path (Token Text
token) Int -> err -> Exception
ferr Maybe a
mbody = do
  let req :: Request
req = ByteString -> Request -> Request
HTTP.setRequestMethod ByteString
method
          forall a b. (a -> b) -> a -> b
$ ByteString -> Request -> Request
HTTP.setRequestHost ByteString
url
          forall a b. (a -> b) -> a -> b
$ Int -> Request -> Request
HTTP.setRequestPort Int
443
          forall a b. (a -> b) -> a -> b
$ ByteString -> Request -> Request
HTTP.setRequestPath ByteString
path
          forall a b. (a -> b) -> a -> b
$ Bool -> Request -> Request
HTTP.setRequestSecure Bool
True
          forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id forall a. ToJSON a => a -> Request -> Request
HTTP.setRequestBodyJSON Maybe a
mbody
          forall a b. (a -> b) -> a -> b
$ HeaderName -> ByteString -> Request -> Request
HTTP.addRequestHeader HeaderName
"Api-Token" (Text -> ByteString
encodeUtf8 Text
token)
          forall a b. (a -> b) -> a -> b
$ Request
HTTP.defaultRequest
  Response ByteString
resp <- forall (m :: * -> *).
MonadIO m =>
Request -> m (Response ByteString)
HTTP.httpBS Request
req
  let code :: Int
code = forall a. Response a -> Int
HTTP.getResponseStatusCode Response ByteString
resp
      body :: ByteString
body = forall a. Response a -> a
HTTP.getResponseBody Response ByteString
resp
  case Int
code of
    Int
200 ->
      forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall e a. Exception e => e -> IO a
Base.throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String -> Exception
ParsingError ByteString
body) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
        forall a. FromJSON a => ByteString -> Either String a
JSON.eitherDecodeStrict ByteString
body
    Int
_ ->
      forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall e a. Exception e => e -> IO a
Base.throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String -> Exception
ParsingError ByteString
body) (forall e a. Exception e => e -> IO a
Base.throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> err -> Exception
ferr Int
code) forall a b. (a -> b) -> a -> b
$
        forall a. FromJSON a => ByteString -> Either String a
JSON.eitherDecodeStrict ByteString
body

-- | Helper to set an empty body when using 'genericQuery'.
noBody :: Maybe ()
noBody :: Maybe ()
noBody = forall a. Maybe a
Nothing

-- | Generic API query to download files.
genericDownload
  :: ByteString -- ^ API URL.
  -> ByteString -- ^ HTTP path.
  -> Token -- ^ API token.
  -> IO ByteString -- ^ Response.
genericDownload :: ByteString -> ByteString -> Token -> IO ByteString
genericDownload ByteString
url ByteString
path (Token Text
token) = do
  let req :: Request
req = ByteString -> Request -> Request
HTTP.setRequestMethod ByteString
"GET"
          forall a b. (a -> b) -> a -> b
$ ByteString -> Request -> Request
HTTP.setRequestHost ByteString
url
          forall a b. (a -> b) -> a -> b
$ Int -> Request -> Request
HTTP.setRequestPort Int
443
          forall a b. (a -> b) -> a -> b
$ ByteString -> Request -> Request
HTTP.setRequestPath ByteString
path
          forall a b. (a -> b) -> a -> b
$ Bool -> Request -> Request
HTTP.setRequestSecure Bool
True
          forall a b. (a -> b) -> a -> b
$ HeaderName -> ByteString -> Request -> Request
HTTP.addRequestHeader HeaderName
"Api-Token" (Text -> ByteString
encodeUtf8 Text
token)
          forall a b. (a -> b) -> a -> b
$ Request
HTTP.defaultRequest
  Response ByteString
resp <- forall (m :: * -> *).
MonadIO m =>
Request -> m (Response ByteString)
HTTP.httpBS Request
req
  let code :: Int
code = forall a. Response a -> Int
HTTP.getResponseStatusCode Response ByteString
resp
      body :: ByteString
body = forall a. Response a -> a
HTTP.getResponseBody Response ByteString
resp
  case Int
code of
    Int
200 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
body
    Int
404 -> forall e a. Exception e => e -> IO a
Base.throwIO forall a b. (a -> b) -> a -> b
$ Int -> Text -> Exception
SingleError Int
404 Text
"File not found."
    Int
_ ->
      forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall e a. Exception e => e -> IO a
Base.throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String -> Exception
ParsingError ByteString
body) (forall e a. Exception e => e -> IO a
Base.throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> JSONResp "error" Text -> Exception
singleError Int
code) forall a b. (a -> b) -> a -> b
$
        forall a. FromJSON a => ByteString -> Either String a
JSON.eitherDecodeStrict ByteString
body

-- | Mailtrap account ID.
newtype AccountID = AccountID Int deriving (AccountID -> AccountID -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AccountID -> AccountID -> Bool
$c/= :: AccountID -> AccountID -> Bool
== :: AccountID -> AccountID -> Bool
$c== :: AccountID -> AccountID -> Bool
Eq, Int -> AccountID -> ShowS
[AccountID] -> ShowS
AccountID -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AccountID] -> ShowS
$cshowList :: [AccountID] -> ShowS
show :: AccountID -> String
$cshow :: AccountID -> String
showsPrec :: Int -> AccountID -> ShowS
$cshowsPrec :: Int -> AccountID -> ShowS
Show, Value -> Parser [AccountID]
Value -> Parser AccountID
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [AccountID]
$cparseJSONList :: Value -> Parser [AccountID]
parseJSON :: Value -> Parser AccountID
$cparseJSON :: Value -> Parser AccountID
FromJSON)

-- | Mailtrap account.
data Account = Account
  { Account -> AccountID
account_id :: AccountID
  , Account -> Text
account_name :: Text
    } deriving Int -> Account -> ShowS
[Account] -> ShowS
Account -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Account] -> ShowS
$cshowList :: [Account] -> ShowS
show :: Account -> String
$cshow :: Account -> String
showsPrec :: Int -> Account -> ShowS
$cshowsPrec :: Int -> Account -> ShowS
Show

instance FromJSON Account where
  parseJSON :: Value -> Parser Account
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"Account" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    AccountID -> Text -> Account
Account forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"

-- | Get all the accounts the given token has access to.
getAllAccounts :: Token -> IO [Account]
getAllAccounts :: Token -> IO [Account]
getAllAccounts Token
token = forall err a b.
(FromJSON err, ToJSON a, FromJSON b) =>
ByteString
-> ByteString
-> ByteString
-> Token
-> (Int -> err -> Exception)
-> Maybe a
-> IO b
genericQuery ByteString
"GET" ByteString
"mailtrap.io" ByteString
"/api/accounts" Token
token Int -> JSONResp "error" Text -> Exception
singleError Maybe ()
noBody

-- | 'EmailAddress' wrapper to provide 'ToJSON' and 'FromJSON' instances.
newtype EmailAddressJSON = EmailAddressJSON { EmailAddressJSON -> EmailAddress
fromEmailAddressJSON :: EmailAddress }

instance ToJSON EmailAddressJSON where
  toJSON :: EmailAddressJSON -> Value
toJSON = Text -> Value
JSON.String forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. EmailAddress -> ByteString
Email.toByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. EmailAddressJSON -> EmailAddress
fromEmailAddressJSON

instance FromJSON EmailAddressJSON where
  parseJSON :: Value -> Parser EmailAddressJSON
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
JSON.withText String
"EmailAddressJSON" forall a b. (a -> b) -> a -> b
$ \Text
t ->
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => String -> m a
fail (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. EmailAddress -> EmailAddressJSON
EmailAddressJSON) forall a b. (a -> b) -> a -> b
$ ByteString -> Either String EmailAddress
Email.validate forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
t

-- | An e-mail address with a name.
data NamedEmailAddress = NamedEmailAddress
  { NamedEmailAddress -> EmailAddress
emailAddress :: EmailAddress
  , NamedEmailAddress -> Text
emailAddressName :: Text 
    } deriving Int -> NamedEmailAddress -> ShowS
[NamedEmailAddress] -> ShowS
NamedEmailAddress -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NamedEmailAddress] -> ShowS
$cshowList :: [NamedEmailAddress] -> ShowS
show :: NamedEmailAddress -> String
$cshow :: NamedEmailAddress -> String
showsPrec :: Int -> NamedEmailAddress -> ShowS
$cshowsPrec :: Int -> NamedEmailAddress -> ShowS
Show

instance ToJSON NamedEmailAddress where
  toJSON :: NamedEmailAddress -> Value
toJSON NamedEmailAddress
addr = [Pair] -> Value
JSON.object
    [ Key
"email" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= EmailAddress -> EmailAddressJSON
EmailAddressJSON (NamedEmailAddress -> EmailAddress
emailAddress NamedEmailAddress
addr)
    , Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= NamedEmailAddress -> Text
emailAddressName NamedEmailAddress
addr
      ]

-- | Attempt to parse an e-mail address
parseEmailAddress :: ByteString -> Either String EmailAddress
parseEmailAddress :: ByteString -> Either String EmailAddress
parseEmailAddress = ByteString -> Either String EmailAddress
Email.validate

-- | Attachment disposition.
data Disposition =
    -- | Inline with identifier.
    Inline Text
  | Attached
    deriving Int -> Disposition -> ShowS
[Disposition] -> ShowS
Disposition -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Disposition] -> ShowS
$cshowList :: [Disposition] -> ShowS
show :: Disposition -> String
$cshow :: Disposition -> String
showsPrec :: Int -> Disposition -> ShowS
$cshowsPrec :: Int -> Disposition -> ShowS
Show

-- | File that can be attached to an e-mail.
data Attachment = Attachment
  { -- | File name.
    Attachment -> Text
attachment_name :: Text
    -- | MIME type of the content.
  , Attachment -> ByteString
attachment_type :: MimeType
    -- | Attachment content.
  , Attachment -> ByteString
attachment_content :: ByteString
    -- | Attachment disposition.
  , Attachment -> Disposition
attachment_disposition :: Disposition
    } deriving Int -> Attachment -> ShowS
[Attachment] -> ShowS
Attachment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Attachment] -> ShowS
$cshowList :: [Attachment] -> ShowS
show :: Attachment -> String
$cshow :: Attachment -> String
showsPrec :: Int -> Attachment -> ShowS
$cshowsPrec :: Int -> Attachment -> ShowS
Show

-- | Create an attachment from a file. It guesses the mime type from
--   the file extension. Disposition is set to 'Attached'.
--   The file is read strictly.
attachmentFromFile :: FilePath -> IO Attachment
attachmentFromFile :: String -> IO Attachment
attachmentFromFile String
fp = do
  let fptext :: Text
      fptext :: Text
fptext = String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ ShowS
takeFileName String
fp
  ByteString
bytes <- String -> IO ByteString
ByteString.readFile String
fp
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Attachment
    { attachment_name :: Text
attachment_name = Text
fptext
    , attachment_type :: ByteString
attachment_type = Text -> ByteString
defaultMimeLookup Text
fptext
    , attachment_content :: ByteString
attachment_content = ByteString
bytes
    , attachment_disposition :: Disposition
attachment_disposition = Disposition
Attached
      }

-- | Set an attachment's disposition.
setDisposition :: Disposition -> Attachment -> Attachment
setDisposition :: Disposition -> Attachment -> Attachment
setDisposition Disposition
d Attachment
a = Attachment
a { attachment_disposition :: Disposition
attachment_disposition = Disposition
d }

instance ToJSON Attachment where
  toJSON :: Attachment -> Value
toJSON Attachment
att = [Pair] -> Value
JSON.object forall a b. (a -> b) -> a -> b
$
    [ Key
"filename" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Attachment -> Text
attachment_name Attachment
att
    , Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ByteString -> Text
decodeUtf8 (Attachment -> ByteString
attachment_type Attachment
att)
    , Key
"content" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ByteString -> Text
encodeBase64 (Attachment -> ByteString
attachment_content Attachment
att)
    , Key
"disposition" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=
      (case Attachment -> Disposition
attachment_disposition Attachment
att of
         Inline Text
_ -> Text
"inline" :: Text
         Disposition
Attached -> Text
"attachment"
         )
      ] forall a. [a] -> [a] -> [a]
++ (case Attachment -> Disposition
attachment_disposition Attachment
att of
              Inline Text
i -> [ Key
"content_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
i ]
              Disposition
Attached -> []
              )

-- | An e-mail body.
data EmailBody =
    -- | Plain-text body.
    PlainTextBody Text
    -- | HTML-only body.
  | HTMLOnlyBody Html
    -- | HTML body with text fallback.
  | HTMLBody Html Text

-- | E-mail message, including subject and body.
data Message = Message
  { Message -> Text
message_subject :: Text
  , Message -> EmailBody
message_body :: EmailBody
    -- | Message category.
  , Message -> Text
message_category :: Text
    }

-- | Template that can be used when sending e-mails.
data Template = Template
  { -- | ID of the template.
    Template -> UUID
template_id :: UUID
    -- | Template variable assignments.
  , Template -> Object
template_variables :: JSON.Object
    } deriving Int -> Template -> ShowS
[Template] -> ShowS
Template -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Template] -> ShowS
$cshowList :: [Template] -> ShowS
show :: Template -> String
$cshow :: Template -> String
showsPrec :: Int -> Template -> ShowS
$cshowsPrec :: Int -> Template -> ShowS
Show

-- | Template with no variable set.
template :: UUID -> Template
#if MIN_VERSION_aeson(2,0,0)
template :: UUID -> Template
template UUID
i = UUID -> Object -> Template
Template UUID
i forall v. KeyMap v
KeyMap.empty
#else
template i = Template i HashMap.empty
#endif

-- | Set template variable.
setTemplateVariable :: ToJSON a => Text -> a -> Template -> Template
setTemplateVariable :: forall a. ToJSON a => Text -> a -> Template -> Template
setTemplateVariable Text
k a
x Template
t =
#if MIN_VERSION_aeson(2,0,0)
  Template
t { template_variables :: Object
template_variables = forall v. Key -> v -> KeyMap v -> KeyMap v
KeyMap.insert (Text -> Key
Key.fromText Text
k) (forall a. ToJSON a => a -> Value
JSON.toJSON a
x) forall a b. (a -> b) -> a -> b
$ Template -> Object
template_variables Template
t }
#else
  t { template_variables = HashMap.insert k (JSON.toJSON x) $ template_variables t }
#endif

-- | E-mail that can be sent using 'sendEmail'.
data Email = Email
  { -- | Sender address.
    Email -> NamedEmailAddress
email_from :: NamedEmailAddress
    -- | Recipient list. Max 1000.
  , Email -> [NamedEmailAddress]
email_to :: [NamedEmailAddress]
    -- | Carbon Copy recipients.
  , Email -> [NamedEmailAddress]
email_cc :: [NamedEmailAddress]
    -- | Blind Carbon Copy recipients.
  , Email -> [NamedEmailAddress]
email_bcc :: [NamedEmailAddress]
    -- | Files attached to the e-mail.
  , Email -> [Attachment]
email_attachments :: [Attachment]
    -- | Custom JSON object.
  , Email -> Object
email_custom :: JSON.Object
    -- | Message to send.
  , Email -> Either Template Message
email_message :: Either Template Message
    }

instance ToJSON Email where
  toJSON :: Email -> Value
toJSON Email
email = [Pair] -> Value
JSON.object forall a b. (a -> b) -> a -> b
$
    [ Key
"from" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Email -> NamedEmailAddress
email_from Email
email
    , Key
"to" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Email -> [NamedEmailAddress]
email_to Email
email
    , Key
"cc" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Email -> [NamedEmailAddress]
email_cc Email
email
    , Key
"bcc" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Email -> [NamedEmailAddress]
email_bcc Email
email
    , Key
"attachments" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Email -> [Attachment]
email_attachments Email
email
    , Key
"custom_variables" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Email -> Object
email_custom Email
email
      ] forall a. [a] -> [a] -> [a]
++ (case Email -> Either Template Message
email_message Email
email of
              Left Template
temp ->
                [ Key
"template_uuid" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Template -> UUID
template_id Template
temp
                , Key
"template_variables" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Template -> Object
template_variables Template
temp
                  ]
              Right Message
msg ->
                [ Key
"subject" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Message -> Text
message_subject Message
msg
                , Key
"category" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Message -> Text
message_category Message
msg
                  ] forall a. [a] -> [a] -> [a]
++ (case Message -> EmailBody
message_body Message
msg of
                          PlainTextBody Text
t -> [ Key
"text" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
t ]
                          HTMLOnlyBody Html
h -> [ Key
"html" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Html -> Text
renderHtml Html
h ]
                          HTMLBody Html
h Text
t -> [ Key
"html" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Html -> Text
renderHtml Html
h, Key
"text" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
t ]
                          )
              )

-- | Testing inbox identifier.
newtype InboxID = InboxID Int deriving (InboxID -> InboxID -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InboxID -> InboxID -> Bool
$c/= :: InboxID -> InboxID -> Bool
== :: InboxID -> InboxID -> Bool
$c== :: InboxID -> InboxID -> Bool
Eq, Int -> InboxID -> ShowS
[InboxID] -> ShowS
InboxID -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InboxID] -> ShowS
$cshowList :: [InboxID] -> ShowS
show :: InboxID -> String
$cshow :: InboxID -> String
showsPrec :: Int -> InboxID -> ShowS
$cshowsPrec :: Int -> InboxID -> ShowS
Show, Value -> Parser [InboxID]
Value -> Parser InboxID
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [InboxID]
$cparseJSONList :: Value -> Parser [InboxID]
parseJSON :: Value -> Parser InboxID
$cparseJSON :: Value -> Parser InboxID
FromJSON)

-- | Testing inbox.
data Inbox = Inbox
  { Inbox -> InboxID
inbox_id :: InboxID
  , Inbox -> Text
inbox_name :: Text
    -- | Number of emails in the inbox.
  , Inbox -> Int
inbox_emailCount :: Int
    -- | Number of unread emails in the inbox.
  , Inbox -> Int
inbox_unreadCount :: Int
  , Inbox -> Int
inbox_maxSize :: Int
    } deriving Int -> Inbox -> ShowS
[Inbox] -> ShowS
Inbox -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Inbox] -> ShowS
$cshowList :: [Inbox] -> ShowS
show :: Inbox -> String
$cshow :: Inbox -> String
showsPrec :: Int -> Inbox -> ShowS
$cshowsPrec :: Int -> Inbox -> ShowS
Show

instance FromJSON Inbox where
  parseJSON :: Value -> Parser Inbox
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"Inbox" forall a b. (a -> b) -> a -> b
$ \Object
o -> InboxID -> Text -> Int -> Int -> Int -> Inbox
Inbox
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"emails_count"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"emails_unread_count"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"max_size"

-- | Get all inboxes from an account.
getInboxes :: Token -> AccountID -> IO [Inbox]
getInboxes :: Token -> AccountID -> IO [Inbox]
getInboxes Token
token (AccountID Int
i) =
  let path :: ByteString
path = forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ String
"/api/accounts/" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
i forall a. [a] -> [a] -> [a]
++ String
"/inboxes"
  in  forall err a b.
(FromJSON err, ToJSON a, FromJSON b) =>
ByteString
-> ByteString
-> ByteString
-> Token
-> (Int -> err -> Exception)
-> Maybe a
-> IO b
genericQuery ByteString
"GET" ByteString
"mailtrap.io" ByteString
path Token
token Int -> JSONResp "error" Text -> Exception
singleError Maybe ()
noBody

-- | Inbox message identifier.
newtype InboxMessageID = InboxMessageID Int deriving (InboxMessageID -> InboxMessageID -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InboxMessageID -> InboxMessageID -> Bool
$c/= :: InboxMessageID -> InboxMessageID -> Bool
== :: InboxMessageID -> InboxMessageID -> Bool
$c== :: InboxMessageID -> InboxMessageID -> Bool
Eq, Int -> InboxMessageID -> ShowS
[InboxMessageID] -> ShowS
InboxMessageID -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InboxMessageID] -> ShowS
$cshowList :: [InboxMessageID] -> ShowS
show :: InboxMessageID -> String
$cshow :: InboxMessageID -> String
showsPrec :: Int -> InboxMessageID -> ShowS
$cshowsPrec :: Int -> InboxMessageID -> ShowS
Show, Value -> Parser [InboxMessageID]
Value -> Parser InboxMessageID
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [InboxMessageID]
$cparseJSONList :: Value -> Parser [InboxMessageID]
parseJSON :: Value -> Parser InboxMessageID
$cparseJSON :: Value -> Parser InboxMessageID
FromJSON)

-- | A message in a testing inbox.
data InboxMessage = InboxMessage
  { InboxMessage -> InboxMessageID
inboxMessage_id :: InboxMessageID
  , InboxMessage -> InboxID
inboxMessage_inbox :: InboxID
  , InboxMessage -> UTCTime
inboxMessage_sentAt :: UTCTime
  , InboxMessage -> EmailAddress
inboxMessage_from :: EmailAddress
  , InboxMessage -> EmailAddress
inboxMessage_to :: EmailAddress
  , InboxMessage -> Text
inboxMessage_subject :: Text
  , InboxMessage -> Bool
inboxMessage_isRead :: Bool
    } deriving Int -> InboxMessage -> ShowS
[InboxMessage] -> ShowS
InboxMessage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InboxMessage] -> ShowS
$cshowList :: [InboxMessage] -> ShowS
show :: InboxMessage -> String
$cshow :: InboxMessage -> String
showsPrec :: Int -> InboxMessage -> ShowS
$cshowsPrec :: Int -> InboxMessage -> ShowS
Show

instance FromJSON InboxMessage where
  parseJSON :: Value -> Parser InboxMessage
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"InboxMessage" forall a b. (a -> b) -> a -> b
$ \Object
o -> InboxMessageID
-> InboxID
-> UTCTime
-> EmailAddress
-> EmailAddress
-> Text
-> Bool
-> InboxMessage
InboxMessage
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"inbox_id"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"sent_at"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (EmailAddressJSON -> EmailAddress
fromEmailAddressJSON forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"from_email")
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (EmailAddressJSON -> EmailAddress
fromEmailAddressJSON forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"to_email")
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"subject"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"is_read"

-- | Get all inbox messages from an testing inbox.
getInboxMessages :: Token -> AccountID -> InboxID -> IO [InboxMessage]
getInboxMessages :: Token -> AccountID -> InboxID -> IO [InboxMessage]
getInboxMessages Token
token (AccountID Int
accid) (InboxID Int
inboxid) =
  let path :: ByteString
path = forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ String
"/api/accounts/" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
accid
          forall a. [a] -> [a] -> [a]
++ String
"/inboxes/" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
inboxid forall a. [a] -> [a] -> [a]
++ String
"/messages"
  in  forall err a b.
(FromJSON err, ToJSON a, FromJSON b) =>
ByteString
-> ByteString
-> ByteString
-> Token
-> (Int -> err -> Exception)
-> Maybe a
-> IO b
genericQuery ByteString
"GET" ByteString
"mailtrap.io" ByteString
path Token
token Int -> JSONResp "error" Text -> Exception
singleError Maybe ()
noBody

-- | Generic function to implement all the message download functions in one place.
downloadMessageGeneric
  :: String -- ^ Extension
  -> Token -> AccountID -> InboxID -> InboxMessageID -> IO Text
downloadMessageGeneric :: String
-> Token -> AccountID -> InboxID -> InboxMessageID -> IO Text
downloadMessageGeneric String
ext Token
token (AccountID Int
accid) (InboxID Int
inboxid) (InboxMessageID Int
msgid) =
  let path :: ByteString
path = forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ String
"/api/accounts/" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
accid
          forall a. [a] -> [a] -> [a]
++ String
"/inboxes/" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
inboxid
          forall a. [a] -> [a] -> [a]
++ String
"/messages/" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
msgid
          forall a. [a] -> [a] -> [a]
++ String
"/body." forall a. [a] -> [a] -> [a]
++ String
ext
  in  ByteString -> Text
decodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> ByteString -> Token -> IO ByteString
genericDownload ByteString
"mailtrap.io" ByteString
path Token
token

-- | Download inbox message raw email body.
downloadMessageRaw :: Token -> AccountID -> InboxID -> InboxMessageID -> IO Text
downloadMessageRaw :: Token -> AccountID -> InboxID -> InboxMessageID -> IO Text
downloadMessageRaw = String
-> Token -> AccountID -> InboxID -> InboxMessageID -> IO Text
downloadMessageGeneric String
"raw"

-- | Download inbox message in EML format.
downloadMessageEML :: Token -> AccountID -> InboxID -> InboxMessageID -> IO Text
downloadMessageEML :: Token -> AccountID -> InboxID -> InboxMessageID -> IO Text
downloadMessageEML = String
-> Token -> AccountID -> InboxID -> InboxMessageID -> IO Text
downloadMessageGeneric String
"eml"

-- | Download inbox message text part.
downloadMessageText :: Token -> AccountID -> InboxID -> InboxMessageID -> IO Text
downloadMessageText :: Token -> AccountID -> InboxID -> InboxMessageID -> IO Text
downloadMessageText = String
-> Token -> AccountID -> InboxID -> InboxMessageID -> IO Text
downloadMessageGeneric String
"txt"

-- | Download inbox message HTML part.
downloadMessageHTML :: Token -> AccountID -> InboxID -> InboxMessageID -> IO Text
downloadMessageHTML :: Token -> AccountID -> InboxID -> InboxMessageID -> IO Text
downloadMessageHTML = String
-> Token -> AccountID -> InboxID -> InboxMessageID -> IO Text
downloadMessageGeneric String
"html"

-- | Production message identifier.
newtype MessageID = MessageID UUID deriving (MessageID -> MessageID -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MessageID -> MessageID -> Bool
$c/= :: MessageID -> MessageID -> Bool
== :: MessageID -> MessageID -> Bool
$c== :: MessageID -> MessageID -> Bool
Eq, Int -> MessageID -> ShowS
[MessageID] -> ShowS
MessageID -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MessageID] -> ShowS
$cshowList :: [MessageID] -> ShowS
show :: MessageID -> String
$cshow :: MessageID -> String
showsPrec :: Int -> MessageID -> ShowS
$cshowsPrec :: Int -> MessageID -> ShowS
Show, Value -> Parser [MessageID]
Value -> Parser MessageID
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [MessageID]
$cparseJSONList :: Value -> Parser [MessageID]
parseJSON :: Value -> Parser MessageID
$cparseJSON :: Value -> Parser MessageID
FromJSON)

-- | Send an e-mail and return the list of IDs of the messages sent (one per recipient).
sendEmail :: Token -> Email -> IO [MessageID]
sendEmail :: Token -> Email -> IO [MessageID]
sendEmail = forall a. FromJSON a => Maybe InboxID -> Token -> Email -> IO [a]
genericSendEmail forall a. Maybe a
Nothing

-- | Send a testing e-mail to the given inbox and return the list of IDs of the messages
--   sent (one per recipient).
sendTestEmail :: Token -> InboxID -> Email -> IO [InboxMessageID]
sendTestEmail :: Token -> InboxID -> Email -> IO [InboxMessageID]
sendTestEmail Token
token InboxID
i = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. AsText a -> a
asText) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => Maybe InboxID -> Token -> Email -> IO [a]
genericSendEmail (forall a. a -> Maybe a
Just InboxID
i) Token
token

-- | Unified implementation for sending testing and production e-mails.
genericSendEmail :: FromJSON a => Maybe InboxID -> Token -> Email -> IO [a]
genericSendEmail :: forall a. FromJSON a => Maybe InboxID -> Token -> Email -> IO [a]
genericSendEmail Maybe InboxID
minbox Token
token Email
email =
  let url :: ByteString
url = case Maybe InboxID
minbox of
              Maybe InboxID
Nothing -> ByteString
"send.api.mailtrap.io"
              Maybe InboxID
_ -> ByteString
"sandbox.api.mailtrap.io"
      path :: ByteString
path = case Maybe InboxID
minbox of
               Just (InboxID Int
i) -> forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ String
"/api/send/" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
i
               Maybe InboxID
Nothing -> ByteString
"/api/send"
  in  forall (k :: Symbol) a. JSONResp k a -> a
fromJSONResp @"message_ids" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall err a b.
(FromJSON err, ToJSON a, FromJSON b) =>
ByteString
-> ByteString
-> ByteString
-> Token
-> (Int -> err -> Exception)
-> Maybe a
-> IO b
genericQuery ByteString
"POST" ByteString
url ByteString
path Token
token Int -> JSONResp "errors" [Text] -> Exception
multipleErrors (forall a. a -> Maybe a
Just Email
email)