{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE RecordWildCards #-}
-- | Reference: https://docs.smtp.bz/#/api
--
-- The response bodies are really un(der)specified, so this library doesn't
-- try to do to much with them. You are on your own.
--
-- Functions' names map (trivially) to API routes. So, for some of them,
-- it's not obvious what they do from their name. This is by design.
module Smtpbz.Internal.Api
  ( user
  , userStats
  , userDomains
  , userDomain
  , userIPs
  , userIP
  , LogMessages(..)
  , logMessages
  , logMessage
  , Unsubscribe(..)
  , unsubscribe
  , unsubscribeAdd
  , unsubscribeRemove
  , unsubscribeRemoveAll
  , SmtpSend(..)
  , sendSmtp
  , checkEmail

  , successfulCall
  , debugPrintResponse
  ) where

import           Data.Bool (bool)
import           Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as Lazy (ByteString)
import qualified Data.ByteString.Lazy.Char8 as ByteString.Lazy
import           Data.Maybe (mapMaybe)
import           Data.String (fromString)
import qualified Network.HTTP.Conduit as Http
import qualified Network.HTTP.Types as Http
import           Text.Printf (printf)

import           Smtpbz.Internal.Has (Has(..), view)


-- | User data.
user :: Has smtpbz => smtpbz -> IO (Http.Response Lazy.ByteString)
user :: forall smtpbz. Has smtpbz => smtpbz -> IO (Response ByteString)
user smtpbz
smtpbz =
  forall smtpbz.
Has smtpbz =>
smtpbz -> String -> IO (Response ByteString)
simpleApiCall smtpbz
smtpbz String
"user"

-- | User's mail distribution statistics.
userStats :: Has smtpbz => smtpbz -> IO (Http.Response Lazy.ByteString)
userStats :: forall smtpbz. Has smtpbz => smtpbz -> IO (Response ByteString)
userStats smtpbz
smtpbz =
  forall smtpbz.
Has smtpbz =>
smtpbz -> String -> IO (Response ByteString)
simpleApiCall smtpbz
smtpbz String
"user/stats"

-- | User's domains data.
userDomains :: Has smtpbz => smtpbz -> IO (Http.Response Lazy.ByteString)
userDomains :: forall smtpbz. Has smtpbz => smtpbz -> IO (Response ByteString)
userDomains smtpbz
smtpbz =
  forall smtpbz.
Has smtpbz =>
smtpbz -> String -> IO (Response ByteString)
simpleApiCall smtpbz
smtpbz String
"user/domain"

-- | User's specific domain data.
userDomain :: Has smtpbz => smtpbz -> String -> IO (Http.Response Lazy.ByteString)
userDomain :: forall smtpbz.
Has smtpbz =>
smtpbz -> String -> IO (Response ByteString)
userDomain smtpbz
smtpbz String
domain =
  forall smtpbz.
Has smtpbz =>
smtpbz -> String -> IO (Response ByteString)
simpleApiCall smtpbz
smtpbz (forall r. PrintfType r => String -> r
printf String
"user/domain/%s" String
domain)

-- | User's IPs data.
userIPs :: Has smtpbz => smtpbz -> IO (Http.Response Lazy.ByteString)
userIPs :: forall smtpbz. Has smtpbz => smtpbz -> IO (Response ByteString)
userIPs smtpbz
smtpbz =
  forall smtpbz.
Has smtpbz =>
smtpbz -> String -> IO (Response ByteString)
simpleApiCall smtpbz
smtpbz String
"user/ip"

-- | User's specific IP data.
userIP :: Has smtpbz => smtpbz -> String -> IO (Http.Response Lazy.ByteString)
userIP :: forall smtpbz.
Has smtpbz =>
smtpbz -> String -> IO (Response ByteString)
userIP smtpbz
smtpbz String
ip = do
  forall smtpbz.
Has smtpbz =>
smtpbz -> String -> IO (Response ByteString)
simpleApiCall smtpbz
smtpbz (forall r. PrintfType r => String -> r
printf String
"user/ip/%s" String
ip)

data LogMessages = LogMessages
  { LogMessages -> Maybe Int
limit  :: Maybe Int
  , LogMessages -> Maybe Int
offset :: Maybe Int
  , LogMessages -> Maybe ByteString
from   :: Maybe ByteString
  , LogMessages -> Maybe ByteString
to     :: Maybe ByteString
  , LogMessages -> Maybe Bool
isOpen :: Maybe Bool
  , LogMessages -> Maybe ByteString
tag    :: Maybe ByteString
  } deriving (Int -> LogMessages -> String -> String
[LogMessages] -> String -> String
LogMessages -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [LogMessages] -> String -> String
$cshowList :: [LogMessages] -> String -> String
show :: LogMessages -> String
$cshow :: LogMessages -> String
showsPrec :: Int -> LogMessages -> String -> String
$cshowsPrec :: Int -> LogMessages -> String -> String
Show, LogMessages -> LogMessages -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogMessages -> LogMessages -> Bool
$c/= :: LogMessages -> LogMessages -> Bool
== :: LogMessages -> LogMessages -> Bool
$c== :: LogMessages -> LogMessages -> Bool
Eq)

-- | Message log search.
logMessages :: Has smtpbz => smtpbz -> LogMessages -> IO (Http.Response Lazy.ByteString)
logMessages :: forall smtpbz.
Has smtpbz =>
smtpbz -> LogMessages -> IO (Response ByteString)
logMessages smtpbz
smtpbz LogMessages {Maybe Bool
Maybe Int
Maybe ByteString
tag :: Maybe ByteString
isOpen :: Maybe Bool
to :: Maybe ByteString
from :: Maybe ByteString
offset :: Maybe Int
limit :: Maybe Int
$sel:tag:LogMessages :: LogMessages -> Maybe ByteString
$sel:isOpen:LogMessages :: LogMessages -> Maybe Bool
$sel:to:LogMessages :: LogMessages -> Maybe ByteString
$sel:from:LogMessages :: LogMessages -> Maybe ByteString
$sel:offset:LogMessages :: LogMessages -> Maybe Int
$sel:limit:LogMessages :: LogMessages -> Maybe Int
..} = do
  Request
req <- forall smtpbz. Has smtpbz => smtpbz -> String -> IO Request
prepareApiCall smtpbz
smtpbz String
"log/message"
  forall smtpbz.
Has smtpbz =>
smtpbz -> Request -> IO (Response ByteString)
callApi smtpbz
smtpbz ([(ByteString, Maybe ByteString)] -> Request -> Request
Http.setQueryString [(ByteString, Maybe ByteString)]
params Request
req)
 where
  params :: [(ByteString, Maybe ByteString)]
params =
    [ (ByteString
"limit", forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) Maybe Int
limit)
    , (ByteString
"offset", forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) Maybe Int
offset)
    , (ByteString
"from", Maybe ByteString
from)
    , (ByteString
"to", Maybe ByteString
to)
      -- documentation says it's a normal person's bool,
      -- but in reality it's a C-programmer's bool
    , (ByteString
"is_open", forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> a -> Bool -> a
bool ByteString
"0" ByteString
"1") Maybe Bool
isOpen)
    , (ByteString
"tag", Maybe ByteString
tag)
    ]

