----------------------------------------------------------------------------------------------------
-- | 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)
#if MIN_VERSION_base64(1,0,0)
import Data.Base64.Types (extractBase64)
#endif
-- 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
(Token -> Token -> Bool) -> (Token -> Token -> Bool) -> Eq Token
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Token -> Token -> Bool
== :: Token -> Token -> Bool
$c/= :: Token -> Token -> Bool
/= :: Token -> Token -> Bool
Eq, Int -> Token -> ShowS
[Token] -> ShowS
Token -> String
(Int -> Token -> ShowS)
-> (Token -> String) -> ([Token] -> ShowS) -> Show Token
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Token -> ShowS
showsPrec :: Int -> Token -> ShowS
$cshow :: Token -> String
show :: Token -> String
$cshowList :: [Token] -> ShowS
showList :: [Token] -> ShowS
Show)

instance FromJSON Token where
  parseJSON :: Value -> Parser Token
parseJSON = String -> (Text -> Parser Token) -> Value -> Parser Token
forall a. String -> (Text -> Parser a) -> Value -> Parser a
JSON.withText String
"Mailtrap Token" (Token -> Parser Token
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Token -> Parser Token) -> (Text -> Token) -> Text -> Parser Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Token
Token)

instance ToJSON Token where
  toJSON :: Token -> Value
toJSON (Token Text
token) = Text -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON Text
token

-- | 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
(Int -> Exception -> ShowS)
-> (Exception -> String)
-> ([Exception] -> ShowS)
-> Show Exception
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Exception -> ShowS
showsPrec :: Int -> Exception -> ShowS
$cshow :: Exception -> String
show :: Exception -> String
$cshowList :: [Exception] -> ShowS
showList :: [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 = String -> Key
forall a. IsString a => String -> a
fromString (String -> Key) -> String -> Key
forall a b. (a -> b) -> a -> b
$ Proxy k -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy k -> String) -> Proxy k -> String
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @k
    in  String
