diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,3 @@ +# 0.1.0 + +* Initial release. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2015, Brian Schroeder + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * 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. + + * Neither the name of Brian Schroeder nor the names of other + 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 +OWNER 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. diff --git a/Quickstart.hs b/Quickstart.hs new file mode 100644 --- /dev/null +++ b/Quickstart.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Quickstart where + +import qualified Data.ByteString.Char8 as B +import Data.Monoid ((<>)) +import Pipes (runEffect, (>->)) +import Pipes.HTTP (newManager, tlsManagerSettings) +import qualified Pipes.Prelude as P + +import Network.Nylas + +token :: AccessToken +token = AccessToken "_PUT_YOUR_ACCESS_TOKEN_HERE_" + +main :: IO () +main = do + mgr <- newManager tlsManagerSettings + let cursor = Nothing + res <- consumeDeltas mgr token cursor (P.map show >-> P.print) + case res of + Left (ParsingError err remainder) -> do + putStrLn $ "ERROR: " <> show err + putStrLn "next few items:" + runEffect $ remainder >-> P.take 3 >-> P.map B.unpack >-> P.stdoutLn + Left (ConsumerError _) -> error "not possible" + Right _ -> return () diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,84 @@ +# nylas + +A _partially completed_ Haskell client for the [Nylas](https://nylas.com) +[HTTP API](https://www.nylas.com/docs/platform), powered by +[lens](https://hackage.haskell.org/package/lens) and +[pipes](https://hackage.haskell.org/package/pipes). At the moment I've only +implemented support for the endpoints I need. + +Pull requests for support of additional endpoints would be greatly appreciated! + +## Features + +* constant-space stream ingestion of the + [changes](https://www.nylas.com/docs/platform#deltas) (currently only message + and thread objects) to an inbox since a given transactional cursor (or the + beginning of time) +* requesting a message object +* requesting a thread object + +## Quickstart + +The following example prints out all of the (thread and message) changes to an +inbox using pipes: + +```haskell +{-# LANGUAGE OverloadedStrings #-} + +module Quickstart where + +import qualified Data.ByteString.Char8 as B +import Data.Monoid ((<>)) +import Pipes (runEffect, (>->)) +import Pipes.HTTP (newManager, tlsManagerSettings) +import qualified Pipes.Prelude as P + +import Network.Nylas + +token :: AccessToken +token = AccessToken "_PUT_YOUR_ACCESS_TOKEN_HERE_" + +main :: IO () +main = do + mgr <- newManager tlsManagerSettings + let cursor = Nothing + res <- consumeDeltas mgr token cursor (P.map show >-> P.print) + case res of + Left (ParsingError err remainder) -> do + putStrLn $ "ERROR: " <> show err + putStrLn "next few items:" + runEffect $ remainder >-> P.take 3 >-> P.map B.unpack >-> P.stdoutLn + Left (ConsumerError _) -> error "not possible" + Right _ -> return () +``` + +## License (3-clause BSD) + +Copyright (c) 2015, Brian Schroeder + +All rights reserved. + +Redistribution and use in source and binary forms, with or without modification, +are permitted provided that the following conditions are met: + +* Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + +* 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. + +* Neither the name of Brian Schroeder nor the names of other 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 OWNER 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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/nylas.cabal b/nylas.cabal new file mode 100644 --- /dev/null +++ b/nylas.cabal @@ -0,0 +1,38 @@ +name: nylas +version: 0.1.0 +synopsis: Client for the Nylas API +description: A client for the Nylas HTTP API, powered by lens and pipes. +license: BSD3 +license-file: LICENSE +author: Brian Schroeder +maintainer: bts@gmail.com +copyright: 2015, Brian Schroeder +category: Network, API +build-type: Simple +cabal-version: >=1.10 +homepage: https://github.com/bts/nylas-hs +bug-reports: https://github.com/bts/nylas-hs/issues +extra-source-files: README.md CHANGELOG.md Quickstart.hs + +source-repository head + type: git + location: git://github.com/bts/nylas-hs.git + +library + exposed-modules: Network.Nylas, Network.Nylas.Client, Network.Nylas.Types + build-depends: aeson >= 0.8 && < 0.10 + , base >= 4.8 && < 4.9 + , bytestring >= 0.10.6.0 && < 0.11 + , lens >= 4.5 && < 5.0 + , lens-aeson >= 1.0.0.4 && < 1.1 + , pipes >= 4.1.0 && < 5.0 + , pipes-aeson >= 0.4.1.3 && < 0.5 + , pipes-bytestring >= 2.1.1 && < 3.0 + , pipes-parse >= 3.0.2 && < 4.0 + , text >= 1.2.1.1 && < 1.3 + , wreq >= 0.4.0.0 && < 0.5 + , pipes-http >= 1.0.2 && < 2.0 + , time >= 1.5 && < 2.0 + hs-source-dirs: src + default-language: Haskell2010 + ghc-options: -Wall diff --git a/src/Network/Nylas.hs b/src/Network/Nylas.hs new file mode 100644 --- /dev/null +++ b/src/Network/Nylas.hs @@ -0,0 +1,7 @@ +module Network.Nylas + ( module Network.Nylas.Client + , module Network.Nylas.Types + ) where + +import Network.Nylas.Client +import Network.Nylas.Types diff --git a/src/Network/Nylas/Client.hs b/src/Network/Nylas/Client.hs new file mode 100644 --- /dev/null +++ b/src/Network/Nylas/Client.hs @@ -0,0 +1,95 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} + +module Network.Nylas.Client + ( -- * Streaming Delta Consumption + consumeDeltas + -- * Requesting Individual Objects + , getMessage + , getThread + ) where + +import Control.Lens (view, (&), (.~), (?~), (^.)) +import Control.Monad ((=<<)) +import qualified Data.ByteString.Char8 as B +import Data.Either (Either (Left, Right)) +import Data.Eq ((/=)) +import Data.Functor ((<$>)) +import Data.Maybe (Maybe, maybe) +import Data.Monoid ((<>)) +import qualified Data.Text as T +import qualified Data.Text.Encoding as E +import GHC.Base (($)) +import qualified Network.Wreq as W +import Pipes (Consumer, Producer, runEffect, (>->)) +import Pipes.Aeson (DecodingError) +import qualified Pipes.Aeson.Unchecked as AU +import Pipes.HTTP (Manager, Request, applyBasicAuth, + parseUrl, responseBody, withHTTP) +import qualified Pipes.Prelude as P +import System.IO (IO) + +import Network.Nylas.Types + +authenticatedOpts :: AccessToken -> W.Options -> W.Options +authenticatedOpts (AccessToken t) = W.auth ?~ W.basicAuth (E.encodeUtf8 t) "" + +authenticatedReq :: AccessToken -> Request -> Request +authenticatedReq (AccessToken t) = + applyBasicAuth (E.encodeUtf8 t) (E.encodeUtf8 "") + +deltaStreamUrl :: Maybe Cursor -> Url +deltaStreamUrl mCursor = + T.unpack $ "https://api.nylas.com/delta/streaming?cursor=" + <> maybe "0" _cursorId mCursor + +-- | Consume 'Delta's for the inbox associated with the provided 'AccessToken' +-- since the optional 'Cursor' from Nylas' transactional +-- . +-- +-- Clients should keep track of the 'Cursor' from the latest 'Delta' consumed to +-- resume consumption in the future. +-- +-- Any errors encountered during consumption (e.g. while writing to a database) +-- should be surfaced using the 'ConsumerError' value constructor of +-- 'StreamingError'. +consumeDeltas + :: Manager + -> AccessToken + -> Maybe Cursor + -> Consumer Delta IO (Either StreamingError ()) + -> IO (Either StreamingError ()) +consumeDeltas m t mCursor consumer = do + req <- parseUrl $ deltaStreamUrl mCursor + withHTTP (authenticatedReq t req) m $ \resp -> do + let body = responseBody resp >-> P.takeWhile (/= "\n") + deltas = wrapError <$> view AU.decoded body + runEffect $ deltas >-> consumer + + where + wrapError :: Either (DecodingError, Producer B.ByteString IO ()) () + -> Either StreamingError () + wrapError (Left (err, leftovers)) = Left $ ParsingError err leftovers + wrapError _ = Right () + +messageUrl :: NylasId -> Url +messageUrl (NylasId i) = T.unpack $ "https://api.nylas.com/messages/" <> i + +-- | Fetch the 'Message' identified by 'NylasId' from the account associated +-- with 'AccessToken'. +getMessage :: Manager -> AccessToken -> NylasId -> IO Message +getMessage mgr t i = (^. W.responseBody) <$> (W.asJSON =<< W.getWith opts url) + where opts = W.defaults & authenticatedOpts t + & W.manager .~ Right mgr + url = messageUrl i + +threadUrl :: NylasId -> Url +threadUrl (NylasId i) = T.unpack $ "https://api.nylas.com/threads/" <> i + +-- | Fetch the 'Thread' identified by 'NylasId' from the account associated with +-- 'AccessToken'. +getThread :: Manager -> AccessToken -> NylasId -> IO Thread +getThread mgr t i = (^. W.responseBody) <$> (W.asJSON =<< W.getWith opts url) + where opts = W.defaults & authenticatedOpts t + & W.manager .~ Right mgr + url = threadUrl i diff --git a/src/Network/Nylas/Types.hs b/src/Network/Nylas/Types.hs new file mode 100644 --- /dev/null +++ b/src/Network/Nylas/Types.hs @@ -0,0 +1,337 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +module Network.Nylas.Types where + +import Control.Applicative (empty, pure, (<*>)) +import Control.Lens (makeLenses, makePrisms, (^.)) +import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON), + Value (String, Object, Bool), object, + (.:), (.:?)) +import Data.Aeson.Types (Parser) +import Data.Bool (Bool (True, False)) +import qualified Data.ByteString.Char8 as B +import Data.Eq (Eq) +import Data.Functor (fmap, (<$>)) +import Data.Int (Int) +import Data.Maybe (Maybe (Nothing, Just)) +import Data.Monoid ((<>)) +import Data.String (String) +import Data.Text (Text) +import Data.Time.Clock (UTCTime) +import Data.Time.Clock.POSIX (posixSecondsToUTCTime) +import GHC.Base (($), (.)) +import GHC.Generics (Generic) +import GHC.Real (fromIntegral) +import Pipes (Producer) +import Pipes.Aeson (DecodingError) +import Prelude (Show) +import System.IO (IO) + +-- * Types + +type Url = String + +-- | The from +-- Nylas to access data from a single inbox. +newtype AccessToken = AccessToken Text deriving (Eq, Show) + +-- | The unique ID for a Nylas object. +newtype NylasId = NylasId { _nylasId :: Text } deriving (Eq, Show, Generic) + +-- ** Nylas Object Types + +-- | A tuple of an email address and the optional name accompanying it, for +-- participants in 'Thread's and 'Message's. +data Mailbox + = Mailbox + { _mailboxName :: Maybe Text + , _mailboxEmail :: Text + } deriving (Eq, Show) + +-- | A file attached to a 'Message'. +data File + = File + { _fileId :: NylasId + , _fileContentType :: Text + , _fileName :: Text + , _fileSize :: Int + , _fileContentId :: Maybe Text + } deriving (Eq, Show) + +-- | The time a message was sent. +newtype MessageTime = MessageTime { _utcTime :: UTCTime } + deriving (Eq, Show, Generic) + +-- | Whether a 'Message' has been read in the inbox. +data ReadStatus = MessageRead + | MessageUnread + deriving (Eq, Show) + +-- | Whether a 'Message' or 'Thread' has been starred in the inbox. +data StarStatus = Starred + | Unstarred + deriving (Eq, Show) + +-- | A Gmail-style label applied to a 'Message' or 'Thread'. +data Label + = Label + { _labelId :: NylasId + , _labelName :: Text + , _labelDisplayName :: Text + } deriving (Eq, Show) + +-- | An IMAP-style folder in which 'Message's can reside. A 'Thread' can contain +-- 'Messages' spanning multiple folders. +data Folder + = Folder + { _folderId :: NylasId + , _folderName :: Text + , _folderDisplayName :: Text + } deriving (Eq, Show) + +-- | An email message. +data Message + = Message + { _messageId :: NylasId + , _messageSubject :: Text + , _messageSenders :: [Mailbox] + , _messageToRecipients :: [Mailbox] + , _messageCcRecipients :: [Mailbox] + , _messageBccRecipients :: [Mailbox] + -- TODO: add support for (undocumented?) reply-tos + , _messageTime :: MessageTime + , _messageThreadId :: NylasId + , _messageFiles :: [File] + , _messageSnippet :: Text + , _messageLabels :: Maybe [Label] + , _messageFolder :: Maybe Folder + , _messageBody :: Text + , _messageRead :: ReadStatus + , _messageStarred :: StarStatus + } deriving (Eq, Show) + +-- | Whether a 'Thread' contains any attached 'File's. +data AttachmentsStatus = HasAttachments + | NoAttachments + deriving (Eq, Show) + +-- | A chain of 'Message's. +data Thread + = Thread + { _threadId :: NylasId + , _threadSubject :: Text + , _threadFirstTimestamp :: MessageTime + , _threadLastTimestamp :: MessageTime + , _threadParticipants :: [Mailbox] + , _threadSnippet :: Text + , _threadLabels :: Maybe [Label] + , _threadFolders :: Maybe [Folder] + , _threadMessageIds :: [NylasId] + , _threadDraftIds :: [NylasId] + , _threadVersion :: Int + , _threadStarred :: StarStatus + , _threadAttachments :: AttachmentsStatus + } deriving (Eq, Show) + +-- ** Streaming Types + +-- | The transactional cursor as of a certain 'Delta'. When requesting a stream +-- of updates, clients should provide the 'Cursor' for the last 'Delta' they +-- successfully consumed. +newtype Cursor = Cursor { _cursorId :: Text } deriving (Eq, Show, Generic) + +-- | An error in a streaming pipeline involving 'consumeDeltas'. +data StreamingError = ParsingError DecodingError (Producer B.ByteString IO ()) + -- ^ An error in parsing JSON + | ConsumerError Text + -- ^ An error produced by clients while consuming 'Delta's + +-- | The change operation wrapping the affected object in a 'Delta'. If the +-- object has been created or modified (as opposed to deleted), the object is +-- nested within the 'Change'. +data Change a + = Create a + | Modify a + | Delete + deriving (Eq, Show) + +-- | The type of modification to the inbox the 'Delta' contains. +data DeltaChange + = CalendarChange + | ContactChange + | EventChange + | FileChange + | MessageChange (Change Message) + | DraftChange + | ThreadChange (Change Thread) + | LabelChange + | FolderChange + deriving (Eq, Show) + +-- | A change to an inbox with a transactional 'Cursor' to continue processing +-- from this 'Delta' in the future. +data Delta + = Delta + { _deltaCursor :: Cursor + , _deltaObjectId :: NylasId + , _deltaChange :: DeltaChange + } deriving (Eq, Show) + +-- * Lenses + +makeLenses ''NylasId +makeLenses ''Mailbox +makeLenses ''File +makeLenses ''MessageTime +makePrisms ''ReadStatus +makePrisms ''StarStatus +makeLenses ''Label +makeLenses ''Folder +makeLenses ''Message +makePrisms ''AttachmentsStatus +makeLenses ''Thread +makeLenses ''Cursor +makePrisms ''Change +makePrisms ''DeltaChange +makeLenses ''Delta + +-- * Utilities + +-- | A list of the recipients of all types for a 'Message'. +recipients :: Message -> [Mailbox] +recipients m = m ^. messageToRecipients + <> m ^. messageCcRecipients + <> m ^. messageBccRecipients + +-- Instances + +instance FromJSON Mailbox where + parseJSON (Object v) = + Mailbox <$> fmap nonEmpty (v .: "name") + <*> v .: "email" + where + nonEmpty "" = Nothing + nonEmpty str = Just str + parseJSON _ = empty + +instance FromJSON File where + parseJSON (Object v) = + File <$> v .: "id" + <*> v .: "content_type" + <*> v .: "filename" + <*> v .: "size" + <*> v .:? "content_id" + parseJSON _ = empty + +instance FromJSON MessageTime where + parseJSON n = (MessageTime . posixSecondsToUTCTime . fromIntegral) + <$> (parseJSON n :: Parser Int) + +instance FromJSON StarStatus where + parseJSON (Bool True) = pure Starred + parseJSON (Bool False) = pure Unstarred + parseJSON _ = empty + +instance FromJSON Label where + parseJSON (Object v) = + Label <$> v .: "id" + <*> v .: "name" + <*> v .: "display_name" + parseJSON _ = empty + +instance FromJSON Folder where + parseJSON (Object v) = + Folder <$> v .: "id" + <*> v .: "name" + <*> v .: "display_name" + parseJSON _ = empty + +instance FromJSON Message where + parseJSON (Object v) = + Message <$> v .: "id" + <*> v .: "subject" + <*> v .: "from" + <*> v .: "to" + <*> v .: "cc" + <*> v .: "bcc" + <*> v .: "date" + <*> v .: "thread_id" + <*> v .: "files" + <*> v .: "snippet" + <*> v .:? "labels" + <*> v .:? "folder" + <*> v .: "body" + <*> fmap fromUnread (v .: "unread") + <*> v .: "starred" + where + fromUnread :: Bool -> ReadStatus + fromUnread True = MessageUnread + fromUnread False = MessageRead + parseJSON _ = empty + +instance FromJSON AttachmentsStatus where + parseJSON (Bool True) = pure HasAttachments + parseJSON (Bool False) = pure NoAttachments + parseJSON _ = empty + +instance FromJSON Thread where + parseJSON (Object v) = + Thread <$> v .: "id" + <*> v .: "subject" + <*> v .: "first_message_timestamp" + <*> v .: "last_message_timestamp" + <*> v .: "participants" + <*> v .: "snippet" + <*> v .:? "labels" + <*> v .:? "folders" + <*> v .: "message_ids" + <*> v .: "draft_ids" + <*> v .: "version" + <*> v .: "starred" + <*> v .: "has_attachments" + parseJSON _ = empty + +instance FromJSON Cursor where + parseJSON (String s) = pure $ Cursor s + parseJSON _ = empty + +instance FromJSON NylasId where + parseJSON (String s) = pure $ NylasId s + parseJSON _ = empty + +instance FromJSON Delta where + parseJSON (Object deltaV) = do + cursor <- deltaV .: "cursor" + nyId <- deltaV .: "id" + (String event) <- deltaV .: "event" + (String objectType) <- deltaV .: "object" + mObjV <- deltaV .:? "attributes" + dc <- case objectType of + "calendar" -> pure CalendarChange + "contact" -> pure ContactChange + "event" -> pure EventChange + "file" -> pure FileChange + "message" -> MessageChange <$> parseChange event mObjV + "draft" -> pure DraftChange + "thread" -> ThreadChange <$> parseChange event mObjV + "label" -> pure LabelChange + "folder" -> pure FolderChange + _ -> empty + pure $ Delta cursor nyId dc + + where + parseChange :: FromJSON a => Text -> Maybe Value -> Parser (Change a) + parseChange "create" (Just objV) = Create <$> parseJSON objV + parseChange "modify" (Just objV) = Modify <$> parseJSON objV + parseChange "delete" Nothing = pure Delete + parseChange _ _ = empty + + parseJSON _ = empty + +-- HACK: since pipes-aeson's stream decoding lens supports bidirectional usage, +-- we need to provide this dummy instance: +instance ToJSON Delta where + toJSON _ = object []