From e1cd889814e07bbe1ffbe07bb24fe42c7e566592 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Wed, 14 Aug 2024 16:09:45 +0000 Subject: [PATCH 1/5] add list of active refresh tokens to app list --- libs/wire-api/src/Wire/API/OAuth.hs | 30 +++++++++++++++++---- services/brig/src/Brig/API/OAuth.hs | 14 +++++++--- services/brig/test/integration/API/OAuth.hs | 8 +++--- 3 files changed, 39 insertions(+), 13 deletions(-) diff --git a/libs/wire-api/src/Wire/API/OAuth.hs b/libs/wire-api/src/Wire/API/OAuth.hs index 89c28f98370..fc9d47efc40 100644 --- a/libs/wire-api/src/Wire/API/OAuth.hs +++ b/libs/wire-api/src/Wire/API/OAuth.hs @@ -29,6 +29,7 @@ import Data.ByteString.Lazy (fromStrict, toStrict) import Data.Either.Combinators (mapLeft) import Data.HashMap.Strict qualified as HM import Data.Id as Id +import Data.Json.Util import Data.OpenApi (ToParamSchema (..)) import Data.OpenApi qualified as S import Data.Range @@ -650,9 +651,28 @@ instance ToSchema OAuthRevokeRefreshTokenRequest where clientIdDescription = description ?~ "The OAuth client's ID" refreshTokenDescription = description ?~ "The refresh token" +data OAuthSession = OAuthSession + { refreshTokenId :: OAuthRefreshTokenId, + createdAt :: UTCTime + } + deriving (Eq, Show, Ord, Generic) + deriving (Arbitrary) via (GenericUniform OAuthSession) + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema OAuthSession) + +instance ToSchema OAuthSession where + schema = + object "OAuthSession" $ + OAuthSession + <$> (.refreshTokenId) .= fieldWithDocModifier "refresh_token_id" refreshTokenIdDescription schema + <*> (toUTCTimeMillis . (.createdAt)) .= (fromUTCTimeMillis <$> fieldWithDocModifier "created_at" createdAtDescription schema) + where + refreshTokenIdDescription = description ?~ "The ID of the refresh token" + createdAtDescription = description ?~ "The time when the session was created" + data OAuthApplication = OAuthApplication { applicationId :: OAuthClientId, - name :: OAuthApplicationName + name :: OAuthApplicationName, + sessions :: Set OAuthSession } deriving (Eq, Show, Ord, Generic) deriving (Arbitrary) via (GenericUniform OAuthApplication) @@ -662,13 +682,13 @@ instance ToSchema OAuthApplication where schema = object "OAuthApplication" $ OAuthApplication - <$> applicationId - .= fieldWithDocModifier "id" idDescription schema - <*> (.name) - .= fieldWithDocModifier "name" nameDescription schema + <$> applicationId .= fieldWithDocModifier "id" idDescription schema + <*> (.name) .= fieldWithDocModifier "name" nameDescription schema + <*> sessions .= fieldWithDocModifier "sessions" sessionsDescription (set schema) where idDescription = description ?~ "The OAuth client's ID" nameDescription = description ?~ "The OAuth client's name" + sessionsDescription = description ?~ "The OAuth client's sessions" -------------------------------------------------------------------------------- -- Errors diff --git a/services/brig/src/Brig/API/OAuth.hs b/services/brig/src/Brig/API/OAuth.hs index 5ff461bf652..0057f182c37 100644 --- a/services/brig/src/Brig/API/OAuth.hs +++ b/services/brig/src/Brig/API/OAuth.hs @@ -36,6 +36,7 @@ import Crypto.JWT hiding (params, uri) import Data.ByteString.Conversion import Data.Domain import Data.Id +import Data.Map qualified as Map import Data.Misc import Data.Set qualified as Set import Data.Text.Ascii @@ -320,10 +321,15 @@ lookupAndVerifyToken key = getOAuthApplications :: UserId -> (Handler r) [OAuthApplication] getOAuthApplications uid = do activeRefreshTokens <- lift $ wrapClient $ lookupOAuthRefreshTokens uid - nub . catMaybes <$> for activeRefreshTokens oauthApp + toApplications activeRefreshTokens where - oauthApp :: OAuthRefreshTokenInfo -> (Handler r) (Maybe OAuthApplication) - oauthApp info = (OAuthApplication info.clientId . (.name)) <$$> getOAuthClient info.userId info.clientId + toApplications :: [OAuthRefreshTokenInfo] -> (Handler r) [OAuthApplication] + toApplications infos = do + let grouped = Map.fromListWith (<>) $ (\info -> (info.clientId, [info])) <$> infos + mApps <- for (Map.toList grouped) $ \(cid, tokens) -> do + mClient <- getOAuthClient uid cid + pure $ (\client -> OAuthApplication cid client.name (Set.fromList ((\i -> OAuthSession i.refreshTokenId i.createdAt) <$> tokens))) <$> mClient + pure $ catMaybes mApps -------------------------------------------------------------------------------- @@ -404,7 +410,7 @@ insertOAuthRefreshToken maxActiveTokens ttl info = do determineOldestTokensToBeDeleted tokens = take (length sorted - fromIntegral maxActiveTokens + 1) sorted where - sorted = sortOn createdAt tokens + sorted = sortOn (.createdAt) tokens lookupOAuthRefreshTokens :: (MonadClient m) => UserId -> m [OAuthRefreshTokenInfo] lookupOAuthRefreshTokens uid = do diff --git a/services/brig/test/integration/API/OAuth.hs b/services/brig/test/integration/API/OAuth.hs index 3b3eba50b38..f48fb5b343d 100644 --- a/services/brig/test/integration/API/OAuth.hs +++ b/services/brig/test/integration/API/OAuth.hs @@ -439,7 +439,7 @@ testRefreshTokenMaxActiveTokens opts db brig = resp <- createOAuthAccessToken brig accessTokenRequest rid <- extractRefreshTokenId jwk resp.refreshToken tokens <- C.runClient db (lookupOAuthRefreshTokens uid) - liftIO $ assertBool testMsg $ [rid] `hasSameElems` (refreshTokenId <$> tokens) + liftIO $ assertBool testMsg $ [rid] `hasSameElems` ((.refreshTokenId) <$> tokens) pure (rid, cid, secret) delayOneSec rid2 <- do @@ -449,7 +449,7 @@ testRefreshTokenMaxActiveTokens opts db brig = resp <- createOAuthAccessToken brig accessTokenRequest rid <- extractRefreshTokenId jwk resp.refreshToken tokens <- C.runClient db (lookupOAuthRefreshTokens uid) - liftIO $ assertBool testMsg $ [rid1, rid] `hasSameElems` (refreshTokenId <$> tokens) + liftIO $ assertBool testMsg $ [rid1, rid] `hasSameElems` ((.refreshTokenId) <$> tokens) pure rid delayOneSec rid3 <- do @@ -460,7 +460,7 @@ testRefreshTokenMaxActiveTokens opts db brig = rid <- extractRefreshTokenId jwk resp.refreshToken recoverN 3 $ do tokens <- C.runClient db (lookupOAuthRefreshTokens uid) - liftIO $ assertBool testMsg $ [rid2, rid] `hasSameElems` (refreshTokenId <$> tokens) + liftIO $ assertBool testMsg $ [rid2, rid] `hasSameElems` ((.refreshTokenId) <$> tokens) pure rid delayOneSec do @@ -470,7 +470,7 @@ testRefreshTokenMaxActiveTokens opts db brig = resp <- createOAuthAccessToken brig accessTokenRequest rid <- extractRefreshTokenId jwk resp.refreshToken tokens <- C.runClient db (lookupOAuthRefreshTokens uid) - liftIO $ assertBool testMsg $ [rid3, rid] `hasSameElems` (refreshTokenId <$> tokens) + liftIO $ assertBool testMsg $ [rid3, rid] `hasSameElems` ((.refreshTokenId) <$> tokens) where extractRefreshTokenId :: (MonadIO m) => JWK -> OAuthRefreshToken -> m OAuthRefreshTokenId extractRefreshTokenId jwk rt = do From 746ba51b9e1f19f92069b6a2c55885695f875400 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Thu, 15 Aug 2024 08:33:17 +0000 Subject: [PATCH 2/5] fixed roundtrip test --- libs/wire-api/src/Wire/API/OAuth.hs | 8 ++++---- services/brig/src/Brig/API/OAuth.hs | 3 ++- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/libs/wire-api/src/Wire/API/OAuth.hs b/libs/wire-api/src/Wire/API/OAuth.hs index fc9d47efc40..4861631b00a 100644 --- a/libs/wire-api/src/Wire/API/OAuth.hs +++ b/libs/wire-api/src/Wire/API/OAuth.hs @@ -653,7 +653,7 @@ instance ToSchema OAuthRevokeRefreshTokenRequest where data OAuthSession = OAuthSession { refreshTokenId :: OAuthRefreshTokenId, - createdAt :: UTCTime + createdAt :: UTCTimeMillis } deriving (Eq, Show, Ord, Generic) deriving (Arbitrary) via (GenericUniform OAuthSession) @@ -664,7 +664,7 @@ instance ToSchema OAuthSession where object "OAuthSession" $ OAuthSession <$> (.refreshTokenId) .= fieldWithDocModifier "refresh_token_id" refreshTokenIdDescription schema - <*> (toUTCTimeMillis . (.createdAt)) .= (fromUTCTimeMillis <$> fieldWithDocModifier "created_at" createdAtDescription schema) + <*> (.createdAt) .= fieldWithDocModifier "created_at" createdAtDescription schema where refreshTokenIdDescription = description ?~ "The ID of the refresh token" createdAtDescription = description ?~ "The time when the session was created" @@ -672,7 +672,7 @@ instance ToSchema OAuthSession where data OAuthApplication = OAuthApplication { applicationId :: OAuthClientId, name :: OAuthApplicationName, - sessions :: Set OAuthSession + sessions :: [OAuthSession] } deriving (Eq, Show, Ord, Generic) deriving (Arbitrary) via (GenericUniform OAuthApplication) @@ -684,7 +684,7 @@ instance ToSchema OAuthApplication where OAuthApplication <$> applicationId .= fieldWithDocModifier "id" idDescription schema <*> (.name) .= fieldWithDocModifier "name" nameDescription schema - <*> sessions .= fieldWithDocModifier "sessions" sessionsDescription (set schema) + <*> sessions .= fieldWithDocModifier "sessions" sessionsDescription (array schema) where idDescription = description ?~ "The OAuth client's ID" nameDescription = description ?~ "The OAuth client's name" diff --git a/services/brig/src/Brig/API/OAuth.hs b/services/brig/src/Brig/API/OAuth.hs index 0057f182c37..b9e69c4c613 100644 --- a/services/brig/src/Brig/API/OAuth.hs +++ b/services/brig/src/Brig/API/OAuth.hs @@ -36,6 +36,7 @@ import Crypto.JWT hiding (params, uri) import Data.ByteString.Conversion import Data.Domain import Data.Id +import Data.Json.Util (toUTCTimeMillis) import Data.Map qualified as Map import Data.Misc import Data.Set qualified as Set @@ -328,7 +329,7 @@ getOAuthApplications uid = do let grouped = Map.fromListWith (<>) $ (\info -> (info.clientId, [info])) <$> infos mApps <- for (Map.toList grouped) $ \(cid, tokens) -> do mClient <- getOAuthClient uid cid - pure $ (\client -> OAuthApplication cid client.name (Set.fromList ((\i -> OAuthSession i.refreshTokenId i.createdAt) <$> tokens))) <$> mClient + pure $ (\client -> OAuthApplication cid client.name ((\i -> OAuthSession i.refreshTokenId (toUTCTimeMillis i.createdAt)) <$> tokens)) <$> mClient pure $ catMaybes mApps -------------------------------------------------------------------------------- From 22574ac42f8ede0a1bc5131c61ecb67b4b7c67d4 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Thu, 15 Aug 2024 14:54:36 +0000 Subject: [PATCH 3/5] integration test --- integration/integration.cabal | 1 + integration/test/API/Brig.hs | 38 +++++++++++++++++++++ integration/test/API/BrigInternal.hs | 6 ++++ integration/test/Test/OAuth.hs | 25 ++++++++++++++ integration/test/Testlib/HTTP.hs | 10 ++++++ services/brig/test/integration/API/OAuth.hs | 6 ++-- 6 files changed, 83 insertions(+), 3 deletions(-) create mode 100644 integration/test/Test/OAuth.hs diff --git a/integration/integration.cabal b/integration/integration.cabal index 1b5069a2b4b..30bc3c641c3 100644 --- a/integration/integration.cabal +++ b/integration/integration.cabal @@ -139,6 +139,7 @@ library Test.MLS.SubConversation Test.MLS.Unreachable Test.Notifications + Test.OAuth Test.Presence Test.Property Test.Provider diff --git a/integration/test/API/Brig.hs b/integration/test/API/Brig.hs index 898afda288e..e6233bcda94 100644 --- a/integration/test/API/Brig.hs +++ b/integration/test/API/Brig.hs @@ -694,3 +694,41 @@ clearProperties :: (MakesValue user) => user -> App Response clearProperties user = do req <- baseRequest user Brig Versioned $ joinHttpPath ["properties"] submit "DELETE" req + +-- | https://staging-nginz-https.zinfra.io/v6/api/swagger-ui/#/default/post_oauth_authorization_codes +generateOAuthAuthorizationCode :: (HasCallStack, MakesValue user, MakesValue cid) => user -> cid -> [String] -> String -> App Response +generateOAuthAuthorizationCode user cid scopes redirectUrl = do + cidStr <- asString cid + req <- baseRequest user Brig Versioned "/oauth/authorization/codes" + submit "POST" $ + req + & addJSONObject + [ "client_id" .= cidStr, + "scope" .= unwords scopes, + "redirect_uri" .= redirectUrl, + "code_challenge" .= "G7CWLBqYDT8doT_oEIN3un_QwZWYKHmOqG91nwNzITc", + "code_challenge_method" .= "S256", + "response_type" .= "code", + "state" .= "abc" + ] + +-- | https://staging-nginz-https.zinfra.io/v6/api/swagger-ui/#/default/post_oauth_token +createOAuthAccessToken :: (HasCallStack, MakesValue user, MakesValue cid) => user -> cid -> String -> String -> App Response +createOAuthAccessToken user cid code redirectUrl = do + cidStr <- asString cid + req <- baseRequest user Brig Versioned "/oauth/token" + submit "POST" $ + req + & addUrlEncodedForm + [ ("grant_type", "authorization_code"), + ("client_id", cidStr), + ("code_verifier", "nE3k3zykOmYki~kriKzAmeFiGT7cWugcuToFwo1YPgrZ1cFvaQqLa.dXY9MnDj3umAmG-8lSNIYIl31Cs_.fV5r2psa4WWZcB.Nlc3A-t3p67NDZaOJjIiH~8PvUH_hR"), + ("code", code), + ("redirect_uri", redirectUrl) + ] + +-- | https://staging-nginz-https.zinfra.io/v6/api/swagger-ui/#/default/get_oauth_applications +getOAuthApplications :: (HasCallStack, MakesValue user) => user -> App Response +getOAuthApplications user = do + req <- baseRequest user Brig Versioned "/oauth/applications" + submit "GET" req diff --git a/integration/test/API/BrigInternal.hs b/integration/test/API/BrigInternal.hs index ccdeb10224c..0e840713bc3 100644 --- a/integration/test/API/BrigInternal.hs +++ b/integration/test/API/BrigInternal.hs @@ -278,3 +278,9 @@ deleteFeatureForUser user featureName = do uid <- objId user req <- baseRequest user Brig Unversioned $ joinHttpPath ["i", "users", uid, "features", featureName] submit "DELETE" req + +-- | https://staging-nginz-https.zinfra.io/api-internal/swagger-ui/brig/#/brig/post_i_oauth_clients +createOAuthClient :: (HasCallStack, MakesValue user) => user -> String -> String -> App Response +createOAuthClient user name url = do + req <- baseRequest user Brig Unversioned "i/oauth/clients" + submit "POST" $ req & addJSONObject ["application_name" .= name, "redirect_url" .= url] diff --git a/integration/test/Test/OAuth.hs b/integration/test/Test/OAuth.hs new file mode 100644 index 00000000000..4a98a235872 --- /dev/null +++ b/integration/test/Test/OAuth.hs @@ -0,0 +1,25 @@ +module Test.OAuth where + +import API.Brig +import API.BrigInternal +import Data.String.Conversions +import Network.HTTP.Types +import Network.URI +import SetupHelpers +import Testlib.Prelude + +testListApplicationsWithActiveSessions :: (HasCallStack) => App () +testListApplicationsWithActiveSessions = do + user <- randomUser OwnDomain def + oauthClient <- createOAuthClient user "foobar" "https://example.com" >>= getJSON 200 + cid <- oauthClient %. "client_id" + let scopes = ["write:conversations"] + let generateAccessToken = do + authCodeResponse <- generateOAuthAuthorizationCode user cid scopes "https://example.com" + let location = fromMaybe (error "no location header") $ parseURI . cs . snd =<< locationHeader authCodeResponse + let code = maybe "no code query param" cs $ join $ lookup (cs "code") $ parseQuery $ cs location.uriQuery + void $ createOAuthAccessToken user cid code "https://example.com" >>= getJSON 200 + replicateM_ 2 generateAccessToken + [app] <- getOAuthApplications user >>= getJSON 200 >>= asList + sessions <- app %. "sessions" >>= asList + length sessions `shouldMatchInt` 2 diff --git a/integration/test/Testlib/HTTP.hs b/integration/test/Testlib/HTTP.hs index 14c285f964a..6f1a9677eec 100644 --- a/integration/test/Testlib/HTTP.hs +++ b/integration/test/Testlib/HTTP.hs @@ -17,6 +17,7 @@ import Data.String import Data.String.Conversions (cs) import qualified Data.Text as T import qualified Data.Text.Encoding as T +import Data.Tuple.Extra import GHC.Generics import GHC.Stack import qualified Network.HTTP.Client as HTTP @@ -41,6 +42,15 @@ addJSONObject = addJSON . Aeson.object addJSON :: (Aeson.ToJSON a) => a -> HTTP.Request -> HTTP.Request addJSON obj = addBody (HTTP.RequestBodyLBS (Aeson.encode obj)) "application/json" +addUrlEncodedForm :: [(String, String)] -> HTTP.Request -> HTTP.Request +addUrlEncodedForm form req = + req + { HTTP.requestBody = HTTP.RequestBodyLBS (L.fromStrict (HTTP.renderSimpleQuery False (both C8.pack <$> form))), + HTTP.requestHeaders = + (fromString "Content-Type", fromString "application/x-www-form-urlencoded") + : HTTP.requestHeaders req + } + addBody :: HTTP.RequestBody -> String -> HTTP.Request -> HTTP.Request addBody body contentType req = req diff --git a/services/brig/test/integration/API/OAuth.hs b/services/brig/test/integration/API/OAuth.hs index f48fb5b343d..9c6a0a92abf 100644 --- a/services/brig/test/integration/API/OAuth.hs +++ b/services/brig/test/integration/API/OAuth.hs @@ -16,7 +16,7 @@ -- with this program. If not, see . {-# OPTIONS_GHC -fno-warn-orphans #-} -module API.OAuth where +module API.OAuth (tests) where import API.Team.Util qualified as Team import Bilge @@ -609,14 +609,14 @@ testListApplicationsWithAccountAccess brig = do bob <- createUser "bob" brig do apps <- listOAuthApplications brig (User.userId alice) - liftIO $ assertEqual "apps" 0 (length apps) + liftIO $ apps @?= [] void $ createOAuthApplicationWithAccountAccess brig (User.userId alice) void $ createOAuthApplicationWithAccountAccess brig (User.userId alice) do aliceApps <- listOAuthApplications brig (User.userId alice) liftIO $ assertEqual "apps" 2 (length aliceApps) bobsApps <- listOAuthApplications brig (User.userId bob) - liftIO $ assertEqual "apps" 0 (length bobsApps) + liftIO $ bobsApps @?= [] void $ createOAuthApplicationWithAccountAccess brig (User.userId alice) void $ createOAuthApplicationWithAccountAccess brig (User.userId bob) do From 2c4fafac57b665458338d2e255c02245fe62a0cc Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Thu, 15 Aug 2024 14:58:32 +0000 Subject: [PATCH 4/5] changelog --- changelog.d/2-features/WPB-1334 | 1 + 1 file changed, 1 insertion(+) create mode 100644 changelog.d/2-features/WPB-1334 diff --git a/changelog.d/2-features/WPB-1334 b/changelog.d/2-features/WPB-1334 new file mode 100644 index 00000000000..ee6519d1ea2 --- /dev/null +++ b/changelog.d/2-features/WPB-1334 @@ -0,0 +1 @@ +Adds a field to each OAuth application in the response of `GET /oauth/applications` which contains a list of all active sessions. From 938483d48b16f4f326a944b0e61fe97aebfc9e0a Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Thu, 15 Aug 2024 15:01:06 +0000 Subject: [PATCH 5/5] rephrased changelog --- changelog.d/2-features/WPB-1334 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/changelog.d/2-features/WPB-1334 b/changelog.d/2-features/WPB-1334 index ee6519d1ea2..a9741efd7ee 100644 --- a/changelog.d/2-features/WPB-1334 +++ b/changelog.d/2-features/WPB-1334 @@ -1 +1 @@ -Adds a field to each OAuth application in the response of `GET /oauth/applications` which contains a list of all active sessions. +Adds a field which contains a list of all active sessions to each OAuth application in the response of `GET /oauth/applications`