-> (Object -> Parser (JSONResp k a))
-> Value
-> Parser (JSONResp k a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"JSONResp" ((Object -> Parser (JSONResp k a))
 -> Value -> Parser (JSONResp k a))
-> (Object -> Parser (JSONResp k a))
-> Value
-> Parser (JSONResp k a)
forall a b. (a -> b) -> a -> b
$ (a -> JSONResp k a) -> Parser a -> Parser (JSONResp k a)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> JSONResp k a
forall (k :: Symbol) a. a -> JSONResp k a
JSONResp (Parser a -> Parser (JSONResp k a))
-> (Object -> Parser a) -> Object -> Parser (JSONResp k a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Object -> Key -> Parser a
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 = String -> (Text -> Parser (AsText a)) -> Value -> Parser (AsText a)
forall a. String -> (Text -> Parser a) -> Value -> Parser a
JSON.withText String
"AsText" ((Text -> Parser (AsText a)) -> Value -> Parser (AsText a))
-> (Text -> Parser (AsText a)) -> Value -> Parser (AsText a)
forall a b. (a -> b) -> a -> b
$
    (String -> Parser (AsText a))
-> (a -> Parser (AsText a)) -> Either String a -> Parser (AsText a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser (AsText a)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (AsText a -> Parser (AsText a)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AsText a -> Parser (AsText a))
-> (a -> AsText a) -> a -> Parser (AsText a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> AsText a
forall a. a -> AsText a
AsText) (Either String a -> Parser (AsText a))
-> (Text -> Either String a) -> Text -> Parser (AsText a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
JSON.eitherDecodeStrict (ByteString -> Either String a)
-> (Text -> ByteString) -> Text -> Either String a
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
          (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ ByteString -> Request -> Request
HTTP.setRequestHost ByteString
url
          (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ Int -> Request -> Request
HTTP.setRequestPort Int
443
          (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ ByteString -> Request -> Request
HTTP.setRequestPath ByteString
path
          (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ Bool -> Request -> Request
HTTP.setRequestSecure Bool
True
          (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ (Request -> Request)
-> (a -> Request -> Request) -> Maybe a -> Request -> Request
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Request -> Request
forall a. a -> a
id a -> Request -> Request
forall a. ToJSON a => a -> Request -> Request
HTTP.setRequestBodyJSON Maybe a
mbody
          (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ HeaderName -> ByteString -> Request -> Request
HTTP.addRequestHeader HeaderName
"Api-Token" (Text -> ByteString
encodeUtf8 Text
token)
          (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ Request
HTTP.defaultRequest
  Response ByteString
resp <- Request -> IO (Response ByteString)
forall (m :: * -> *).
MonadIO m =>
Request -> m (Response ByteString)
HTTP.httpBS Request
req
  let code :: Int
code = Response ByteString -> Int
forall a. Response a -> Int
HTTP.getResponseStatusCode Response ByteString
resp
      body :: ByteString
body = Response ByteString -> ByteString
forall a. Response a -> a
HTTP.getResponseBody Response ByteString
resp
  case Int
code of
    Int
200 ->
      (String -> IO b) -> (b -> IO b) -> Either String b -> IO b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Exception -> IO b
forall e a. Exception e => e -> IO a
Base.throwIO (Exception -> IO b) -> (String -> Exception) -> String -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String -> Exception
ParsingError ByteString
body) b -> IO b
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String b -> IO b) -> Either String b -> IO b
forall a b. (a -> b) -> a -> b
$
        ByteString -> Either String b
forall a. FromJSON a => ByteString -> Either String a
JSON.eitherDecodeStrict ByteString
body
    Int
_ ->
      (String -> IO b) -> (err -> IO b) -> Either String err -> IO b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Exception -> IO b
forall e a. Exception e => e -> IO a
Base.throwIO (Exception -> IO b) -> (String -> Exception) -> String -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String -> Exception
ParsingError ByteString
body) (Exception -> IO b
forall e a. Exception e => e -> IO a
Base.throwIO (Exception -> IO b) -> (err -> Exception) -> err -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> err -> Exception
ferr Int
code) (Either String err -> IO b) -> Either String err -> IO b
forall a b. (a -> b) -> a -> b
$
        ByteString -> Either String err
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 = Maybe ()
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"
          (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ ByteString -> Request -> Request
HTTP.setRequestHost ByteString
url
          (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ Int -> Request -> Request
HTTP.setRequestPort Int
443
          (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ ByteString -> Request -> Request
HTTP.setRequestPath ByteString
path
          (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ Bool -> Request -> Request
HTTP.setRequestSecure Bool
True
          (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ HeaderName -> ByteString -> Request -> Request
HTTP.addRequestHeader HeaderName
"Api-Token" (Text -> ByteString
encodeUtf8 Text
token)
          (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ Request
HTTP.defaultRequest
  Response ByteString
resp <- Request -> IO (Response ByteString)
forall (m :: * -> *).
MonadIO m =>
Request -> m (Response ByteString)
HTTP.httpBS Request
req
  let code :: Int
code = Response ByteString -> Int
forall a. Response a -> Int
HTTP.getResponseStatusCode Response ByteString
resp
      body :: ByteString
body = Response ByteString -> ByteString
forall a. Response a -> a
HTTP.getResponseBody Response ByteString
resp
  case Int
code of
    Int
200 -> ByteString -> IO ByteString
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
body
    Int
404 -> Exception -> IO ByteString
forall e a. Exception e => e -> IO a
Base.throwIO (Exception -> IO ByteString) -> Exception -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Exception
SingleError Int
404 Text
"File not found."
    Int
_ ->
      (String -> IO ByteString)
-> (JSONResp "error" Text -> IO ByteString)
-> Either String (JSONResp "error" Text)
-> IO ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Exception -> IO ByteString
forall e a. Exception e => e -> IO a
Base.throwIO (Exception -> IO ByteString)
-> (String -> Exception) -> String -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String -> Exception
ParsingError ByteString
body) (Exception -> IO ByteString
forall e a. Exception e => e -> IO a
Base.throwIO (Exception -> IO ByteString)
-> (JSONResp "error" Text -> Exception)
-> JSONResp "error" Text
-> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> JSONResp "error" Text -> Exception
singleError Int
code) (Either String (JSONResp "error" Text) -> IO ByteString)
-> Either String (JSONResp "error" Text) -> IO ByteString
forall a b. (a -> b) -> a -> b
$
        ByteString -> Either String (JSONResp "error" Text)
forall a. FromJSON a => ByteString -> Either String a
JSON.eitherDecodeStrict ByteString
body

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

instance FromJSON Account where
  parseJSON :: Value -> Parser Account
parseJSON = String -> (Object -> Parser Account) -> Value -> Parser Account
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"Account" ((Object -> Parser Account) -> Value -> Parser Account)
-> (Object -> Parser Account) -> Value -> Parser Account
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    AccountID -> Text -> Account
Account (AccountID -> Text -> Account)
-> Parser AccountID -> Parser (Text -> Account)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser AccountID
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id" Parser (Text -> Account) -> Parser Text -> Parser Account
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
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 = ByteString
-> ByteString
-> ByteString
-> Token
-> (Int -> JSONResp "error" Text -> Exception)
-> Maybe ()
-> IO [Account]
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 (Text -> Value)
-> (EmailAddressJSON -> Text) -> EmailAddressJSON -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8 (ByteString -> Text)
-> (EmailAddressJSON -> ByteString) -> EmailAddressJSON -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EmailAddress -> ByteString
Email.toByteString (EmailAddress -> ByteString)
-> (EmailAddressJSON -> EmailAddress)
-> EmailAddressJSON
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EmailAddressJSON -> EmailAddress
fromEmailAddressJSON

instance FromJSON EmailAddressJSON where
  parseJSON :: Value -> Parser EmailAddressJSON
parseJSON = String
-> (Text -> Parser EmailAddressJSON)
-> Value
-> Parser EmailAddressJSON
forall a. String -> (Text -> Parser a) -> Value -> Parser a
JSON.withText String
"EmailAddressJSON" ((Text -> Parser EmailAddressJSON)
 -> Value -> Parser EmailAddressJSON)
-> (Text -> Parser EmailAddressJSON)
-> Value
-> Parser EmailAddressJSON
forall a b. (a -> b) -> a -> b
$ \Text
t ->
    (String -> Parser EmailAddressJSON)
-> (EmailAddress -> Parser EmailAddressJSON)
-> Either String EmailAddress
-> Parser EmailAddressJSON
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser EmailAddressJSON
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (EmailAddressJSON -> Parser EmailAddressJSON
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EmailAddressJSON -> Parser EmailAddressJSON)
-> (EmailAddress -> EmailAddressJSON)
-> EmailAddress
-> Parser EmailAddressJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EmailAddress -> EmailAddressJSON
EmailAddressJSON) (Either String EmailAddress -> Parser EmailAddressJSON)
-> Either String EmailAddress -> Parser EmailAddressJSON
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String EmailAddress
Email.validate (ByteString -> Either String EmailAddress)
-> ByteString -> Either String EmailAddress
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
(Int -> NamedEmailAddress -> ShowS)
-> (NamedEmailAddress -> String)
-> ([NamedEmailAddress] -> ShowS)
-> Show NamedEmailAddress
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NamedEmailAddress -> ShowS
showsPrec :: Int -> NamedEmailAddress -> ShowS
$cshow :: NamedEmailAddress -> String
show :: NamedEmailAddress -> String
$cshowList :: [NamedEmailAddress] -> ShowS
showList :: [NamedEmailAddress] -> ShowS
Show

instance ToJSON NamedEmailAddress where
  toJSON :: NamedEmailAddress -> Value
toJSON NamedEmailAddress
addr = [Pair] -> Value
JSON.object
    [ Key
"email" Key -> EmailAddressJSON -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= EmailAddress -> EmailAddressJSON
EmailAddressJSON (NamedEmailAddress -> EmailAddress
emailAddress NamedEmailAddress
addr)
    , Key
"name" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e 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
(Int -> Disposition -> ShowS)
-> (Disposition -> String)
-> ([Disposition] -> ShowS)
-> Show Disposition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Disposition -> ShowS
showsPrec :: Int -> Disposition -> ShowS
$cshow :: Disposition -> String
show :: Disposition -> String
$cshowList :: [Disposition] -> ShowS
showList :: [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
(Int -> Attachment -> ShowS)
-> (Attachment -> String)
-> ([Attachment] -> ShowS)
-> Show Attachment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Attachment -> ShowS
showsPrec :: Int -> Attachment -> ShowS
$cshow :: Attachment -> String
show :: Attachment -> String
$cshowList :: [Attachment] -> ShowS
showList :: [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 (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ShowS
takeFileName String
fp
  ByteString
bytes <- String -> IO ByteString
ByteString.readFile String
fp
  Attachment -> IO Attachment
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Attachment -> IO Attachment) -> Attachment -> IO Attachment
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 = d }

instance ToJSON Attachment where
  toJSON :: Attachment -> Value
toJSON Attachment
att = [Pair] -> Value
JSON.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
    [ Key
"filename" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Attachment -> Text
attachment_name Attachment
att
    , Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ByteString -> Text
decodeUtf8 (Attachment -> ByteString
attachment_type Attachment
att)
#if MIN_VERSION_base64(1,0,0)
    , Key
"content" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Base64 'StdPadded Text -> Text
forall (k :: Alphabet) a. Base64 k a -> a
extractBase64 (ByteString -> Base64 'StdPadded Text
encodeBase64 (ByteString -> Base64 'StdPadded Text)
-> ByteString -> Base64 'StdPadded Text
forall a b. (a -> b) -> a -> b
$ Attachment -> ByteString
attachment_content Attachment
att)
#else
    , "content" .= encodeBase64 (attachment_content att)
#endif
    , Key
"disposition" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.=
      (case Attachment -> Disposition
attachment_disposition Attachment
att of
         Inline Text
_ -> Text
"inline" :: Text
         Disposition
Attached -> Text
"attachment"
         )
      ] [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ (case Attachment -> Disposition
attachment_disposition Attachment
att of
              Inline Text
i -> [ Key
"content_id" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e 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
(Int -> Template -> ShowS)
-> (Template -> String) -> ([Template] -> ShowS) -> Show Template
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Template -> ShowS
showsPrec :: Int -> Template -> ShowS
$cshow :: Template -> String
show :: Template -> String
$cshowList :: [Template] -> ShowS
showList :: [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 Object
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 = KeyMap.insert (Key.fromText k) (JSON.toJSON x) $ template_variables 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 ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
    [ Key
"from" Key -> NamedEmailAddress -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Email -> NamedEmailAddress
email_from Email
email
    , Key
"to" Key -> [NamedEmailAddress] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Email -> [NamedEmailAddress]
email_to Email
email
    , Key
"cc" Key -> [NamedEmailAddress] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Email -> [NamedEmailAddress]
email_cc Email
email
    , Key
"bcc" Key -> [NamedEmailAddress] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Email -> [NamedEmailAddress]
email_bcc Email
email
    , Key
"attachments" Key -> [Attachment] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Email -> [Attachment]
email_attachments Email
email
    , Key
"custom_variables" Key -> Object -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Email -> Object
email_custom Email
email
      ] [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ (case Email -> Either Template Message
email_message Email
email of
              Left Template
temp ->
                [ Key
"template_uuid" Key -> UUID -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Template -> UUID
template_id Template
temp
                , Key
"template_variables" Key -> Object -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Template -> Object
template_variables Template
temp
                  ]
              Right Message
msg ->
                [ Key
"subject" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Message -> Text
message_subject Message
msg
                , Key
"category" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Message -> Text
message_category Message
msg
                  ] [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ (case Message -> EmailBody
message_body Message
msg of
                          PlainTextBody Text
t -> [ Key
"text" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
t ]
                          HTMLOnlyBody Html
h -> [ Key
"html" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Html -> Text
renderHtml Html
h ]
                          HTMLBody Html
h Text
t -> [ Key
"html" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Html -> Text
renderHtml Html
h, Key
"text" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
t ]
                          )
              )

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

instance FromJSON Inbox where
  parseJSON :: Value -> Parser Inbox
parseJSON = String -> (Object -> Parser Inbox) -> Value -> Parser Inbox
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"Inbox" ((Object -> Parser Inbox) -> Value -> Parser Inbox)
-> (Object -> Parser Inbox) -> Value -> Parser Inbox
forall a b. (a -> b) -> a -> b
$ \Object
o -> InboxID -> Text -> Int -> Int -> Int -> Inbox
Inbox
    (InboxID -> Text -> Int -> Int -> Int -> Inbox)
-> Parser InboxID -> Parser (Text -> Int -> Int -> Int -> Inbox)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser InboxID
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
    Parser (Text -> Int -> Int -> Int -> Inbox)
-> Parser Text -> Parser (Int -> Int -> Int -> Inbox)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    Parser (Int -> Int -> Int -> Inbox)
-> Parser Int -> Parser (Int -> Int -> Inbox)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"emails_count"
    Parser (Int -> Int -> Inbox) -> Parser Int -> Parser (Int -> Inbox)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"emails_unread_count"
    Parser (Int -> Inbox) -> Parser Int -> Parser Inbox
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Int
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 = String -> ByteString
forall a. IsString a => String -> a
fromString (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String
"/api/accounts/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/inboxes"
  in  ByteString
-> ByteString
-> ByteString
-> Token
-> (Int -> JSONResp "error" Text -> Exception)
-> Maybe ()
-> IO [Inbox]
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
(InboxMessageID -> InboxMessageID -> Bool)
-> (InboxMessageID -> InboxMessageID -> Bool) -> Eq InboxMessageID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InboxMessageID -> InboxMessageID -> Bool
== :: InboxMessageID -> InboxMessageID -> Bool
$c/= :: InboxMessageID -> InboxMessageID -> Bool
/= :: InboxMessageID -> InboxMessageID -> Bool
Eq, Int -> InboxMessageID -> ShowS
[InboxMessageID] -> ShowS
InboxMessageID -> String
(Int -> InboxMessageID -> ShowS)
-> (InboxMessageID -> String)
-> ([InboxMessageID] -> ShowS)
-> Show InboxMessageID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InboxMessageID -> ShowS
showsPrec :: Int -> InboxMessageID -> ShowS
$cshow :: InboxMessageID -> String
show :: InboxMessageID -> String
$cshowList :: [InboxMessageID] -> ShowS
showList :: [InboxMessageID] -> ShowS
Show, Maybe InboxMessageID
Value -> Parser [InboxMessageID]
Value -> Parser InboxMessageID
(Value -> Parser InboxMessageID)
-> (Value -> Parser [InboxMessageID])
-> Maybe InboxMessageID
-> FromJSON InboxMessageID
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser InboxMessageID
parseJSON :: Value -> Parser InboxMessageID
$cparseJSONList :: Value -> Parser [InboxMessageID]
parseJSONList :: Value -> Parser [InboxMessageID]
$comittedField :: Maybe InboxMessageID
omittedField :: Maybe 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
(Int -> InboxMessage -> ShowS)
-> (InboxMessage -> String)
-> ([InboxMessage] -> ShowS)
-> Show InboxMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InboxMessage -> ShowS
showsPrec :: Int -> InboxMessage -> ShowS
$cshow :: InboxMessage -> String
show :: InboxMessage -> String
$cshowList :: [InboxMessage] -> ShowS
showList :: [InboxMessage] -> ShowS
Show

instance FromJSON InboxMessage where
  parseJSON :: Value -> Parser InboxMessage
parseJSON = String
-> (Object -> Parser InboxMessage) -> Value -> Parser InboxMessage
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"InboxMessage" ((Object -> Parser InboxMessage) -> Value -> Parser InboxMessage)
-> (Object -> Parser InboxMessage) -> Value -> Parser InboxMessage
forall a b. (a -> b) -> a -> b
$ \Object
o -> InboxMessageID
-> InboxID
-> UTCTime
-> EmailAddress
-> EmailAddress
-> Text
-> Bool
-> InboxMessage
InboxMessage
    (InboxMessageID
 -> InboxID
 -> UTCTime
 -> EmailAddress
 -> EmailAddress
 -> Text
 -> Bool
 -> InboxMessage)
-> Parser InboxMessageID
-> Parser
     (InboxID
      -> UTCTime
      -> EmailAddress
      -> EmailAddress
      -> Text
      -> Bool
      -> InboxMessage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser InboxMessageID
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
    Parser
  (InboxID
   -> UTCTime
   -> EmailAddress
   -> EmailAddress
   -> Text
   -> Bool
   -> InboxMessage)
-> Parser InboxID
-> Parser
     (UTCTime
      -> EmailAddress -> EmailAddress -> Text -> Bool -> InboxMessage)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser InboxID
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"inbox_id"
    Parser
  (UTCTime
   -> EmailAddress -> EmailAddress -> Text -> Bool -> InboxMessage)
-> Parser UTCTime
-> Parser
     (EmailAddress -> EmailAddress -> Text -> Bool -> InboxMessage)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser UTCTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"sent_at"
    Parser
  (EmailAddress -> EmailAddress -> Text -> Bool -> InboxMessage)
-> Parser EmailAddress
-> Parser (EmailAddress -> Text -> Bool -> InboxMessage)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (EmailAddressJSON -> EmailAddress
fromEmailAddressJSON (EmailAddressJSON -> EmailAddress)
-> Parser EmailAddressJSON -> Parser EmailAddress
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser EmailAddressJSON
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"from_email")
    Parser (EmailAddress -> Text -> Bool -> InboxMessage)
-> Parser EmailAddress -> Parser (Text -> Bool -> InboxMessage)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (EmailAddressJSON -> EmailAddress
fromEmailAddressJSON (EmailAddressJSON -> EmailAddress)
-> Parser EmailAddressJSON -> Parser EmailAddress
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser EmailAddressJSON
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"to_email")
    Parser (Text -> Bool -> InboxMessage)
-> Parser Text -> Parser (Bool -> InboxMessage)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"subject"
    Parser (Bool -> InboxMessage) -> Parser Bool -> Parser InboxMessage
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Bool
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 = String -> ByteString
forall a. IsString a => String -> a
fromString (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String
"/api/accounts/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
accid
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/inboxes/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
inboxid String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/messages"
  in  ByteString
-> ByteString
-> ByteString
-> Token
-> (Int -> JSONResp "error" Text -> Exception)
-> Maybe ()
-> IO [InboxMessage]
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 = String -> ByteString
forall a. IsString a => String -> a
fromString (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String
"/api/accounts/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
accid
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/inboxes/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
inboxid
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/messages/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
msgid
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/body." String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ext
  in  ByteString -> Text
decodeUtf8 (ByteString -> Text) -> IO ByteString -> IO Text
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
(MessageID -> MessageID -> Bool)
-> (MessageID -> MessageID -> Bool) -> Eq MessageID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MessageID -> MessageID -> Bool
== :: MessageID -> MessageID -> Bool
$c/= :: MessageID -> MessageID -> Bool
/= :: MessageID -> MessageID -> Bool
Eq, Int -> MessageID -> ShowS
[MessageID] -> ShowS
MessageID -> String
(Int -> MessageID -> ShowS)
-> (MessageID -> String)
-> ([MessageID] -> ShowS)
-> Show MessageID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MessageID -> ShowS
showsPrec :: Int -> MessageID -> ShowS
$cshow :: MessageID -> String
show :: MessageID -> String
$cshowList :: [MessageID] -> ShowS
showList :: [MessageID] -> ShowS
Show, Maybe MessageID
Value -> Parser [MessageID]
Value -> Parser MessageID
(Value -> Parser MessageID)
-> (Value -> Parser [MessageID])
-> Maybe MessageID
-> FromJSON MessageID
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser MessageID
parseJSON :: Value -> Parser MessageID
$cparseJSONList :: Value -> Parser [MessageID]
parseJSONList :: Value -> Parser [MessageID]
$comittedField :: Maybe MessageID
omittedField :: Maybe 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 = Maybe InboxID -> Token -> Email -> IO [MessageID]
forall a. FromJSON a => Maybe InboxID -> Token -> Email -> IO [a]
genericSendEmail Maybe InboxID
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 = ([AsText InboxMessageID] -> [InboxMessageID])
-> IO [AsText InboxMessageID] -> IO [InboxMessageID]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((AsText InboxMessageID -> InboxMessageID)
-> [AsText InboxMessageID] -> [InboxMessageID]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AsText InboxMessageID -> InboxMessageID
forall a. AsText a -> a
asText) (IO [AsText InboxMessageID] -> IO [InboxMessageID])
-> (Email -> IO [AsText InboxMessageID])
-> Email
-> IO [InboxMessageID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe InboxID -> Token -> Email -> IO [AsText InboxMessageID]
forall a. FromJSON a => Maybe InboxID -> Token -> Email -> IO [a]
genericSendEmail (InboxID -> Maybe InboxID
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) -> String -> ByteString
forall a. IsString a => String -> a
fromString (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String
"/api/send/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
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" (JSONResp "message_ids" [a] -> [a])
-> IO (JSONResp "message_ids" [a]) -> IO [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString
-> ByteString
-> ByteString
-> Token
-> (Int -> JSONResp "errors" [Text] -> Exception)
-> Maybe Email
-> IO (JSONResp "message_ids" [a])
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 (Email -> Maybe Email
forall a. a -> Maybe a
Just Email
email)