WPB-685 give SCIM connections human readable names

cassandra-schema.cql

@@ -1965,6 +1965,7 @@ CREATE TABLE spar_test.team_provisioning_by_team (
     created_at timestamp,
     descr text,
     idp uuid,
+    name text,
     token_ text,
     PRIMARY KEY (team, id)
 ) WITH CLUSTERING ORDER BY (id ASC)
@@ -2049,6 +2050,7 @@ CREATE TABLE spar_test.team_provisioning_by_token (
     descr text,
     id uuid,
     idp uuid,
+    name text,
     team uuid
 ) WITH bloom_filter_fp_chance = 0.1
     AND caching = {'keys': 'ALL', 'rows_per_partition': 'NONE'}

changelog.d/1-api-changes/WPB-685

@@ -0,0 +1 @@
+New variant in API version 7 of endpoints for creating and listing SCIM tokens that support a `name` field. New endpoint in version 7 for updating a SCIM token name.

changelog.d/2-features/WPB-685

@@ -0,0 +1 @@
+Added human readable names for SCIM tokens

integration/test/API/Spar.hs

@@ -18,6 +18,17 @@ createScimToken caller = do
   req <- baseRequest caller Spar Versioned "/scim/auth-tokens"
   submit "POST" $ req & addJSONObject ["password" .= defPassword, "description" .= "integration test"]
 
+-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/post_scim_auth_tokens
+createScimTokenWithName :: (HasCallStack, MakesValue caller) => caller -> String -> App Response
+createScimTokenWithName caller name = do
+  req <- baseRequest caller Spar Versioned "/scim/auth-tokens"
+  submit "POST" $ req & addJSONObject ["password" .= defPassword, "description" .= "integration test", "name" .= name]
+
+putScimTokenName :: (HasCallStack, MakesValue caller) => caller -> String -> String -> App Response
+putScimTokenName caller token name = do
+  req <- baseRequest caller Spar Versioned $ joinHttpPath ["scim", "auth-tokens", token]
+  submit "PUT" $ req & addJSONObject ["name" .= name]
+
 createScimUser :: (HasCallStack, MakesValue domain, MakesValue scimUser) => domain -> String -> scimUser -> App Response
 createScimUser domain token scimUser = do
   req <- baseRequest domain Spar Versioned "/scim/v2/Users"

integration/test/Test/Spar.hs

@@ -311,3 +311,34 @@ checkSparGetUserAndFindByExtId domain tok extId uid k = do
   k userByUid
 
   userByUid `shouldMatch` userByIdExtId
+
+testSparCreateScimTokenNoName :: (HasCallStack) => App ()
+testSparCreateScimTokenNoName = do
+  (owner, _tid, mem : _) <- createTeam OwnDomain 2
+  createScimToken owner >>= assertSuccess
+  createScimToken owner >>= assertSuccess
+  tokens <- bindResponse (getScimTokens owner) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    tokens <- resp.json %. "tokens" >>= asList
+    for_ tokens $ \token -> do
+      token %. "name" `shouldMatch` (token %. "id")
+    pure tokens
+  for_ tokens $ \token -> do
+    tokenId <- token %. "id" >>= asString
+    putScimTokenName mem tokenId "new name" >>= assertStatus 403
+    putScimTokenName owner tokenId ("token:" <> tokenId) >>= assertSuccess
+  bindResponse (getScimTokens owner) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    updatedTokens <- resp.json %. "tokens" >>= asList
+    for_ updatedTokens $ \token -> do
+      tokenId <- token %. "id" >>= asString
+      token %. "name" `shouldMatch` ("token:" <> tokenId)
+
+testSparCreateScimTokenWithName :: (HasCallStack) => App ()
+testSparCreateScimTokenWithName = do
+  (owner, _tid, _) <- createTeam OwnDomain 1
+  let expected = "my scim token"
+  createScimTokenWithName owner expected >>= assertSuccess
+  tokens <- getScimTokens owner >>= getJSON 200 >>= (%. "tokens") >>= asList
+  for_ tokens $ \token -> do
+    token %. "name" `shouldMatch` expected

libs/types-common/src/Data/Id.hs

@@ -53,6 +53,9 @@ module Data.Id
     NoId,
     OAuthClientId,
     OAuthRefreshTokenId,
+
+    -- * Utils
+    uuidSchema,
   )
 where
 
@@ -176,23 +179,23 @@ newtype Id a = Id
   deriving (ToJSON, FromJSON, S.ToSchema) via Schema (Id a)
 
 instance ToSchema (Id a) where
-  schema = Id <$> toUUID .= uuid
-    where
-      uuid :: ValueSchema NamedSwaggerDoc UUID
-      uuid =
-        mkSchema
-          (addExample (swaggerDoc @UUID))
-          ( A.withText
-              "UUID"
-              ( maybe (fail "Invalid UUID") pure
-                  . UUID.fromText
-              )
-          )
-          (pure . A.toJSON . UUID.toText)
-
-      addExample =
-        S.schema . S.example
-          ?~ toJSON ("99db9768-04e3-4b5d-9268-831b6a25c4ab" :: Text)
+  schema = Id <$> toUUID .= uuidSchema
+
+uuidSchema :: ValueSchema NamedSwaggerDoc UUID
+uuidSchema =
+  mkSchema
+    (addExample (swaggerDoc @UUID))
+    ( A.withText
+        "UUID"
+        ( maybe (fail "Invalid UUID") pure
+            . UUID.fromText
+        )
+    )
+    (pure . A.toJSON . UUID.toText)
+  where
+    addExample =
+      S.schema . S.example
+        ?~ toJSON ("99db9768-04e3-4b5d-9268-831b6a25c4ab" :: Text)
 
 -- REFACTOR: non-derived, custom show instances break pretty-show and violate the law
 -- that @show . read == id@.  can we derive Show here?

