From c02d31679df83c77abe5708d3e6af2cc4beee28e Mon Sep 17 00:00:00 2001 From: Marco Zocca Date: Sun, 2 Jul 2023 12:52:01 +0200 Subject: [PATCH] graph api v0.9 --- ms-graph-api-test/app/Main.hs | 89 +++++++++++-------- ms-graph-api-test/ms-graph-api-test.cabal | 10 ++- ms-graph-api/CHANGELOG.md | 6 +- ms-graph-api/ms-graph-api.cabal | 5 +- ms-graph-api/src/MSGraphAPI/Files/Drive.hs | 16 ++-- .../src/MSGraphAPI/Files/DriveItem.hs | 8 +- .../src/MSGraphAPI/Internal/Common.hs | 6 +- ms-graph-api/src/MSGraphAPI/Users/Group.hs | 10 ++- ms-graph-api/src/MSGraphAPI/Users/User.hs | 17 ++-- 9 files changed, 100 insertions(+), 67 deletions(-) diff --git a/ms-graph-api-test/app/Main.hs b/ms-graph-api-test/app/Main.hs index 65bf696..8613f72 100644 --- a/ms-graph-api-test/app/Main.hs +++ b/ms-graph-api-test/app/Main.hs @@ -5,11 +5,12 @@ module Main (main) where import Control.Monad.IO.Class (MonadIO(..)) +import Data.Maybe (fromMaybe) -- aeson-pretty import qualified Data.Aeson.Encode.Pretty as A (encodePretty) -- bytestring -import qualified Data.ByteString.Lazy.Char8 as LBS (putStrLn) +import qualified Data.ByteString.Lazy.Char8 as LBS (putStrLn, pack) -- hoauth2 import Network.OAuth.OAuth2 (OAuth2Token(..)) import Network.OAuth2.Experiment (IdpApplication, GrantTypeFlow(..)) @@ -18,7 +19,7 @@ import Network.HTTP.Client (Manager, newManager) -- http-client-tls import Network.HTTP.Client.TLS (tlsManagerSettings) -- req -import Network.HTTP.Req (runReq, defaultHttpConfig, httpConfigAltManager) +import Network.HTTP.Req (HttpConfig, runReq, defaultHttpConfig, httpConfigAltManager) -- scotty import Web.Scotty.Trans (ScottyT, scottyT, get, text, html, RoutePattern, middleware) -- text @@ -34,8 +35,10 @@ import URI.ByteString.QQ (uri) -- wai-extra import Network.Wai.Middleware.RequestLogger (logStdoutDev) +import qualified MSGraphAPI as MSG (Collection(..), run, withTLS) +import qualified MSGraphAPI.Files.Drive as MSD (Drive(..), listDrivesGroup) import qualified MSGraphAPI.Files.DriveItem as MSDI (listRootChildrenMe) -import qualified MSGraphAPI.Users.Group as MSGU (getMeJoinedTeams) +import qualified MSGraphAPI.Users.Group as MSGU (Group(..), getMeJoinedTeams, getGroupsDriveItems) import qualified MSGraphAPI.Users.User as MSG (getMe, User(..)) import Network.OAuth2.Provider.AzureAD (OAuthCfg(..), azureOAuthADApp, AzureAD) import MSAuth (applyDotEnv, Tokens, newTokens, tokensToList, withAADUser, loginEndpoint, replyEndpoint, UserSub, Scotty, Action) @@ -48,41 +51,55 @@ server :: MonadIO m => m () server = do ts <- newTokens applyDotEnv (Just ".env") - mgr <- liftIO $ newManager tlsManagerSettings ip <- idpApp - let - runR r = runReaderT r ts - scottyT 3000 runR $ do - middleware logStdoutDev - loginEndpoint ip "/oauth/login" - replyEndpoint ip ts mgr "/oauth/reply" - allTokensEndpoint ts "/tokens" - currentUsersEndpoint ts (Just mgr) "/me" - meFilesEndpoint ts (Just mgr) "/me/files" - meTeamsEndpoint ts (Just mgr) "/me/teams" - --- currentUserEndpoint :: MonadIO m => --- Tokens UserSub OAuth2Token --- -> RoutePattern -> Scotty m () --- currentUserEndpoint ts pth = get pth $ withAADUser ts "/oauth/login" $ \oat -> do --- let --- t = accessToken oat --- u <- runReq defaultHttpConfig $ MSG.getMe t --- let --- uname = MSG.uDisplayName u --- h = TL.pack $ unwords ["", "

", T.unpack uname, "

",""] --- html h + MSG.withTLS $ \hc mgr -> do + let + runR r = runReaderT r ts + scottyT 3000 runR $ do + middleware logStdoutDev + loginEndpoint ip "/oauth/login" + replyEndpoint ip ts mgr "/oauth/reply" + + meGroupDrivesEndpoint ts hc "/me/group/drives" + currentUsersEndpoint ts hc "/me" + meFilesEndpoint ts hc "/me/files" + meTeamsEndpoint ts hc "/me/teams" + + +groupDriveItems t = do + gs <- MSG.cValue <$> MSGU.getMeJoinedTeams t + traverse (\g -> MSGU.getGroupsDriveItems (MSGU.gId g) t ) gs + +meGroupDrivesEndpoint :: (MonadIO m) => + Tokens a OAuth2Token + -> HttpConfig -> RoutePattern -> Scotty m () +meGroupDrivesEndpoint ts hc pth = get pth $ do + tsl <- tokensToList ts + let + f (_, oat) = do + let + t = accessToken oat + iteme <- MSG.run hc $ groupDriveItems t + case iteme of + Right item -> pure $ A.encodePretty item + Left e -> pure $ LBS.pack $ show e + rows <- traverse f tsl + text $ TL.decodeUtf8 $ mconcat rows + + + + meTeamsEndpoint :: (MonadIO m) => Tokens a OAuth2Token - -> Maybe Manager -> RoutePattern -> Scotty m () -meTeamsEndpoint ts mmgr pth = get pth $ do + -> HttpConfig -> RoutePattern -> Scotty m () +meTeamsEndpoint ts hc pth = get pth $ do tsl <- tokensToList ts let f (_, oat) = do let t = accessToken oat - item <- runReq defaultHttpConfig{ httpConfigAltManager = mmgr } $ MSGU.getMeJoinedTeams t + item <- runReq hc $ MSGU.getMeJoinedTeams t let js = A.encodePretty item pure js @@ -91,14 +108,14 @@ meTeamsEndpoint ts mmgr pth = get pth $ do meFilesEndpoint :: (MonadIO m) => Tokens a OAuth2Token - -> Maybe Manager -> RoutePattern -> Scotty m () -meFilesEndpoint ts mmgr pth = get pth $ do + -> HttpConfig -> RoutePattern -> Scotty m () +meFilesEndpoint ts hc pth = get pth $ do tsl <- tokensToList ts let f (_, oat) = do let t = accessToken oat - item <- runReq defaultHttpConfig{ httpConfigAltManager = mmgr } $ MSDI.listRootChildrenMe t + item <- runReq hc $ MSDI.listRootChildrenMe t let js = A.encodePretty item pure js @@ -107,15 +124,15 @@ meFilesEndpoint ts mmgr pth = get pth $ do currentUsersEndpoint :: (MonadIO m) => Tokens a OAuth2Token - -> Maybe Manager -- ^ if Nothing it uses the default implicit connection manager + -> HttpConfig -> RoutePattern -> Scotty m () -currentUsersEndpoint ts mmgr pth = get pth $ do +currentUsersEndpoint ts hc pth = get pth $ do tsl <- tokensToList ts let f (_, oat) = do let t = accessToken oat - usr <- runReq defaultHttpConfig{ httpConfigAltManager = mmgr } $ MSG.getMe t + usr <- runReq hc $ MSG.getMe t let row = unwords ["", show usr, ""] pure row @@ -141,7 +158,7 @@ table mm = TL.pack ("" <> foldMap insf mm <> "
") idpApp :: MonadIO m => m (IdpApplication 'AuthorizationCode AzureAD) idpApp = azureOAuthADApp (OAuthCfg "ms-graph-api-test" - ["profile", "email", "User.Read", "Files.Read", "Team.ReadBasic.All"] + ["profile", "email", "User.Read", "Files.Read.All", "Team.ReadBasic.All"] "abcd1234" [uri|https://66e7-213-89-187-253.ngrok-free.app/oauth/reply|] ) diff --git a/ms-graph-api-test/ms-graph-api-test.cabal b/ms-graph-api-test/ms-graph-api-test.cabal index b5f7f70..46baf06 100644 --- a/ms-graph-api-test/ms-graph-api-test.cabal +++ b/ms-graph-api-test/ms-graph-api-test.cabal @@ -19,23 +19,25 @@ library default-language: Haskell2010 hs-source-dirs: src exposed-modules: Lib - build-depends: base >= 4.7 && < 5 + build-depends: base >= 4.7 && < 5, + directory >= 1.3.6.2 ghc-options: -Wall executable ms-graph-api-test default-language: Haskell2010 hs-source-dirs: app main-is: Main.hs - build-depends: base - , aeson + build-depends: aeson , aeson-pretty + , base , bytestring + , directory >= 1.3.6.2 , hoauth2 == 2.6.0 , http-client , http-client-tls >= 0.3 + , ms-auth >= 0.2 , ms-graph-api , ms-graph-api-test - , ms-auth >= 0.2 , req , scotty , text >= 1.2.5.0 diff --git a/ms-graph-api/CHANGELOG.md b/ms-graph-api/CHANGELOG.md index 48f2018..75d38a6 100644 --- a/ms-graph-api/CHANGELOG.md +++ b/ms-graph-api/CHANGELOG.md @@ -13,6 +13,9 @@ and this project adheres to the MSGraphAPI.Files.Drive +*Breaking changes* +- withTLS changed signature: the inner continuation has an additional Manager parameter + ## 0.8.0.0 @@ -28,8 +31,7 @@ MSGraphAPI.ChangeNotifications.Subscription: - add createSubscription *Breaking changes* - -Moved the Network/* module hierarchy to the `ms-auth` package shared with `ms-azure-api`. +- Moved the Network/* module hierarchy to the `ms-auth` package shared with `ms-azure-api`. ## 0.6.0.0 diff --git a/ms-graph-api/ms-graph-api.cabal b/ms-graph-api/ms-graph-api.cabal index d5b83e4..4b97151 100644 --- a/ms-graph-api/ms-graph-api.cabal +++ b/ms-graph-api/ms-graph-api.cabal @@ -27,11 +27,12 @@ library MSGraphAPI.Files.Drive MSGraphAPI.Files.DriveItem other-modules: MSGraphAPI.Internal.Common - build-depends: base >= 4.7 && < 5 - , aeson + build-depends: aeson + , base >= 4.7 && < 5 , bytestring , containers , hoauth2 == 2.6.0 + , http-client >= 0.7.13.1 , http-client-tls >= 0.3 , http-types , modern-uri diff --git a/ms-graph-api/src/MSGraphAPI/Files/Drive.hs b/ms-graph-api/src/MSGraphAPI/Files/Drive.hs index 8f00f5e..1b081dc 100644 --- a/ms-graph-api/src/MSGraphAPI/Files/Drive.hs +++ b/ms-graph-api/src/MSGraphAPI/Files/Drive.hs @@ -5,25 +5,25 @@ module MSGraphAPI.Files.Drive ( , Drive(..) ) where -import Control.Applicative (Alternative(..)) -import Data.Int (Int32) +-- import Control.Applicative (Alternative(..)) +-- import Data.Int (Int32) import GHC.Generics (Generic(..)) -- aeson -import qualified Data.Aeson as A (ToJSON(..), FromJSON(..), Value, genericParseJSON, (.:), (.:?), Object, withObject, Key) -import qualified Data.Aeson.Types as A (Parser) +import qualified Data.Aeson as A (ToJSON(..), FromJSON(..), genericParseJSON) +-- import qualified Data.Aeson.Types as A (Parser) -- bytestring -import qualified Data.ByteString.Lazy as LBS (ByteString) +-- import qualified Data.ByteString.Lazy as LBS (ByteString) -- hoauth import Network.OAuth.OAuth2.Internal (AccessToken(..)) -- req import Network.HTTP.Req (Req) -- text -import Data.Text (Text, pack, unpack) +import Data.Text (Text) -- time import Data.Time (ZonedTime) -import qualified MSGraphAPI.Internal.Common as MSG (get, getLbs, post, Collection, aesonOptions) +import qualified MSGraphAPI.Internal.Common as MSG (get, Collection, aesonOptions) -- | The top-level object that represents a user's OneDrive or a document library in SharePoint. -- @@ -53,4 +53,4 @@ listDrivesMe = MSG.get ["me", "drives"] mempty -- @GET \/groups\/{groupId}\/drives@ listDrivesGroup :: Text -- ^ group ID -> AccessToken -> Req (MSG.Collection Drive) -listDrivesGroup gid = MSG.get ["groups", gid, "drives"] +listDrivesGroup gid = MSG.get ["groups", gid, "drives"] mempty diff --git a/ms-graph-api/src/MSGraphAPI/Files/DriveItem.hs b/ms-graph-api/src/MSGraphAPI/Files/DriveItem.hs index 3c9c173..1b6273f 100644 --- a/ms-graph-api/src/MSGraphAPI/Files/DriveItem.hs +++ b/ms-graph-api/src/MSGraphAPI/Files/DriveItem.hs @@ -18,7 +18,7 @@ import Data.Int (Int32) import GHC.Generics (Generic(..)) -- aeson -import qualified Data.Aeson as A (ToJSON(..), FromJSON(..), Value, genericParseJSON, (.:), (.:?), Object, withObject, Key) +import qualified Data.Aeson as A (ToJSON(..), FromJSON(..), genericParseJSON, (.:), Object, withObject, Key) import qualified Data.Aeson.Types as A (Parser) -- bytestring import qualified Data.ByteString.Lazy as LBS (ByteString) @@ -27,11 +27,11 @@ import Network.OAuth.OAuth2.Internal (AccessToken(..)) -- req import Network.HTTP.Req (Req) -- text -import Data.Text (Text, pack, unpack) +import Data.Text (Text) -- time -import Data.Time (LocalTime, ZonedTime) +import Data.Time (ZonedTime) -import qualified MSGraphAPI.Internal.Common as MSG (get, getLbs, post, Collection, aesonOptions) +import qualified MSGraphAPI.Internal.Common as MSG (get, getLbs, Collection, aesonOptions) -- | The 'DriveItem' resource represents a file, folder, or other item stored in a drive. -- diff --git a/ms-graph-api/src/MSGraphAPI/Internal/Common.hs b/ms-graph-api/src/MSGraphAPI/Internal/Common.hs index 4fbb624..133da85 100644 --- a/ms-graph-api/src/MSGraphAPI/Internal/Common.hs +++ b/ms-graph-api/src/MSGraphAPI/Internal/Common.hs @@ -45,6 +45,8 @@ import qualified Data.ByteString.Lazy.Char8 as LBS8 (pack, unpack, putStrLn) -- hoauth2 import Network.OAuth.OAuth2 (OAuth2Token(..)) import Network.OAuth.OAuth2.Internal (AccessToken(..), ExchangeToken(..), RefreshToken(..), OAuth2Error, IdToken(..)) +-- http-client +import Network.HTTP.Client (Manager) -- http-client-tls import Network.HTTP.Client.TLS (newTlsManager) -- modern-uri @@ -68,13 +70,13 @@ tryReq = try -- | Create a new TLS manager, which should be reused throughout the program withTLS :: MonadIO m => - (HttpConfig -> m b) -- ^ user program + (HttpConfig -> Manager -> m b) -- ^ user program -> m b withTLS act = do mgr <- newTlsManager let hc = defaultHttpConfig { httpConfigAltManager = Just mgr } - act hc + act hc mgr -- | Run a 'Req' computation run :: MonadIO m => diff --git a/ms-graph-api/src/MSGraphAPI/Users/Group.hs b/ms-graph-api/src/MSGraphAPI/Users/Group.hs index fb0b0e9..d8f00f1 100644 --- a/ms-graph-api/src/MSGraphAPI/Users/Group.hs +++ b/ms-graph-api/src/MSGraphAPI/Users/Group.hs @@ -12,15 +12,15 @@ module MSGraphAPI.Users.Group ( import GHC.Generics (Generic(..)) -- aeson -import qualified Data.Aeson as A (ToJSON(..), FromJSON(..), eitherDecode, genericParseJSON, defaultOptions, Options(..), withObject, withText, (.:), (.:?), object, (.=)) +import qualified Data.Aeson as A (ToJSON(..), FromJSON(..), genericParseJSON) -- hoauth import Network.OAuth.OAuth2.Internal (AccessToken(..)) -- req import Network.HTTP.Req (Req) -- text -import Data.Text (Text, pack, unpack) +import Data.Text (Text) -import qualified MSGraphAPI.Internal.Common as MSG (Collection(..), get, post, aesonOptions) +import qualified MSGraphAPI.Internal.Common as MSG (Collection(..), get, aesonOptions) import MSGraphAPI.Files.DriveItem (DriveItem) -- | Groups are collections of principals with shared access to resources in Microsoft services or in your app. Different principals such as users, other groups, devices, and applications can be part of groups. @@ -33,7 +33,7 @@ data Group = Group { } deriving (Eq, Ord, Show, Generic) instance A.FromJSON Group where parseJSON = A.genericParseJSON (MSG.aesonOptions "g") -instance A.ToJSON Group +instance A.ToJSON Group -- | Get the teams in Microsoft Teams that the given user is a direct member of. -- @@ -57,6 +57,8 @@ getMeJoinedTeams = MSG.get ["me", "joinedTeams"] mempty -- @GET \/groups\/{group-id}\/drive\/root\/children@ -- -- https://learn.microsoft.com/en-us/graph/api/driveitem-list-children?view=graph-rest-1.0&tabs=http +-- +-- NB : requires @Files.Read.All@, since it tries to access all files a user has access to. getGroupsDriveItems :: Text -- ^ Group ID -> AccessToken -> Req (MSG.Collection DriveItem) getGroupsDriveItems gid = MSG.get ["groups", gid, "drive", "root", "children"] mempty diff --git a/ms-graph-api/src/MSGraphAPI/Users/User.hs b/ms-graph-api/src/MSGraphAPI/Users/User.hs index 9929a56..62c7f08 100644 --- a/ms-graph-api/src/MSGraphAPI/Users/User.hs +++ b/ms-graph-api/src/MSGraphAPI/Users/User.hs @@ -1,20 +1,26 @@ -- | Users.User -module MSGraphAPI.Users.User where +module MSGraphAPI.Users.User ( + get + , getMe + -- * types + , User(..)) where import GHC.Generics (Generic(..)) -- aeson -import qualified Data.Aeson as A (ToJSON(..), FromJSON(..), genericParseJSON, defaultOptions, Options(..), withObject, withText, (.:), (.:?), object, (.=)) +import qualified Data.Aeson as A (ToJSON(..), FromJSON(..), genericParseJSON) -- hoauth import Network.OAuth.OAuth2.Internal (AccessToken(..)) -- req import Network.HTTP.Req (Req) -- text -import Data.Text (Text, pack, unpack) - -import qualified MSGraphAPI.Internal.Common as MSG (get, post, aesonOptions) +import Data.Text (Text) +import qualified MSGraphAPI.Internal.Common as MSG (get, aesonOptions) +-- | Representation of a user in the MS Graph API +-- +-- https://learn.microsoft.com/en-us/graph/api/resources/users?view=graph-rest-1.0 data User = User { uId :: Text , uUserPrincipalName :: Text @@ -22,6 +28,7 @@ data User = User { } deriving (Eq, Ord, Show, Generic) instance A.FromJSON User where parseJSON = A.genericParseJSON (MSG.aesonOptions "u") +instance A.ToJSON User -- | Get user information