From cae1424498bc8539ae8c8e01513449a93ee20a27 Mon Sep 17 00:00:00 2001 From: Nitin Prakash Date: Sun, 27 Oct 2024 20:52:46 +0530 Subject: [PATCH] smart constructor + top level send function --- azure-email/Azure/Email.hs | 31 ++++++++++++++++++++++--------- azure-email/Azure/Types.hs | 33 ++++++++++++++++++++++++++++++++- 2 files changed, 54 insertions(+), 10 deletions(-) diff --git a/azure-email/Azure/Email.hs b/azure-email/Azure/Email.hs index 1b57852..1a9db38 100644 --- a/azure-email/Azure/Email.hs +++ b/azure-email/Azure/Email.hs @@ -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" @@ -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 @@ -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" diff --git a/azure-email/Azure/Types.hs b/azure-email/Azure/Types.hs index dab3b3c..32e20a5 100644 --- a/azure-email/Azure/Types.hs +++ b/azure-email/Azure/Types.hs @@ -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@. @@ -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] @@ -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 @@ -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 -}