gmail-simple (empty) → 0.1.0.0

raw patch · 4 files changed

+384/−0 lines, 4 filesdep +aesondep +basedep +base64

Dependencies added: aeson, base, base64, blaze-html, bytestring, containers, cryptonite, http-api-data, http-conduit, http-media, jwt, text, time, unordered-containers

Files

LICENSE +29/−0
README.md +14/−0
gmail-simple.cabal +38/−0
src/Network/GMail/Simple.hs +303/−0

+ LICENSE view

@@ -0,0 +1,29 @@+BSD 3-Clause License++Copyright (c) 2021, Daniel Casanueva+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+   list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+   this list of conditions and the following disclaimer in the documentation+   and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its+   contributors may be used to endorse or promote products derived from+   this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ README.md view

@@ -0,0 +1,14 @@+# gmail-simple++A library for [Haskell](https://www.haskell.org) that provides functions to easily+interact with the [Google Mail API](https://developers.google.com/gmail/api).+It doesn't intend to be fully featured, but rather simple.++## Current features++* OAuth management.+* Mail sending.+* Plain text and HTML supported.++Feel free to open an issue if you are interested in the addition of+some specific feature.

+ gmail-simple.cabal view

@@ -0,0 +1,38 @@+name: gmail-simple+version: 0.1.0.0+synopsis: Simple library for Google Mail (GMail).+description:+  Easy-to-use library to interact with the Google Mail API.+  .+  Current only supporting sending mails.+category: Email, Google+license: BSD3+license-file: LICENSE+bug-reports: https://github.com/Daniel-Diaz/gmail-simple/issues+homepage: https://github.com/Daniel-Diaz/gmail-simple/blob/main/README.md+build-type: Simple+cabal-version: >= 1.10+extra-source-files:+  README.md++library+  default-language: Haskell2010+  hs-source-dirs: src+  ghc-options: -Wall+  build-depends:+      base < 5+    , jwt+    , http-conduit+    , text+    , time+    , unordered-containers+    , aeson+    , base64+    , http-media+    , bytestring+    , cryptonite+    , containers+    , http-api-data+    , blaze-html+  exposed-modules:+    Network.GMail.Simple

+ src/Network/GMail/Simple.hs view