-- | Look up a specific message.
logMessage :: Has smtpbz => smtpbz -> String -> IO (Http.Response Lazy.ByteString)
logMessage :: forall smtpbz.
Has smtpbz =>
smtpbz -> String -> IO (Response ByteString)
logMessage smtpbz
smtpbz String
messageID = do
  forall smtpbz.
Has smtpbz =>
smtpbz -> String -> IO (Response ByteString)
simpleApiCall smtpbz
smtpbz (forall r. PrintfType r => String -> r
printf String
"log/message/%s" String
messageID)

data Unsubscribe = Unsubscribe
  { Unsubscribe -> Maybe Int
limit   :: Maybe Int
  , Unsubscribe -> Maybe Int
offset  :: Maybe Int
  , Unsubscribe -> Maybe ByteString
address :: Maybe ByteString
  , Unsubscribe -> Maybe ByteString
reason  :: Maybe ByteString
  } deriving (Int -> Unsubscribe -> String -> String
[Unsubscribe] -> String -> String
Unsubscribe -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Unsubscribe] -> String -> String
$cshowList :: [Unsubscribe] -> String -> String
show :: Unsubscribe -> String
$cshow :: Unsubscribe -> String
showsPrec :: Int -> Unsubscribe -> String -> String
$cshowsPrec :: Int -> Unsubscribe -> String -> String
Show, Unsubscribe -> Unsubscribe -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Unsubscribe -> Unsubscribe -> Bool
$c/= :: Unsubscribe -> Unsubscribe -> Bool
== :: Unsubscribe -> Unsubscribe -> Bool
$c== :: Unsubscribe -> Unsubscribe -> Bool
Eq)

