Skip to content

Commit

Permalink
smart constructor + top level send function
Browse files Browse the repository at this point in the history
  • Loading branch information
nitinprakash96 committed Oct 27, 2024
1 parent 8d80868 commit cae1424
Show file tree
Hide file tree
Showing 2 changed files with 54 additions and 10 deletions.
31 changes: 22 additions & 9 deletions azure-email/Azure/Email.hs
Original file line number Diff line number Diff line change
Expand Up @@ -16,26 +16,39 @@ import Data.Time (UTCTime, defaultTimeLocale, formatTime, getCurrentTime)
import Network.HTTP.Client.TLS (newTlsManager)
import Servant.API
import Servant.Client (BaseUrl (..), ClientM, Scheme (..), client, mkClientEnv, runClientM)
import UnliftIO (MonadIO (..))
import UnliftIO (MonadIO (..), throwString)

import qualified Data.ByteString as BS
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Char8 as C8
import qualified Data.Text as Text

{- | Send an email provided a request payload
Errors are thrown in IO. For a variant where error is captured
in an @Left@ branch, see @sendEmailEither@
-}
sendEmail ::
MonadIO m =>
Text ->
Text ->
AzureEmailRequest ->
m AzureEmailResponse
sendEmail apiSecret payload = undefined
sendEmail apiSecret emailHost payload = do
resp <- sendEmailEither apiSecret emailHost payload
case resp of
Left err -> throwString $ show err
Right r -> pure r

-- | Send an email provided a request payload
sendEmailEither ::
MonadIO m =>
Text ->
Text ->
AzureEmailRequest ->
m (Either Text AzureEmailResponse)
sendEmailEither apiSecret payload = undefined
sendEmailEither apiSecret emailHost payload =
liftIO $ callSendEmailClient sendEmailApi payload emailHost apiSecret

type SendEmailApi =
"emails:send"
Expand All @@ -45,17 +58,17 @@ type SendEmailApi =
:> Header' '[Required, Strict] "x-ms-content-sha256" Text
:> Header' '[Required, Strict] "Authorization" Text
:> ReqBody '[JSON] AzureEmailRequest
:> PostNoContent
:> Post '[JSON] AzureEmailResponse

sendEmailApi :: Text -> Text -> Text -> Text -> Text -> AzureEmailRequest -> ClientM NoContent
sendEmailApi :: Text -> Text -> Text -> Text -> Text -> AzureEmailRequest -> ClientM AzureEmailResponse
sendEmailApi = client (Proxy @SendEmailApi)

callSendEmailClient ::
(Text -> Text -> Text -> Text -> Text -> AzureEmailRequest -> ClientM NoContent) ->
(Text -> Text -> Text -> Text -> Text -> AzureEmailRequest -> ClientM AzureEmailResponse) ->
AzureEmailRequest ->
Text ->
Text ->
IO (Either Text ())
IO (Either Text AzureEmailResponse)
callSendEmailClient action req azureEmailHost secret = do
manager <- liftIO newTlsManager
(formatToAzureTime -> now) <- getCurrentTime
Expand All @@ -79,8 +92,8 @@ callSendEmailClient action req azureEmailHost secret = do
pure $ case res of
Left err -> do
Left . Text.pack $ show err
Right _ -> do
Right ()
Right r -> do
Right r
where
apiVersion :: Text
apiVersion = "2023-03-31"
Expand Down
33 changes: 32 additions & 1 deletion azure-email/Azure/Types.hs
Original file line number Diff line number Diff line change
Expand Up @@ -13,12 +13,17 @@ module Azure.Types
, EmailRecipients (..)
, EmailContent (..)
, EmailAttachment (..)

-- * Smart constructors
, newAzureEmailRequest
) where

import Data.Aeson (FromJSON (..), ToJSON (..), object, withObject, withText, (.:), (.=))
import Data.Aeson.Types (parseFail)
import Data.Text (Text)

import qualified Data.Text as Text

{- | Each email is represented as an object with @displayName@
and an associated @address@.
Expand All @@ -37,6 +42,14 @@ instance ToJSON EmailAddress where
, "displayName" .= eaDisplayName
]

{- | Why text type instead of represting it as @EmailAddress@?
Well, Azure API dictates that sender address should only be the email
instead of a combination of email and display name (EmailAddress in our case).
Therefore, we fallback to use text as a type alias for this one case.
-}
type SenderEmailAddress = Text

-- | Fields to represent @cc@, @bcc@ and @to@ in an email
data EmailRecipients = EmailRecipients
{ ccRecipients :: ![EmailAddress]
Expand Down Expand Up @@ -97,7 +110,7 @@ Source: https://learn.microsoft.com/en-us/rest/api/communication/dataplane/email
data AzureEmailRequest = AzureEmailRequest
{ aerContent :: !EmailContent
, aerRecipients :: !EmailRecipients
, aerSenderAddress :: !Text -- TODO: This should probably be it's own newtype
, aerSenderAddress :: !SenderEmailAddress
, aerReplyTo :: ![EmailAddress] -- TODO: Should this be NonEmpty instead?
, aerAttachments :: ![EmailAttachment]
, aerUserEngagementTrackingDisabled :: !Bool
Expand All @@ -115,6 +128,24 @@ instance ToJSON AzureEmailRequest where
, "userEngagementTrackingDisabled" .= aerUserEngagementTrackingDisabled
]

{- | Smart constructor to build a send email request.
There are few default settings that the caller needs to be aware of:
1. @replyTo@ for recipient is the sender's email address. In case there needs to be multiple
email addresses in @replyTo@ field, it is advised to build a custom request based on the
exposed data types instead.
2. Attachements are not included, yet.
3. Enagagement tracking is disabled.
-}
newAzureEmailRequest ::
SenderEmailAddress ->
EmailRecipients ->
EmailContent ->
AzureEmailRequest
newAzureEmailRequest senderAddress recipients content =
let senderEmailAddress = EmailAddress senderAddress Text.empty
in AzureEmailRequest content recipients senderAddress [senderEmailAddress] [] True

{- | Possible states once a send email action is triggered.
Source: https://learn.microsoft.com/en-us/rest/api/communication/dataplane/email/send?view=rest-communication-dataplane-2023-03-31&tabs=HTTP#emailsendstatus
-}
Expand Down

0 comments on commit cae1424

Please sign in to comment.