@@ -0,0 +1,303 @@++{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleInstances #-}++-- | Interactions with GMail made simple.+--+--   == Sending mails+--+--   For now, only mail sending is implemented.+--   Here's an example:+--+--   First we read the Google key file.+--+-- > do gkey <- readKeyFile "google-key.json"+--+--   Then we start a session. We provide the+--   mail address of the user that will send+--   the mail.+--+-- >    session <- newSession gkey "sender@example.com"+--+--   Here's the mail description.+--+-- >    let mail :: Mail Text+-- >        mail = Mail+-- >          { mail_recipient = "recipient@example.com"+-- >          , mail_subject = "Example mail"+-- >          , mail_body = "This is an example mail."+-- >            }+--+--   Finally, we simply send the mail.+--+-- >    sendMail session mail+--+--   That's it.+--+--   == Importing this library+--+--   I would recommend importing this module qualified. For example:+--+-- > import qualified Network.GMail.Simple as GMail+--+--+module Network.GMail.Simple+  ( -- * Key+    Key (..)+  , readKeyFile+    -- * Session+  , Session+  , newSession+    -- * Mail+  , MailAddress (..)+  , Mail (..)+  , sendMail+    -- * Mail body+  , ToMailBody (..)+    -- * Exceptions+  , GMailException (..)+    ) where++import Control.Monad (unless)+import Control.Exception (Exception, throwIO)+import Control.Concurrent (MVar, newMVar, modifyMVar)+import Data.Proxy (Proxy (..))+import Data.String (IsString (..))+import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.Lazy as LazyText+import Data.Text.Encoding (encodeUtf8, decodeUtf8)+import qualified Web.JWT as JWT+import qualified Data.HashMap.Strict as HashMap+import qualified Data.Aeson as JSON+import qualified Network.HTTP.Simple as HTTP+import Data.ByteString.Base64 (encodeBase64)+import Network.HTTP.Media (MediaType)+import qualified Network.HTTP.Media as Media+import Data.Time.Clock (NominalDiffTime)+import Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime)+import qualified Web.FormUrlEncoded as URLEncoded+import Crypto.PubKey.RSA.Types (PrivateKey)+import qualified Data.Map as Map+import Data.ByteString.Lazy (ByteString)+import qualified Data.ByteString.Lazy as LazyB+import Text.Blaze.Html (Html)+import qualified Text.Blaze.Html.Renderer.Text as HTML++-- | A mail address as text.+newtype MailAddress = MailAddress Text++mailAddressText :: MailAddress -> Text+mailAddressText (MailAddress t) = t++instance IsString MailAddress where+  fromString = MailAddress . fromString++-- | Mail datatype.+data Mail a = Mail+  { -- | Sender's alias.+    mail_sender :: Text+    -- | The recipient of this mail.+  , mail_recipient :: MailAddress+    -- | The subject of this mail.+  , mail_subject :: Text+    -- | Polymorphic mail body.+  , mail_body :: a+    }++-- | You can use `fmap` to map a function over the body of a mail.+instance Functor Mail where+  fmap f mail = mail { mail_body = f $ mail_body mail }++-- | Google API Key from a service account. You can create one+--   inside your project in <https://console.cloud.google.com Google Cloud>.+--   Once you have it, you can download it to a file and read it using 'readKeyFile'.+data Key = Key+  { private_key    :: PrivateKey+  , private_key_id :: Text+  , client_email   :: MailAddress+    }++-- | Read the key file provided by Google Cloud.+--   It throws a 'FailedToParseKey' exception when+--   the file fails to parse.+--+--   If you don't want to read it from a local file,+--   you can use the `JSON.FromJSON` instance of `Key`+--   to read it. The function 'readKeyFile' is just a+--   wrapper around that.+readKeyFile :: FilePath -> IO Key+readKeyFile fp = LazyB.readFile fp >>=+  either (throwIO . FailedToParseKey) pure . JSON.eitherDecode++instance JSON.FromJSON Key where+  parseJSON = JSON.withObject "Key" $ \o -> do+    pkt <- o JSON..: "private_key"+    case JWT.readRsaSecret $ encodeUtf8 pkt of+      Just pk -> Key+        <$> pure pk+        <*> o JSON..: "private_key_id"+        <*> (MailAddress <$> o JSON..: "client_email")+      _ -> fail "Error parsing private key."++data OAuth = OAuth+  { oauth_access_token :: Text+  , oauth_expires_in :: NominalDiffTime+    }++instance JSON.FromJSON OAuth where+  parseJSON = JSON.withObject "OAuth" $ \o ->+    OAuth <$> o JSON..: "access_token" <*> o JSON..: "expires_in"++oauthQuery+  :: Key -- ^ Google key+  -> MailAddress -- ^ Sender mail address+  -> IO OAuth+oauthQuery k sender = do+  now <- getPOSIXTime+  let -- JWT Header+      h = JWT.JOSEHeader+            { JWT.typ = Just "JWT"+            , JWT.cty = Nothing+            , JWT.alg = Just JWT.RS256+            , JWT.kid = Nothing+              }+      -- Scoped required to send mails+      scope :: Text+      scope = "https://www.googleapis.com/auth/gmail.send"+      -- JWT Claims+      c = JWT.JWTClaimsSet+            { JWT.iss = JWT.stringOrURI $ mailAddressText $ client_email k+            , JWT.sub = JWT.stringOrURI $ mailAddressText sender+            , JWT.aud = Left <$> JWT.stringOrURI "https://oauth2.googleapis.com/token"+            , JWT.unregisteredClaims = JWT.ClaimsMap $ Map.singleton "scope" $ JSON.toJSON scope+            , JWT.iat = JWT.numericDate now+            , JWT.exp = JWT.numericDate $ now + 3600+            , JWT.nbf = Nothing+            , JWT.jti = Nothing+              }+      -- Signed JWT+      jwt = JWT.encodeSigned (JWT.RSAPrivateKey $ private_key k) h c+      -- HTTP request body+      body :: ByteString+      body = URLEncoded.urlEncodeForm $ URLEncoded.Form $ HashMap.fromList+               [ ("grant_type", ["urn:ietf:params:oauth:grant-type:jwt-bearer"])+               , ("assertion", [jwt])+                 ]+      -- HTTP request+      req :: HTTP.Request+      req = HTTP.setRequestMethod "POST"+          $ HTTP.setRequestSecure True+          $ HTTP.setRequestPort 443+          $ HTTP.setRequestHost "oauth2.googleapis.com"+          $ HTTP.setRequestPath "/token"+          $ HTTP.addRequestHeader "Content-Type" "application/x-www-form-urlencoded"+          $ HTTP.setRequestBodyLBS body+          $ HTTP.defaultRequest+  HTTP.getResponseBody <$> HTTP.httpJSON req ++data OAuthWithTimestamp = OAuthWithTimestamp+  { oauth_value :: OAuth+  , oauth_time :: POSIXTime+    }++-- | A session that can be used to send mails.+--+--   * It may be reused.+--   * Multiple threads can use it simultaneously.+data Session = Session+  { session_key :: Key+  , session_sender :: MailAddress+  , session_oauth :: MVar OAuthWithTimestamp+    }++-- | Create a new session for the given sender.+newSession+  :: Key -- ^ Google API key+  -> MailAddress -- ^ Mail address of the sender+  -> IO Session+newSession k sender = do+  oauth <- oauthQuery k sender+  now <- getPOSIXTime+  let oauthw = OAuthWithTimestamp+        { oauth_value = oauth+        , oauth_time = now+          }+  Session k sender <$> newMVar oauthw++withOAuth :: Session -> (OAuth -> IO a) -> IO a+withOAuth session f = modifyMVar (session_oauth session) $ \oauthw -> do+  let oauth = oauth_value oauthw+  now <- getPOSIXTime+  -- We renew the token 5 seconds earlier+  if now + 5 < oauth_time oauthw + oauth_expires_in oauth+     then (,) oauthw <$> f oauth+     else do oauth' <- oauthQuery (session_key session) (session_sender session)+             now' <- getPOSIXTime+             let oauthw' = OAuthWithTimestamp+                   { oauth_value = oauth'+                   , oauth_time = now'+                     }+             (,) oauthw' <$> f oauth'++renderMail :: forall a . ToMailBody a => MailAddress -> Mail a -> JSON.Value+renderMail sender mail = JSON.Object $ HashMap.singleton "raw" $ JSON.String+    $ Text.replace "+" "-"+    $ Text.replace "/" "_"+    $ encodeBase64+    $ encodeUtf8 $ Text.concat+        [ "From: " <> mail_sender mail <> " <" <> mailAddressText sender <> ">\r\n"+        , "To: " <> mailAddressText (mail_recipient mail) <> "\r\n"+        , "Subject: " <> mail_subject mail <> "\r\n"+        , "Content-Type: " <> decodeUtf8 (Media.renderHeader $ mailContentType (Proxy @ a)) <> "\r\n"+        , "\r\n"+        , toMailBody $ mail_body mail+          ]++-- | Exceptions thrown by functions in this library.+data GMailException =+    -- | A mail failed to be sent. The JSON value contains+    --   the error message as sent by Google.+    FailedToSend JSON.Value+    -- | A key file failed to parse. The string contains+    --   the parsing error.+  | FailedToParseKey String+    deriving Show++instance Exception GMailException++-- | Send mail using a session. It might throw a 'FailedToSend' exception.+sendMail :: ToMailBody a => Session -> Mail a -> IO ()+sendMail session mail = withOAuth session $ \oauth -> do+  let mailReq :: HTTP.Request+      mailReq = HTTP.setRequestMethod "POST"+              $ HTTP.setRequestSecure True+              $ HTTP.setRequestPort 443+              $ HTTP.setRequestHost "gmail.googleapis.com"+              $ HTTP.setRequestPath ("/gmail/v1/users/me/messages/send")+              $ HTTP.setRequestQueryString [("key",Just $ encodeUtf8 $ private_key_id $ session_key session)]+              $ HTTP.addRequestHeader "Authorization" ("Bearer " <> encodeUtf8 (oauth_access_token oauth))+              $ HTTP.setRequestBodyJSON (renderMail (session_sender session) mail)+              $ HTTP.defaultRequest+  resp <- HTTP.httpJSON mailReq+  let respCode = HTTP.getResponseStatusCode resp+  unless (div respCode 100 == 2) $ throwIO $ FailedToSend $ HTTP.getResponseBody resp++-- ToMailBody class and instances++-- | Class of types that can be used as mail body.+class ToMailBody a where+  -- | Textual representation of the mail body.+  toMailBody :: a -> Text+  -- | Value for the @Content-Type@ header.+  mailContentType :: proxy a -> MediaType++instance ToMailBody Text where+  toMailBody = id+  mailContentType _ = "text" Media.// "plain"++instance ToMailBody Html where+  toMailBody = LazyText.toStrict . HTML.renderHtml+  mailContentType _ = "text" Media.// "html"