-- | List of e-mail addresses mail is not delivired to.
unsubscribe :: Has smtpbz => smtpbz -> Unsubscribe -> IO (Http.Response Lazy.ByteString)
unsubscribe :: forall smtpbz.
Has smtpbz =>
smtpbz -> Unsubscribe -> IO (Response ByteString)
unsubscribe smtpbz
smtpbz Unsubscribe {Maybe Int
Maybe ByteString
reason :: Maybe ByteString
address :: Maybe ByteString
offset :: Maybe Int
limit :: Maybe Int
$sel:reason:Unsubscribe :: Unsubscribe -> Maybe ByteString
$sel:address:Unsubscribe :: Unsubscribe -> Maybe ByteString
$sel:offset:Unsubscribe :: Unsubscribe -> Maybe Int
$sel:limit:Unsubscribe :: Unsubscribe -> Maybe Int
..} = do
  Request
req <- forall smtpbz. Has smtpbz => smtpbz -> String -> IO Request
prepareApiCall smtpbz
smtpbz String
"unsubscribe"
  forall smtpbz.
Has smtpbz =>
smtpbz -> Request -> IO (Response ByteString)
callApi smtpbz
smtpbz ([(ByteString, Maybe ByteString)] -> Request -> Request
Http.setQueryString [(ByteString, Maybe ByteString)]
params Request
req)
 where
  params :: [(ByteString, Maybe ByteString)]
params =
    [ (ByteString
"limit", forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) Maybe Int
limit)
    , (ByteString
"offset", forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) Maybe Int
offset)
    , (ByteString
"address", Maybe ByteString
address)
    , (ByteString
"reason", Maybe ByteString
reason)
    ]

-- | Ignore an address.
unsubscribeAdd :: Has smtpbz => smtpbz -> ByteString -> IO (Http.Response Lazy.ByteString)
unsubscribeAdd :: forall smtpbz.
Has smtpbz =>
smtpbz -> ByteString -> IO (Response ByteString)
unsubscribeAdd smtpbz
smtpbz ByteString
address = do
  Request
req <- forall smtpbz. Has smtpbz => smtpbz -> String -> IO Request
prepareApiCall smtpbz
smtpbz String
"unsubscribe/add"
  forall smtpbz.
Has smtpbz =>
smtpbz -> Request -> IO (Response ByteString)
callApi smtpbz
smtpbz ([(ByteString, ByteString)] -> Request -> Request
Http.urlEncodedBody [(ByteString, ByteString)]
params Request
req)
 where
  params :: [(ByteString, ByteString)]
params =
    [ (ByteString
"address", ByteString
address)
    ]

-- | Stop ignoring an address.
unsubscribeRemove :: Has smtpbz => smtpbz -> ByteString -> IO (Http.Response Lazy.ByteString)
unsubscribeRemove :: forall smtpbz.
Has smtpbz =>
smtpbz -> ByteString -> IO (Response ByteString)
unsubscribeRemove smtpbz
smtpbz ByteString
address = do
  Request
req <- forall smtpbz. Has smtpbz => smtpbz -> String -> IO Request
prepareApiCall smtpbz
smtpbz String
"unsubscribe/remove"
  forall smtpbz.