libs/wire-api/src/Wire/API/Routes/Public/Spar.hs

@@ -25,7 +25,6 @@ import SAML2.WebSSO qualified as SAML
 import Servant
 import Servant.API.Extended
 import Servant.Multipart
-import Servant.OpenApi
 import URI.ByteString qualified as URI
 import Web.Scim.Capabilities.MetaSchema as Scim.Meta
 import Web.Scim.Class.Auth as Scim.Auth
@@ -37,6 +36,8 @@ import Wire.API.Routes.API
 import Wire.API.Routes.Internal.Spar
 import Wire.API.Routes.Named
 import Wire.API.Routes.Public
+import Wire.API.Routes.Version
+import Wire.API.Routes.Versioned
 import Wire.API.SwaggerServant
 import Wire.API.User.IdentityProvider
 import Wire.API.User.Saml
@@ -188,9 +189,21 @@ data ScimSite tag route = ScimSite
   deriving (Generic)
 
 type APIScimToken =
-  Named "auth-tokens-create" (ZOptUser :> APIScimTokenCreate)
+  Named "auth-tokens-create@v6" (Until 'V7 :> ZOptUser :> APIScimTokenCreateV6)
+    :<|> Named "auth-tokens-create" (From 'V7 :> ZOptUser :> APIScimTokenCreate)
+    :<|> Named "auth-tokens-put-name" (From 'V7 :> ZUser :> APIScimTokenPutName)
     :<|> Named "auth-tokens-delete" (ZOptUser :> APIScimTokenDelete)
-    :<|> Named "auth-tokens-list" (ZOptUser :> APIScimTokenList)
+    :<|> Named "auth-tokens-list@v6" (Until 'V7 :> ZOptUser :> APIScimTokenListV6)
+    :<|> Named "auth-tokens-list" (From 'V7 :> ZOptUser :> APIScimTokenList)
+
+type APIScimTokenPutName =
+  Capture "id" ScimTokenId
+    :> ReqBody '[JSON] ScimTokenName
+    :> Put '[JSON] ()
+
+type APIScimTokenCreateV6 =
+  VersionedReqBody 'V6 '[JSON] CreateScimToken
+    :> Post '[JSON] CreateScimTokenResponseV6
 
 type APIScimTokenCreate =
   ReqBody '[JSON] CreateScimToken
@@ -203,9 +216,10 @@ type APIScimTokenDelete =
 type APIScimTokenList =
   Get '[JSON] ScimTokenList
 
+type APIScimTokenListV6 =
+  Get '[JSON] ScimTokenListV6
+
 data SparAPITag
 
 instance ServiceAPI SparAPITag v where
   type ServiceAPIRoutes SparAPITag = SparAPI
-  type SpecialisedAPIRoutes v SparAPITag = SparAPI
-  serviceSwagger = toOpenApi (Proxy @SparAPI)

libs/wire-api/src/Wire/API/Routes/Version.hs

@@ -68,7 +68,9 @@ import Data.Text.Encoding as Text
 import GHC.TypeLits
 import Imports hiding ((\\))
 import Servant
+import Servant.API.Extended (ReqBodyCustomError)
 import Servant.API.Extended.RawM qualified as RawM
+import Servant.Multipart (MultipartForm)
 import Wire.API.Deprecated
 import Wire.API.Routes.MultiVerb
 import Wire.API.Routes.Named hiding (unnamed)
@@ -293,12 +295,24 @@ type instance
   SpecialiseToVersion v (MultiVerb m t r x) =
     MultiVerb m t r x
 
+type instance
+  SpecialiseToVersion v (NoContentVerb m) =
+    NoContentVerb m
+
 type instance SpecialiseToVersion v RawM.RawM = RawM.RawM
 
 type instance
   SpecialiseToVersion v (ReqBody t x :> api) =
     ReqBody t x :> SpecialiseToVersion v api
 
+type instance
+  SpecialiseToVersion v (ReqBodyCustomError t l x :> api) =
+    ReqBodyCustomError t l x :> SpecialiseToVersion v api
+
+type instance
+  SpecialiseToVersion v (MultipartForm x b :> api) =
+    MultipartForm x b :> SpecialiseToVersion v api
+
 type instance
   SpecialiseToVersion v (QueryParam' mods l x :> api) =
     QueryParam' mods l x :> SpecialiseToVersion v api

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

@@ -23,9 +23,8 @@ where
 
 import Data.Metrics.Servant
 import Data.Proxy
-import Imports hiding (head)
 import Servant
-import Servant.OpenApi (HasOpenApi (toOpenApi))
+import Wire.API.Routes.Version
 
 -- | A type-level tag that lets us omit any branch from Swagger docs.
 --
@@ -34,9 +33,6 @@ import Servant.OpenApi (HasOpenApi (toOpenApi))
 -- it's only justification is laziness.
 data OmitDocs
 
-instance HasOpenApi (OmitDocs :> a) where
-  toOpenApi _ = mempty
-
 instance (HasServer api ctx) => HasServer (OmitDocs :> api) ctx where
   type ServerT (OmitDocs :> api) m = ServerT api m
 
@@ -46,3 +42,7 @@ instance (HasServer api ctx) => HasServer (OmitDocs :> api) ctx where
 
 instance (RoutesToPaths api) => RoutesToPaths (OmitDocs :> api) where
   getRoutes = getRoutes @api
+
+type instance
+  SpecialiseToVersion v (OmitDocs :> api) =
+    EmptyAPI