Register and Update OAuth client via Stern/Backoffice

changelog.d/5-internal/pr-3305

@@ -0,0 +1 @@
+Register/Update OAuth client via backoffice/stern

integration/test/API/BrigInternal.hs

@@ -43,3 +43,30 @@ createUser domain cu = do
                  | cu.team
                ]
         )
+
+registerOAuthClient :: (HasCallStack, MakesValue user, MakesValue name, MakesValue url) => user -> name -> url -> App Response
+registerOAuthClient user name url = do
+  req <- baseRequest user Brig Unversioned "i/oauth/clients"
+  applicationName <- asString name
+  redirectUrl <- asString url
+  submit "POST" (req & addJSONObject ["application_name" .= applicationName, "redirect_url" .= redirectUrl])
+
+getOAuthClient :: (HasCallStack, MakesValue user, MakesValue cid) => user -> cid -> App Response
+getOAuthClient user cid = do
+  clientId <- objId cid
+  req <- baseRequest user Brig Unversioned $ "i/oauth/clients/" <> clientId
+  submit "GET" req
+
+updateOAuthClient :: (HasCallStack, MakesValue user, MakesValue cid, MakesValue name, MakesValue url) => user -> cid -> name -> url -> App Response
+updateOAuthClient user cid name url = do
+  clientId <- objId cid
+  req <- baseRequest user Brig Unversioned $ "i/oauth/clients/" <> clientId
+  applicationName <- asString name
+  redirectUrl <- asString url
+  submit "PUT" (req & addJSONObject ["application_name" .= applicationName, "redirect_url" .= redirectUrl])
+
+deleteOAuthClient :: (HasCallStack, MakesValue user, MakesValue cid) => user -> cid -> App Response
+deleteOAuthClient user cid = do
+  clientId <- objId cid
+  req <- baseRequest user Brig Unversioned $ "i/oauth/clients/" <> clientId
+  submit "DELETE" req

integration/test/Test/Brig.hs

@@ -18,3 +18,26 @@ testSearchContactForExternalUsers = do
 
   bindResponse (Public.searchContacts partner (owner %. "name")) $ \resp ->
     resp.status `shouldMatchInt` 403
+
+testCrudOAuthClient :: HasCallStack => App ()
+testCrudOAuthClient = do
+  user <- randomUser ownDomain def
+  let appName = "foobar"
+  let url = "https://example.com/callback.html"
+  clientId <- bindResponse (Internal.registerOAuthClient user appName url) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    resp.json %. "client_id"
+  bindResponse (Internal.getOAuthClient user clientId) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    resp.json %. "application_name" `shouldMatch` appName
+    resp.json %. "redirect_url" `shouldMatch` url
+  let newName = "barfoo"
+  let newUrl = "https://example.com/callback2.html"
+  bindResponse (Internal.updateOAuthClient user clientId newName newUrl) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    resp.json %. "application_name" `shouldMatch` newName
+    resp.json %. "redirect_url" `shouldMatch` newUrl
+  bindResponse (Internal.deleteOAuthClient user clientId) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+  bindResponse (Internal.getOAuthClient user clientId) $ \resp -> do
+    resp.status `shouldMatchInt` 404

libs/wire-api/src/Wire/API/OAuth.hs

@@ -100,18 +100,18 @@ newtype OAuthApplicationName = OAuthApplicationName {unOAuthApplicationName :: R
 instance ToSchema OAuthApplicationName where
   schema = OAuthApplicationName <$> unOAuthApplicationName .= schema
 
-data RegisterOAuthClientRequest = RegisterOAuthClientRequest
+data OAuthClientConfig = OAuthClientConfig
   { applicationName :: OAuthApplicationName,
     redirectUrl :: RedirectUrl
   }
   deriving (Eq, Show, Generic)
-  deriving (Arbitrary) via (GenericUniform RegisterOAuthClientRequest)
-  deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema RegisterOAuthClientRequest)
+  deriving (Arbitrary) via (GenericUniform OAuthClientConfig)
+  deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema OAuthClientConfig)
 
-instance ToSchema RegisterOAuthClientRequest where
+instance ToSchema OAuthClientConfig where
   schema =
-    object "RegisterOAuthClientRequest" $
-      RegisterOAuthClientRequest
+    object "OAuthClientConfig" $
+      OAuthClientConfig
         <$> applicationName .= fieldWithDocModifier "application_name" applicationNameDescription schema
         <*> (.redirectUrl) .= fieldWithDocModifier "redirect_url" redirectUrlDescription schema
     where

