diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -10,6 +10,12 @@ +## 0.8.0.0 + +MSGraphAPI.Files.DriveItem + + + ## 0.7.0.0 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -9,9 +9,9 @@ ## Introduction -This library provides both the client interface (under the `MSGraphAPI` namespace) as well as helpers to integrate with Microsoft infrastructure, e.g. using ActiveDirectory as an OAuth2 identity provider. +This library provides both client interface to the MS Grapi API (under the `MSGraphAPI` namespace). -With the provided auth functions (see `Network.OAuth2.Session`) you can easily implement OAuth2 for your application, and the resulting token store is thread-safe and automatically renews before expiring. +Authentication can be implemented with the `ms-auth` library. ## Status @@ -26,6 +26,7 @@ We adhere to the [Package Versioning Policy](https://pvp.haskell.org/): major breaking changes or API refactors are signaled by increasing the first major version number (i.e. 0.0.0.0 -> 1.0.0.0 ) whereas less significant ones are indicated by increasing the second one (0.0.0.0 -> 0.1.0.0) +Significant changes in the SDK will be documented in the respective CHANGELOG. ## Copyright diff --git a/ms-graph-api.cabal b/ms-graph-api.cabal --- a/ms-graph-api.cabal +++ b/ms-graph-api.cabal @@ -1,8 +1,8 @@ name: ms-graph-api -version: 0.7.0.0 +version: 0.8.0.0 synopsis: Microsoft Graph API description: Bindings to the Microsoft Graph API -homepage: https://github.com/unfoldml/ms-api +homepage: https://github.com/unfoldml/ms-graph-api license: BSD3 license-file: LICENSE author: Marco Zocca @@ -18,19 +18,20 @@ library default-language: Haskell2010 hs-source-dirs: src - exposed-modules: MSGraphAPI.ChangeNotifications.Subscription + exposed-modules: MSGraphAPI + MSGraphAPI.ChangeNotifications.Subscription MSGraphAPI.User MSGraphAPI.Users.User MSGraphAPI.Users.Group MSGraphAPI.Drive MSGraphAPI.Files.DriveItem - MSGraphAPI.Internal.Common - other-modules: MSGraphAPI.Auth + other-modules: MSGraphAPI.Internal.Common build-depends: base >= 4.7 && < 5 , aeson , bytestring , containers , hoauth2 == 2.6.0 + , http-client-tls >= 0.3 , http-types , modern-uri , req @@ -47,27 +48,6 @@ DeriveFunctor DerivingStrategies LambdaCase - - --- test-suite spec --- default-language: Haskell2010 --- type: exitcode-stdio-1.0 --- hs-source-dirs: test --- main-is: Spec.hs --- other-modules: LibSpec --- build-depends: base --- , ms-graph-api --- , hspec --- , QuickCheck --- ghc-options: -Wall --- -Wcompat --- -Widentities --- -Wincomplete-record-updates --- -Wincomplete-uni-patterns --- -Wmissing-export-lists --- -Wmissing-home-modules --- -Wpartial-fields --- -Wredundant-constraints source-repository head type: git diff --git a/src/MSGraphAPI.hs b/src/MSGraphAPI.hs new file mode 100644 --- /dev/null +++ b/src/MSGraphAPI.hs @@ -0,0 +1,5 @@ +module MSGraphAPI ( + Collection(..), run, tryReq, withTLS + ) where + +import MSGraphAPI.Internal.Common (Collection(..), run, tryReq, withTLS) diff --git a/src/MSGraphAPI/Auth.hs b/src/MSGraphAPI/Auth.hs deleted file mode 100644 --- a/src/MSGraphAPI/Auth.hs +++ /dev/null @@ -1,2 +0,0 @@ -module MSGraphAPI.Auth where - diff --git a/src/MSGraphAPI/ChangeNotifications/Subscription.hs b/src/MSGraphAPI/ChangeNotifications/Subscription.hs --- a/src/MSGraphAPI/ChangeNotifications/Subscription.hs +++ b/src/MSGraphAPI/ChangeNotifications/Subscription.hs @@ -1,3 +1,8 @@ +-- | Subscription to change notifications through webhooks +-- +-- see for a list of resources that can produce change notifications +-- +-- see for protocol details module MSGraphAPI.ChangeNotifications.Subscription where import Data.List.NonEmpty (NonEmpty) @@ -14,11 +19,31 @@ import Data.Text (Text, pack, unpack) -- time import Data.Time (LocalTime) +-- import Data.UUID.Types (UUID) import qualified MSGraphAPI.Internal.Common as MSG (Collection(..), get, post, aesonOptions) import MSGraphAPI.Files.DriveItem (DriveItem) --- | Creating a subscription requires read scope to the resource. For example, to get change notifications on messages, your app needs the Mail.Read permission. +-- | Represents the notification sent to the subscriber. https://learn.microsoft.com/en-us/graph/api/resources/changenotification?view=graph-rest-1.0 +-- +-- +data ChangeNotification a = ChangeNotification { + cnChangeType :: ChangeType + , cnClientState :: Text + , cnId :: Text + , cnResource :: Text + , cnResourceData :: Maybe a + , cnSubscriptionId :: Text + , cnTenantId :: Text + } deriving (Eq, Show, Generic) +instance A.FromJSON a => A.FromJSON (ChangeNotification a) where + parseJSON = A.genericParseJSON (MSG.aesonOptions "cn") + +-- | Create a subscription https://learn.microsoft.com/en-us/graph/api/subscription-post-subscriptions?view=graph-rest-1.0&tabs=http +-- +-- @ POST https:\/\/graph.microsoft.com\/v1.0\/subscriptions@ +-- +-- Creating a subscription requires read scope to the resource. For example, to get change notifications on messages, your app needs the @Mail.Read@ permission. createSubscription :: (A.FromJSON b) => Subscription -> AccessToken -> Req b createSubscription = MSG.post ["subscriptions"] mempty @@ -31,7 +56,7 @@ , cnsClientState :: Text , cnsExpirationDateTime :: LocalTime , cnsNotificationUrl :: Text -- ^ The URL of the endpoint that will receive the change notifications. This URL must make use of the HTTPS protocol. Any query string parameter included in the notificationUrl property will be included in the HTTP POST request when Microsoft Graph sends the change notifications. - , cnsResource :: Text -- ^ Specifies the resource that will be monitored for changes. Do not include the base URL (https://graph.microsoft.com/v1.0/) + , cnsResource :: Text -- ^ Specifies the resource that will be monitored for changes. Do not include the base URL (@https:\/\/graph.microsoft.com\/v1.0\/@) , cnsLatestSupportedTLSVersion :: LatestTLSVer } deriving (Eq, Show, Generic) instance A.FromJSON Subscription where diff --git a/src/MSGraphAPI/Files/DriveItem.hs b/src/MSGraphAPI/Files/DriveItem.hs --- a/src/MSGraphAPI/Files/DriveItem.hs +++ b/src/MSGraphAPI/Files/DriveItem.hs @@ -1,9 +1,24 @@ -module MSGraphAPI.Files.DriveItem where +module MSGraphAPI.Files.DriveItem ( + -- * list items + listRootChildrenMe + , listGroupItemChildren + -- , listGroupRootChildren + -- * download items + , downloadFile + , downloadFileMe + -- * types + , DriveItem(..) + , DIItem(..) + , File(..), Folder(..), Package(..) + ) where +import Control.Applicative (Alternative(..)) +import Data.Int (Int32) import GHC.Generics (Generic(..)) -- aeson -import qualified Data.Aeson as A (ToJSON(..), FromJSON(..), genericParseJSON) +import qualified Data.Aeson as A (ToJSON(..), FromJSON(..), Value, genericParseJSON, (.:), (.:?), Object, withObject, Key) +import qualified Data.Aeson.Types as A (Parser) -- bytestring import qualified Data.ByteString.Lazy as LBS (ByteString) -- hoauth @@ -13,19 +28,89 @@ -- text import Data.Text (Text, pack, unpack) -- time -import Data.Time (LocalTime) +import Data.Time (LocalTime, ZonedTime) import qualified MSGraphAPI.Internal.Common as MSG (get, getLbs, post, Collection, aesonOptions) +-- | The 'DriveItem' resource represents a file, folder, or other item stored in a drive. +-- +-- All file system objects in OneDrive and SharePoint are returned as driveItem resources. +-- +-- https://learn.microsoft.com/en-us/graph/api/resources/driveitem?view=graph-rest-1.0 data DriveItem = DriveItem { diId :: Text , diName :: Text - , diLastModifiedDateTime :: LocalTime - } deriving (Eq, Ord, Show, Generic) + , diLastModifiedDateTime :: ZonedTime -- 2022-11-28T09:18:45Z + , diItem :: DIItem + } deriving (Show, Generic) +instance A.ToJSON DriveItem + instance A.FromJSON DriveItem where - parseJSON = A.genericParseJSON (MSG.aesonOptions "di") + parseJSON = A.withObject "DriveItem" $ \o -> DriveItem <$> + o A..: "id" <*> + o A..: "name" <*> + o A..: "lastModifiedDateTime" <*> + diItemP o +diItemP :: A.Object -> A.Parser DIItem +diItemP o = + (DIIFile <$> o A..: "file") <|> + (DIIFolder <$> o A..: "folder") <|> + (DIIRemoteItem <$ o .: "remoteItem") <|> + (DIIPhoto <$ o .: "photo") <|> + (DIIVideo <$ o .: "video") <|> + (DIIBundle <$ o .: "bundle") <|> + (DIIPackage <$> o A..: "package") + +(.:) :: A.Object -> A.Key -> A.Parser () +(.:) = (A..:) + +-- | A sum type for the various drive item types +-- +-- This is a departure from the original API but makes it convenient to pattern match on constructors +data DIItem = DIIFile File + | DIIFolder Folder + | DIIRemoteItem + | DIIPhoto + | DIIVideo + | DIIBundle + | DIIPackage Package + deriving (Eq, Ord, Show, Generic) +instance A.ToJSON DIItem where + toJSON = \case + DIIFile f -> A.toJSON f + DIIFolder f -> A.toJSON f + DIIPackage f -> A.toJSON f + e -> A.toJSON $ drop 3 (show e) -- FIXME hack + +-- | The Folder resource groups folder-related data on an item into a single structure. DriveItems with a non-null folder facet are containers for other DriveItems. +-- +-- https://learn.microsoft.com/en-us/graph/api/resources/folder?view=graph-rest-1.0 +data Folder = Folder { + difoChildCount :: Int32 + } deriving (Eq, Ord, Show, Generic) +instance A.FromJSON Folder where + parseJSON = A.genericParseJSON (MSG.aesonOptions "difo") +instance A.ToJSON Folder + +-- | The File resource groups file-related data items into a single structure. +-- +-- https://learn.microsoft.com/en-us/graph/api/resources/file?view=graph-rest-1.0 +data File = File { + difiMimeType :: Text + } deriving (Eq, Ord, Show, Generic) +instance A.FromJSON File where + parseJSON = A.genericParseJSON (MSG.aesonOptions "difi") +instance A.ToJSON File + +data Package = Package { + dipType :: Text + } deriving (Eq, Ord, Show, Generic) +instance A.FromJSON Package where + parseJSON = A.genericParseJSON (MSG.aesonOptions "dip") +instance A.ToJSON Package + -- | download a complete file from user's directory -- -- @GET \/me\/drive\/items\/{item-id}\/content@ @@ -44,3 +129,31 @@ -> Text -- ^ file ID -> AccessToken -> Req LBS.ByteString downloadFile did itemId = MSG.getLbs ["drives", did, "items", itemId, "content"] mempty + +-- | List children in the root of the current user's drive +-- +-- @GET \/me\/drive\/root\/children@ +-- +-- https://learn.microsoft.com/en-us/graph/api/driveitem-list-children?view=graph-rest-1.0&tabs=http#list-children-in-the-root-of-the-current-users-drive +listRootChildrenMe :: AccessToken -> Req (MSG.Collection DriveItem) +listRootChildrenMe = MSG.get ["me", "drive", "root", "children"] mempty + + +-- | List children of an item of a group drive +-- +-- @GET \/groups\/{group-id}\/drive\/items\/{item-id}\/children@ +-- +-- https://learn.microsoft.com/en-us/graph/api/driveitem-list-children?view=graph-rest-1.0&tabs=http +listGroupItemChildren :: Text -- ^ group ID + -> Text -- ^ item ID + -> AccessToken -> Req (MSG.Collection DriveItem) +listGroupItemChildren gid iid = + MSG.get ["groups", gid, "drive", "items", iid, "children"] mempty + +-- -- | List children of the root item of a group drive +-- -- +-- -- @GET \/groups\/{group-id}\/drive\/root\/children@ +-- listGroupRootChildren :: Text -- ^ group ID +-- -> AccessToken -> Req (MSG.Collection DriveItem) +-- listGroupRootChildren gid = +-- MSG.get ["groups", gid, "drive", "root", "children"] mempty -- TODO DOUBLE CHECK PATH diff --git a/src/MSGraphAPI/Internal/Common.hs b/src/MSGraphAPI/Internal/Common.hs --- a/src/MSGraphAPI/Internal/Common.hs +++ b/src/MSGraphAPI/Internal/Common.hs @@ -4,18 +4,23 @@ -- -- https://learn.microsoft.com/en-us/graph/api/overview?view=graph-rest-1.0&preserve-view=true module MSGraphAPI.Internal.Common ( + -- * PUT + put -- * GET - get + , get , getLbs - -- ** catch HTTP exceptions - , getE + -- -- ** catch HTTP exceptions + -- , getE -- * POST , post - -- ** catch HTTP exceptions - , postE + -- -- ** catch HTTP exceptions + -- , postE -- * running requests + , run , runReq , tryReq + -- * HTTP(S) connections + , withTLS -- * JSON : aeson helpers , Collection(..) , aesonOptions @@ -40,10 +45,12 @@ -- hoauth2 import Network.OAuth.OAuth2 (OAuth2Token(..)) import Network.OAuth.OAuth2.Internal (AccessToken(..), ExchangeToken(..), RefreshToken(..), OAuth2Error, IdToken(..)) +-- http-client-tls +import Network.HTTP.Client.TLS (newTlsManager) -- modern-uri import Text.URI (URI, mkURI) -- req -import Network.HTTP.Req (Req, runReq, HttpException(..), defaultHttpConfig, req, Option, (=:), GET(..), POST(..), Url, Scheme(..), useHttpsURI, https, (/:), ReqBodyJson(..), NoReqBody(..), oAuth2Bearer, HttpResponse(..), jsonResponse, JsonResponse, lbsResponse, LbsResponse, bsResponse, BsResponse, responseBody) +import Network.HTTP.Req (Req, runReq, HttpException(..), HttpConfig(..), defaultHttpConfig, req, Option, (=:), GET(..), POST(..), PUT(..), Url, Scheme(..), useHttpsURI, https, (/:), ReqBodyJson(..), NoReqBody(..), oAuth2Bearer, HttpResponse(..), jsonResponse, JsonResponse, lbsResponse, LbsResponse, bsResponse, BsResponse, responseBody) -- text import Data.Text (Text, pack, unpack) -- unliftio @@ -59,12 +66,36 @@ tryReq = try --- -- GET, POST +-- | Create a new TLS manager, which should be reused throughout the program +withTLS :: MonadIO m => + (HttpConfig -> m b) -- ^ user program + -> m b +withTLS act = do + mgr <- newTlsManager + let + hc = defaultHttpConfig { httpConfigAltManager = Just mgr } + act hc +-- | Run a 'Req' computation +run :: MonadIO m => + HttpConfig -> Req a -> m (Either HttpException a) +run hc = runReq hc . tryReq + + +-- * REST verbs + +put :: (A.FromJSON b, A.ToJSON a) => + [Text] + -> Option 'Https -> a -> AccessToken -> Req b +put paths params bdy tok = responseBody <$> req PUT url (ReqBodyJson bdy) jsonResponse opts + where + opts = auth <> params + (url, auth) = msGraphReqConfig tok paths + -- | @POST https:\/\/graph.microsoft.com\/v1.0\/...@ post :: (A.ToJSON a, A.FromJSON b) => [Text] -- ^ URI path segments - -> Option 'Https + -> Option 'Https -- ^ request parameters etc. -> a -- ^ request body -> AccessToken -> Req b @@ -73,16 +104,16 @@ opts = auth <> params (url, auth) = msGraphReqConfig tok paths --- | Like 'post' but catches 'HttpException's to allow pattern matching -postE :: (A.ToJSON a, A.FromJSON b) => - [Text] -- ^ URI path segments - -> Option 'Https -> a -> AccessToken -> Req (Either HttpException b) -postE paths params bdy tok = tryReq (post paths params bdy tok) +-- -- | Like 'post' but catches 'HttpException's to allow pattern matching +-- postE :: (A.ToJSON a, A.FromJSON b) => +-- [Text] -- ^ URI path segments +-- -> Option 'Https -> a -> AccessToken -> Req (Either HttpException b) +-- postE paths params bdy tok = tryReq (post paths params bdy tok) -- | @GET https:\/\/graph.microsoft.com\/v1.0\/...@ get :: A.FromJSON a => [Text] -- ^ URI path segments - -> Option 'Https + -> Option 'Https -- ^ request parameters etc. -> AccessToken -> Req a get paths params tok = responseBody <$> req GET url NoReqBody jsonResponse opts @@ -90,11 +121,11 @@ opts = auth <> params (url, auth) = msGraphReqConfig tok paths --- | Like 'get' but catches 'HttpException's to allow pattern matching -getE :: (A.FromJSON a) => - [Text] -- ^ URI path segments - -> Option 'Https -> AccessToken -> Req (Either HttpException a) -getE paths params tok = tryReq (get paths params tok) +-- -- | Like 'get' but catches 'HttpException's to allow pattern matching +-- getE :: (A.FromJSON a) => +-- [Text] -- ^ URI path segments +-- -> Option 'Https -> AccessToken -> Req (Either HttpException a) +-- getE paths params tok = tryReq (get paths params tok) -- | @GET https:\/\/graph.microsoft.com\/v1.0\/...@ -- @@ -122,9 +153,13 @@ -- | a collection of items with key @value@ data Collection a = Collection { cValue :: [a] + , cNextLink :: Maybe Text } deriving (Eq, Show, Generic) +instance A.ToJSON a => A.ToJSON (Collection a) instance A.FromJSON a => A.FromJSON (Collection a) where - parseJSON = A.genericParseJSON (aesonOptions "c") + parseJSON = A.withObject "Collection" $ \o -> Collection <$> + o A..: "value" <*> + o A..:? "@odata.nextLink" -- | drop the prefix and lowercase first character -- diff --git a/src/MSGraphAPI/Users/Group.hs b/src/MSGraphAPI/Users/Group.hs --- a/src/MSGraphAPI/Users/Group.hs +++ b/src/MSGraphAPI/Users/Group.hs @@ -1,5 +1,13 @@ --- | User -module MSGraphAPI.Users.Group where +-- | Users.Group +module MSGraphAPI.Users.Group ( + -- * Teams + getUserJoinedTeams + , getMeJoinedTeams + -- * Drive items + , getGroupsDriveItems + -- * types + , Group(..) + )where import GHC.Generics (Generic(..)) @@ -25,8 +33,9 @@ } deriving (Eq, Ord, Show, Generic) instance A.FromJSON Group where parseJSON = A.genericParseJSON (MSG.aesonOptions "g") +instance A.ToJSON Group --- | Get the teams in Microsoft Teams that the user is a direct member of. +-- | Get the teams in Microsoft Teams that the given user is a direct member of. -- -- @GET \/users\/{id | user-principal-name}\/joinedTeams@ -- @@ -34,6 +43,14 @@ getUserJoinedTeams :: Text -- ^ User ID -> AccessToken -> Req (MSG.Collection Group) getUserJoinedTeams uid = MSG.get ["users", uid, "joinedTeams"] mempty + +-- | Get the teams in Microsoft Teams that the current user is a direct member of. +-- +-- @GET \/me\/joinedTeams@ +-- +-- https://learn.microsoft.com/en-us/graph/api/user-list-joinedteams?view=graph-rest-1.0&tabs=http +getMeJoinedTeams :: AccessToken -> Req (MSG.Collection Group) +getMeJoinedTeams = MSG.get ["me", "joinedTeams"] mempty -- | Get the 'DriveItem's in the 'Group' storage, starting from the root item -- diff --git a/src/MSGraphAPI/Users/User.hs b/src/MSGraphAPI/Users/User.hs --- a/src/MSGraphAPI/Users/User.hs +++ b/src/MSGraphAPI/Users/User.hs @@ -1,4 +1,4 @@ --- | User +-- | Users.User module MSGraphAPI.Users.User where import GHC.Generics (Generic(..))