Has smtpbz =>
smtpbz -> Request -> IO (Response ByteString)
callApi smtpbz
smtpbz ([(ByteString, ByteString)] -> Request -> Request
Http.urlEncodedBody [(ByteString, ByteString)]
params Request
req)
 where
  params :: [(ByteString, ByteString)]
params =
    [ (ByteString
"address", ByteString
address)
    ]

-- | Stop ignoring all previously ignored addresses.
unsubscribeRemoveAll :: Has smtpbz => smtpbz -> IO (Http.Response Lazy.ByteString)
unsubscribeRemoveAll :: forall smtpbz. Has smtpbz => smtpbz -> IO (Response ByteString)
unsubscribeRemoveAll smtpbz
smtpbz = do
  Request
req <- forall smtpbz. Has smtpbz => smtpbz -> String -> IO Request
prepareApiCall smtpbz
smtpbz String
"unsubscribe/removeall"
  forall smtpbz.
Has smtpbz =>
smtpbz -> Request -> IO (Response ByteString)
callApi smtpbz
smtpbz ([(ByteString, ByteString)] -> Request -> Request
Http.urlEncodedBody [] Request
req)

data SmtpSend = SmtpSend
  { SmtpSend -> ByteString
from    :: ByteString
  , SmtpSend -> Maybe ByteString
name    :: Maybe ByteString
  , SmtpSend -> ByteString
subject :: ByteString
  , SmtpSend -> ByteString
to      :: ByteString
  , SmtpSend -> Maybe ByteString
replyTo :: Maybe ByteString
  , SmtpSend -> ByteString
html    :: ByteString
  , SmtpSend -> Maybe ByteString
text    :: Maybe ByteString
  -- , headers :: ByteString ???
  } deriving (Int -> SmtpSend -> String -> String
[SmtpSend] -> String -> String
SmtpSend -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [SmtpSend] -> String -> String
$cshowList :: [SmtpSend] -> String -> String
show :: SmtpSend -> String
$cshow :: SmtpSend -> String
showsPrec :: Int -> SmtpSend -> String -> String
$cshowsPrec :: Int -> SmtpSend -> String -> String
Show, SmtpSend -> SmtpSend -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SmtpSend -> SmtpSend -> Bool
$c/= :: SmtpSend -> SmtpSend -> Bool
== :: SmtpSend -> SmtpSend -> Bool
$c== :: SmtpSend -> SmtpSend -> Bool
Eq)

--- | Send an email.
sendSmtp :: Has smtpbz => smtpbz -> SmtpSend -> IO (Http.Response Lazy.ByteString)
sendSmtp :: forall smtpbz.
Has smtpbz =>
smtpbz -> SmtpSend -> IO (Response ByteString)
sendSmtp smtpbz
smtpbz SmtpSend {Maybe ByteString
ByteString
text :: Maybe ByteString
html :: ByteString
replyTo :: Maybe ByteString
to :: ByteString
subject :: ByteString
name :: Maybe ByteString
from :: ByteString
$sel:text:SmtpSend :: SmtpSend -> Maybe ByteString
$sel:html:SmtpSend :: SmtpSend -> ByteString
$sel:replyTo:SmtpSend :: SmtpSend -> Maybe ByteString
$sel:to:SmtpSend :: SmtpSend -> ByteString
$sel:subject:SmtpSend :: SmtpSend -> ByteString
$sel:name:SmtpSend :: SmtpSend -> Maybe ByteString
$sel:from:SmtpSend :: SmtpSend -> ByteString
..} = do
  Request
req <- forall smtpbz. Has smtpbz => smtpbz -> String -> IO Request
prepareApiCall smtpbz
smtpbz String
"smtp/send"
  forall smtpbz.
Has smtpbz =>
smtpbz -> Request -> IO (Response ByteString)
callApi smtpbz
smtpbz ([(ByteString, ByteString)] -> Request -> Request
Http.urlEncodedBody (forall a b. [(a, Maybe b)] -> [(a, b)]
collapse [(ByteString, Maybe ByteString)]
params) Request
req)
 where
  params :: [(ByteString, Maybe ByteString)]