libs/wire-api/src/Wire/API/Routes/Internal/Brig/OAuth.hs

@@ -17,6 +17,7 @@
 
 module Wire.API.Routes.Internal.Brig.OAuth where
 
+import Data.Id (OAuthClientId)
 import Servant (JSON)
 import Servant hiding (Handler, JSON, Tagged, addHeader, respond)
 import Servant.Swagger.Internal.Orphans ()
@@ -34,6 +35,37 @@ type OAuthAPI =
         :> CanThrow 'OAuthFeatureDisabled
         :> "oauth"
         :> "clients"
-        :> ReqBody '[JSON] RegisterOAuthClientRequest
+        :> ReqBody '[JSON] OAuthClientConfig
         :> Post '[JSON] OAuthClientCredentials
     )
+    :<|> Named
+           "get-oauth-client"
+           ( Summary "Get OAuth client by id"
+               :> CanThrow 'OAuthFeatureDisabled
+               :> CanThrow 'OAuthClientNotFound
+               :> "oauth"
+               :> "clients"
+               :> Capture "id" OAuthClientId
+               :> Get '[JSON] OAuthClient
+           )
+    :<|> Named
+           "update-oauth-client"
+           ( Summary "Update OAuth client"
+               :> CanThrow 'OAuthFeatureDisabled
+               :> CanThrow 'OAuthClientNotFound
+               :> "oauth"
+               :> "clients"
+               :> Capture "id" OAuthClientId
+               :> ReqBody '[JSON] OAuthClientConfig
+               :> Put '[JSON] OAuthClient
+           )
+    :<|> Named
+           "delete-oauth-client"
+           ( Summary "Delete OAuth client"
+               :> CanThrow 'OAuthFeatureDisabled
+               :> CanThrow 'OAuthClientNotFound
+               :> "oauth"
+               :> "clients"
+               :> Capture "id" OAuthClientId
+               :> Delete '[JSON] ()
+           )

libs/wire-api/test/unit/Test/Wire/API/Roundtrip/Aeson.hs

@@ -149,7 +149,7 @@ tests =
       testRoundTrip @Message.ClientMismatch,
       testRoundTrip @OAuth.RedirectUrl,
       testRoundTrip @OAuth.OAuthApplicationName,
-      testRoundTrip @OAuth.RegisterOAuthClientRequest,
+      testRoundTrip @OAuth.OAuthClientConfig,
       testRoundTrip @OAuth.OAuthClient,
       testRoundTrip @OAuth.CreateOAuthAuthorizationCodeRequest,
       testRoundTrip @OAuth.OAuthAccessTokenRequest,

services/brig/src/Brig/API/OAuth.hs

@@ -62,6 +62,9 @@ import qualified Wire.Sem.Now as Now
 internalOauthAPI :: ServerT I.OAuthAPI (Handler r)
 internalOauthAPI =
   Named @"create-oauth-client" registerOAuthClient
+    :<|> Named @"get-oauth-client" getOAuthClientById
+    :<|> Named @"update-oauth-client" updateOAuthClient
+    :<|> Named @"delete-oauth-client" deleteOAuthClient
 
 --------------------------------------------------------------------------------
 -- API Public
@@ -78,8 +81,8 @@ oauthAPI =
 --------------------------------------------------------------------------------
 -- Handlers
 
-registerOAuthClient :: RegisterOAuthClientRequest -> (Handler r) OAuthClientCredentials
-registerOAuthClient (RegisterOAuthClientRequest name uri) = do
+registerOAuthClient :: OAuthClientConfig -> (Handler r) OAuthClientCredentials
+registerOAuthClient (OAuthClientConfig name uri) = do
   unlessM (Opt.setOAuthEnabled <$> view settings) $ throwStd $ errorToWai @'OAuthFeatureDisabled
   credentials@(OAuthClientCredentials cid secret) <- OAuthClientCredentials <$> randomId <*> createSecret
   safeSecret <- liftIO $ hashClientSecret secret
@@ -95,6 +98,23 @@ registerOAuthClient (RegisterOAuthClientRequest name uri) = do
 rand32Bytes :: MonadIO m => m AsciiBase16
 rand32Bytes = liftIO . fmap encodeBase16 $ randBytes 32
 
+getOAuthClientById :: OAuthClientId -> (Handler r) OAuthClient
+getOAuthClientById cid = do
+  unlessM (Opt.setOAuthEnabled <$> view settings) $ throwStd $ errorToWai @'OAuthFeatureDisabled
+  mClient <- lift $ wrapClient $ lookupOauthClient cid
+  maybe (throwStd $ errorToWai @'OAuthClientNotFound) pure mClient
+
+updateOAuthClient :: OAuthClientId -> OAuthClientConfig -> (Handler r) OAuthClient
+updateOAuthClient cid config = do
+  void $ getOAuthClientById cid
+  lift $ wrapClient $ updateOAuthClient' cid config.applicationName config.redirectUrl
+  getOAuthClientById cid
+
+deleteOAuthClient :: OAuthClientId -> (Handler r) ()
+deleteOAuthClient cid = do
+  void $ getOAuthClientById cid
+  lift $ wrapClient $ deleteOAuthClient' cid
+
 --------------------------------------------------------------------------------
 
 getOAuthClient :: UserId -> OAuthClientId -> (Handler r) (Maybe OAuthClient)
@@ -284,6 +304,18 @@ revokeOAuthAccountAccess uid cid = do
 --------------------------------------------------------------------------------
 -- DB
 
+deleteOAuthClient' :: (MonadClient m) => OAuthClientId -> m ()
+deleteOAuthClient' cid = retry x5 . write q $ params LocalQuorum (Identity cid)
+  where
+    q :: PrepQuery W (Identity OAuthClientId) ()
+    q = "DELETE FROM oauth_client WHERE id = ?"
+
+updateOAuthClient' :: (MonadClient m) => OAuthClientId -> OAuthApplicationName -> RedirectUrl -> m ()
+updateOAuthClient' cid name uri = retry x5 . write q $ params LocalQuorum (name, uri, cid)
+  where
+    q :: PrepQuery W (OAuthApplicationName, RedirectUrl, OAuthClientId) ()
+    q = "UPDATE oauth_client SET name = ?, redirect_uri = ? WHERE id = ?"
+
 insertOAuthClient :: (MonadClient m) => OAuthClientId -> OAuthApplicationName -> RedirectUrl -> Password -> m ()
 insertOAuthClient cid name uri pw = retry x5 . write q $ params LocalQuorum (cid, name, uri, pw)
   where

services/brig/test/integration/API/OAuth.hs

@@ -130,7 +130,7 @@ tests m db b n o = do
 
 testRegisterNewOAuthClient :: Brig -> Http ()
 testRegisterNewOAuthClient brig = do
-  let newOAuthClient@(RegisterOAuthClientRequest expectedAppName expectedUrl) = newOAuthClientRequestBody "E Corp" "https://example.com"
+  let newOAuthClient@(OAuthClientConfig expectedAppName expectedUrl) = newOAuthClientRequestBody "E Corp" "https://example.com"
   c <- registerNewOAuthClient brig newOAuthClient
   uid <- randomId
   oauthClientInfo <- getOAuthClientInfo brig uid c.clientId
@@ -140,7 +140,7 @@ testRegisterNewOAuthClient brig = do
 
 testCreateOAuthCodeSuccess :: Brig -> Http ()
 testCreateOAuthCodeSuccess brig = do
-  let newOAuthClient@(RegisterOAuthClientRequest _ redirectUrl) = newOAuthClientRequestBody "E Corp" "https://example.com"
+  let newOAuthClient@(OAuthClientConfig _ redirectUrl) = newOAuthClientRequestBody "E Corp" "https://example.com"
   c <- registerNewOAuthClient brig newOAuthClient
   uid <- randomId
   let scope = OAuthScopes $ Set.fromList [WriteConversations, WriteConversationsCode]
@@ -739,17 +739,17 @@ authHeader = bearer "Authorization"
 bearer :: ToHttpApiData a => HeaderName -> a -> Request -> Request
 bearer name = header name . toHeader . Bearer
 
-newOAuthClientRequestBody :: Text -> Text -> RegisterOAuthClientRequest
+newOAuthClientRequestBody :: Text -> Text -> OAuthClientConfig
 newOAuthClientRequestBody name url =
   let redirectUrl = mkUrl (cs url)
       applicationName = OAuthApplicationName (unsafeRange name)
-   in RegisterOAuthClientRequest applicationName redirectUrl
+   in OAuthClientConfig applicationName redirectUrl
 
-registerNewOAuthClient :: (MonadIO m, MonadHttp m, MonadCatch m, HasCallStack) => Brig -> RegisterOAuthClientRequest -> m OAuthClientCredentials
+registerNewOAuthClient :: (MonadIO m, MonadHttp m, MonadCatch m, HasCallStack) => Brig -> OAuthClientConfig -> m OAuthClientCredentials
 registerNewOAuthClient brig reqBody =
   responseJsonError =<< registerNewOAuthClient' brig reqBody <!! const 200 === statusCode
 
-registerNewOAuthClient' :: (MonadHttp m) => Brig -> RegisterOAuthClientRequest -> m ResponseLBS
+registerNewOAuthClient' :: (MonadHttp m) => Brig -> OAuthClientConfig -> m ResponseLBS
 registerNewOAuthClient' brig reqBody =
   post (brig . paths ["i", "oauth", "clients"] . json reqBody)
 
@@ -800,7 +800,7 @@ generateOAuthClientAndAuthorizationCode = generateOAuthClientAndAuthorizationCod
 
 generateOAuthClientAndAuthorizationCode' :: (MonadIO m, MonadHttp m, MonadCatch m, HasCallStack) => OAuthCodeChallenge -> Brig -> UserId -> OAuthScopes -> RedirectUrl -> m (OAuthClientId, OAuthAuthorizationCode)
 generateOAuthClientAndAuthorizationCode' chal brig uid scope url = do
-  let newOAuthClient = RegisterOAuthClientRequest (OAuthApplicationName (unsafeRange "E Corp")) url
+  let newOAuthClient = OAuthClientConfig (OAuthApplicationName (unsafeRange "E Corp")) url
   OAuthClientCredentials cid _ <- registerNewOAuthClient brig newOAuthClient
   (cid,) <$> generateOAuthAuthorizationCode' chal brig uid cid scope url
 

tools/stern/src/Stern/API.hs

@@ -165,6 +165,10 @@ sitemap' =
     :<|> Named @"post-team-billing-info" setTeamBillingInfo
     :<|> Named @"get-consent-log" getConsentLog
     :<|> Named @"get-user-meta-info" getUserData
+    :<|> Named @"register-oauth-client" Intra.registerOAuthClient
+    :<|> Named @"get-oauth-client" Intra.getOAuthClient
+    :<|> Named @"update-oauth-client" Intra.updateOAuthClient
+    :<|> Named @"delete-oauth-client" Intra.deleteOAuthClient
 
 sitemapInternal :: Servant.Server SternAPIInternal
 sitemapInternal =

tools/stern/src/Stern/API/Routes.hs

@@ -43,6 +43,7 @@ import Servant.Swagger (HasSwagger (toSwagger))
 import Servant.Swagger.Internal.Orphans ()
 import Servant.Swagger.UI
 import Stern.Types
+import Wire.API.OAuth
 import Wire.API.Routes.Internal.Brig.Connection (ConnectionStatus)
 import qualified Wire.API.Routes.Internal.Brig.EJPD as EJPD
 import Wire.API.Routes.Named
@@ -380,6 +381,43 @@ type SternAPI =
                :> QueryParam' [Required, Strict, Description "A valid UserId"] "id" UserId
                :> Post '[JSON] UserMetaInfo
            )
+    :<|> Named
+           "register-oauth-client"
+           ( Summary "Register an OAuth client"
+               :> "i"
+               :> "oauth"
+               :> "clients"
+               :> ReqBody '[JSON] OAuthClientConfig
+               :> Post '[JSON] OAuthClientCredentials
+           )
+    :<|> Named
+           "get-oauth-client"
+           ( Summary "Get OAuth client by id"
+               :> "i"
+               :> "oauth"
+               :> "clients"
+               :> Capture "id" OAuthClientId
+               :> Get '[JSON] OAuthClient
+           )
+    :<|> Named
+           "update-oauth-client"
+           ( Summary "Update OAuth client"
+               :> "i"
+               :> "oauth"
+               :> "clients"
+               :> Capture "id" OAuthClientId
+               :> ReqBody '[JSON] OAuthClientConfig
+               :> Put '[JSON] OAuthClient
+           )
+    :<|> Named
+           "delete-oauth-client"
+           ( Summary "Delete OAuth client"
+               :> "i"
+               :> "oauth"
+               :> "clients"
+               :> Capture "id" OAuthClientId
+               :> Delete '[JSON] ()
+           )
 
 -------------------------------------------------------------------------------
 -- Swagger