params =
    [ (ByteString
"from", forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
from)
    , (ByteString
"name", Maybe ByteString
name)
    , (ByteString
"subject", forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
subject)
    , (ByteString
"to", forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
to)
    , (ByteString
"reply", Maybe ByteString
replyTo)
    , (ByteString
"html", forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
html)
    , (ByteString
"text", Maybe ByteString
text)
    ]

--- | Check email address validity.
checkEmail :: Has smtpbz => smtpbz -> String -> IO (Http.Response Lazy.ByteString)
checkEmail :: forall smtpbz.
Has smtpbz =>
smtpbz -> String -> IO (Response ByteString)
checkEmail smtpbz
smtpbz String
email =
  forall smtpbz.
Has smtpbz =>
smtpbz -> String -> IO (Response ByteString)
simpleApiCall smtpbz
smtpbz (forall r. PrintfType r => String -> r
printf String
"check/email/%s" String
email)

simpleApiCall :: Has smtpbz => smtpbz -> String -> IO (Http.Response Lazy.ByteString)
simpleApiCall :: forall smtpbz.
Has smtpbz =>
smtpbz -> String -> IO (Response ByteString)
simpleApiCall smtpbz
smtpbz String
path = do
  Request
req <- forall smtpbz. Has smtpbz => smtpbz -> String -> IO Request
prepareApiCall smtpbz
smtpbz String
path
  forall smtpbz.
Has smtpbz =>
smtpbz -> Request -> IO (Response ByteString)
callApi smtpbz
smtpbz Request
req

prepareApiCall :: Has smtpbz => smtpbz -> String -> IO Http.Request
prepareApiCall :: forall smtpbz. Has smtpbz => smtpbz -> String -> IO Request
prepareApiCall smtpbz
smtpbz String
path = do
  Request
req <- forall (m :: * -> *). MonadThrow m => String -> m Request
Http.parseRequest (forall r. PrintfType r => String -> r
printf String
"%s/%s" (forall s t a b. Lens s t a b -> s -> a
view forall t. Has t => Lens' t Text
baseUrl smtpbz
smtpbz) String
path)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure Request
req
    { requestHeaders :: RequestHeaders
Http.requestHeaders = (HeaderName
"Authorization", forall s t a b. Lens s t a b -> s -> a
view forall t. Has t => Lens' t ByteString
apiKey smtpbz
smtpbz) forall a. a -> [a] -> [a]
: Request -> RequestHeaders
Http.requestHeaders Request
req
    }

callApi :: Has smtpbz => smtpbz -> Http.Request -> IO (Http.Response Lazy.ByteString)
callApi :: forall smtpbz.
Has smtpbz =>
smtpbz -> Request -> IO (Response ByteString)
callApi smtpbz
smtpbz Request
req =
  forall (m :: * -> *).
MonadIO m =>
Request -> Manager -> m (Response ByteString)
Http.httpLbs Request
req (forall s t a b. Lens s t a b -> s -> a
view forall t. Has t => Lens' t Manager
httpMan smtpbz
smtpbz)

-- | Check if response status code is in [200, 300).
successfulCall :: Http.Response Lazy.ByteString -> Bool
successfulCall :: Response ByteString -> Bool
successfulCall Response ByteString
res =
  case forall body. Response body -> Status
Http.responseStatus Response ByteString
res of
    Status
st ->
      Status
Http.status200 forall a. Ord a => a -> a -> Bool
<= Status
st Bool -> Bool -> Bool
&& Status
st forall a. Ord a => a -> a -> Bool
< Status
Http.status300

-- | Print response body to stdout.
debugPrintResponse :: Http.Response Lazy.ByteString -> IO ()
debugPrintResponse :: Response ByteString -> IO ()
debugPrintResponse =
  ByteString -> IO ()
ByteString.Lazy.putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall body. Response body -> body
Http.responseBody

collapse :: [(a, Maybe b)] -> [(a, b)]
collapse :: forall a b. [(a, Maybe b)] -> [(a, b)]
collapse =
  forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence