diff --git a/cassandra-schema.cql b/cassandra-schema.cql index b0fb20beb67..28fad0acf4a 100644 --- a/cassandra-schema.cql +++ b/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'} diff --git a/changelog.d/1-api-changes/WPB-685 b/changelog.d/1-api-changes/WPB-685 new file mode 100644 index 00000000000..1dbe090ee80 --- /dev/null +++ b/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. diff --git a/changelog.d/2-features/WPB-685 b/changelog.d/2-features/WPB-685 new file mode 100644 index 00000000000..f7e640abc8c --- /dev/null +++ b/changelog.d/2-features/WPB-685 @@ -0,0 +1 @@ +Added human readable names for SCIM tokens diff --git a/integration/test/API/Spar.hs b/integration/test/API/Spar.hs index ee57ef581aa..c925c7cc5d7 100644 --- a/integration/test/API/Spar.hs +++ b/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" diff --git a/integration/test/Test/Spar.hs b/integration/test/Test/Spar.hs index 7c9d2b8bd77..c18a517d2ea 100644 --- a/integration/test/Test/Spar.hs +++ b/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 diff --git a/libs/types-common/src/Data/Id.hs b/libs/types-common/src/Data/Id.hs index 0a1dbe22ad3..9ae33bcc7df 100644 --- a/libs/types-common/src/Data/Id.hs +++ b/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? diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Spar.hs b/libs/wire-api/src/Wire/API/Routes/Public/Spar.hs index bf87bfb3fef..787da9d22a2 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Spar.hs +++ b/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) diff --git a/libs/wire-api/src/Wire/API/Routes/Version.hs b/libs/wire-api/src/Wire/API/Routes/Version.hs index ec1673aee49..13ec55c42ea 100644 --- a/libs/wire-api/src/Wire/API/Routes/Version.hs +++ b/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 diff --git a/libs/wire-api/src/Wire/API/SwaggerServant.hs b/libs/wire-api/src/Wire/API/SwaggerServant.hs index 8ea0729a504..f5ad2081593 100644 --- a/libs/wire-api/src/Wire/API/SwaggerServant.hs +++ b/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 diff --git a/libs/wire-api/src/Wire/API/User/Scim.hs b/libs/wire-api/src/Wire/API/User/Scim.hs index dd7f4ad8993..07c07c3beea 100644 --- a/libs/wire-api/src/Wire/API/User/Scim.hs +++ b/libs/wire-api/src/Wire/API/User/Scim.hs @@ -42,7 +42,7 @@ -- * Request and response types for SCIM-related endpoints. module Wire.API.User.Scim where -import Control.Lens (makeLenses, mapped, to, (.~), (?~), (^.)) +import Control.Lens (makeLenses, to, (.~), (^.)) import Control.Monad.Except (throwError) import Crypto.Hash (hash) import Crypto.Hash.Algorithms (SHA512) @@ -55,13 +55,14 @@ import Data.ByteString.Conversion (FromByteString (..), ToByteString (..)) import Data.CaseInsensitive qualified as CI import Data.Code as Code import Data.Handle (Handle) -import Data.Id (ScimTokenId, TeamId, UserId) -import Data.Json.Util ((#)) +import Data.Id +import Data.Json.Util import Data.Map qualified as Map import Data.Misc (PlainTextPassword6) -import Data.OpenApi hiding (Operation) -import Data.Proxy +import Data.OpenApi qualified as S +import Data.Schema as Schema import Data.Text qualified as T +import Data.Text qualified as Text import Data.Text.Encoding (decodeUtf8, encodeUtf8) import Data.These import Data.These.Combinators @@ -87,6 +88,8 @@ import Web.Scim.Schema.Schema qualified as Scim import Web.Scim.Schema.User qualified as Scim import Web.Scim.Schema.User qualified as Scim.User import Wire.API.Locale +import Wire.API.Routes.Version +import Wire.API.Routes.Versioned import Wire.API.Team.Role (Role) import Wire.API.User.EmailAddress (EmailAddress, fromEmail) import Wire.API.User.Profile as BT @@ -114,7 +117,11 @@ userSchemas = -- -- For SCIM authentication and token handling logic, see "Spar.Scim.Auth". newtype ScimToken = ScimToken {fromScimToken :: Text} - deriving (Eq, Ord, Show, FromJSON, ToJSON, FromByteString, ToByteString) + deriving (Eq, Ord, Show, FromByteString, ToByteString, Arbitrary) + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema.Schema ScimToken) + +instance ToSchema ScimToken where + schema = ScimToken <$> fromScimToken .= schema newtype ScimTokenHash = ScimTokenHash {fromScimTokenHash :: Text} deriving (Eq, Show) @@ -147,9 +154,13 @@ data ScimTokenInfo = ScimTokenInfo stiIdP :: !(Maybe SAML.IdPId), -- | Free-form token description, can be set -- by the token creator as a mental aid - stiDescr :: !Text + stiDescr :: !Text, + -- | Name for the token, if not set by the user, the name will be equal to the token ID + stiName :: !Text } - deriving (Eq, Show) + deriving (Eq, Show, Generic) + deriving (Arbitrary) via (GenericUniform ScimTokenInfo) + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema.Schema ScimTokenInfo) instance FromHttpApiData ScimToken where parseHeader h = ScimToken <$> parseHeaderWithPrefix "Bearer " h @@ -159,29 +170,44 @@ instance ToHttpApiData ScimToken where toHeader (ScimToken s) = "Bearer " <> encodeUtf8 s toQueryParam (ScimToken s) = toQueryParam s -instance FromJSON ScimTokenInfo where - parseJSON = A.withObject "ScimTokenInfo" $ \o -> do - stiTeam <- o A..: "team" - stiId <- o A..: "id" - stiCreatedAt <- o A..: "created_at" - stiIdP <- o A..:? "idp" - stiDescr <- o A..: "description" - pure ScimTokenInfo {..} - -instance ToJSON ScimTokenInfo where - toJSON s = - A.object $ - "team" - A..= stiTeam s - # "id" - A..= stiId s - # "created_at" - A..= stiCreatedAt s - # "idp" - A..= stiIdP s - # "description" - A..= stiDescr s - # [] +instance ToSchema ScimTokenInfo where + schema = + object "ScimTokenInfo" $ + ScimTokenInfo + <$> (.stiTeam) .= field "team" schema + <*> (.stiId) .= field "id" schema + <*> (.stiCreatedAt) .= field "created_at" utcTimeSchema + <*> (fmap SAML.fromIdPId . (.stiIdP)) .= (SAML.IdPId <$$> maybe_ (optField "idp" uuidSchema)) + <*> (.stiDescr) .= field "description" schema + <*> (.stiName) .= field "name" schema + +-- | Metadata that we store about each token. +data ScimTokenInfoV6 = ScimTokenInfoV6 + { -- | Which team can be managed with the token + stiTeam :: !TeamId, + -- | Token ID, can be used to eg. delete the token + stiId :: !ScimTokenId, + -- | Time of token creation + stiCreatedAt :: !UTCTime, + -- | IdP that created users will "belong" to + stiIdP :: !(Maybe SAML.IdPId), + -- | Free-form token description, can be set + -- by the token creator as a mental aid + stiDescr :: !Text + } + deriving (Eq, Show, Generic) + deriving (Arbitrary) via (GenericUniform ScimTokenInfoV6) + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema.Schema ScimTokenInfoV6) + +instance ToSchema ScimTokenInfoV6 where + schema = + object "ScimTokenInfoV6" $ + ScimTokenInfoV6 + <$> (.stiTeam) .= field "team" schema + <*> (.stiId) .= field "id" schema + <*> (.stiCreatedAt) .= field "created_at" utcTimeSchema + <*> (fmap SAML.fromIdPId . (.stiIdP)) .= (SAML.IdPId <$$> maybe_ (optField "idp" uuidSchema)) + <*> (.stiDescr) .= field "description" schema ---------------------------------------------------------------------------- -- @hscim@ extensions and wrappers @@ -392,51 +418,63 @@ makeLenses ''ValidScimId -- | Type used for request parameters to 'APIScimTokenCreate'. data CreateScimToken = CreateScimToken { -- | Token description (as memory aid for whoever is creating the token) - createScimTokenDescr :: !Text, + description :: !Text, -- | User password, which we ask for because creating a token is a "powerful" operation - createScimTokenPassword :: !(Maybe PlainTextPassword6), - -- | User code (sent by email), for 2nd factor to 'createScimTokenPassword' - createScimTokenCode :: !(Maybe Code.Value) + password :: !(Maybe PlainTextPassword6), + -- | User code (sent by email), for 2nd factor to 'password' + verificationCode :: !(Maybe Code.Value), + -- | Optional name for the token + name :: Maybe Text } deriving (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform CreateScimToken) + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema.Schema CreateScimToken) -instance A.FromJSON CreateScimToken where - parseJSON = A.withObject "CreateScimToken" $ \o -> do - createScimTokenDescr <- o A..: "description" - createScimTokenPassword <- o A..:? "password" - createScimTokenCode <- o A..:? "verification_code" - pure CreateScimToken {..} - --- Used for integration tests -instance A.ToJSON CreateScimToken where - toJSON CreateScimToken {..} = - A.object - [ "description" A..= createScimTokenDescr, - "password" A..= createScimTokenPassword, - "verification_code" A..= createScimTokenCode - ] +createScimTokenSchema :: Maybe Version -> ValueSchema NamedSwaggerDoc CreateScimToken +createScimTokenSchema v = + object ("CreateScimToken" <> foldMap (Text.toUpper . versionText) v) $ + CreateScimToken + <$> (.description) .= field "description" schema + <*> password .= optField "password" (maybeWithDefault A.Null schema) + <*> verificationCode .= optField "verification_code" (maybeWithDefault A.Null schema) + <*> (if isJust v then const Nothing else (.name)) .= maybe_ (optField "name" schema) + +instance ToSchema CreateScimToken where + schema = createScimTokenSchema Nothing + +instance ToSchema (Versioned 'V6 CreateScimToken) where + schema = Versioned <$> unVersioned .= createScimTokenSchema (Just V6) -- | Type used for the response of 'APIScimTokenCreate'. data CreateScimTokenResponse = CreateScimTokenResponse - { createScimTokenResponseToken :: ScimToken, - createScimTokenResponseInfo :: ScimTokenInfo + { token :: ScimToken, + info :: ScimTokenInfo } - deriving (Eq, Show) + deriving (Eq, Show, Generic) + deriving (Arbitrary) via (GenericUniform CreateScimTokenResponse) + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema.Schema CreateScimTokenResponse) --- Used for integration tests -instance A.FromJSON CreateScimTokenResponse where - parseJSON = A.withObject "CreateScimTokenResponse" $ \o -> do - createScimTokenResponseToken <- o A..: "token" - createScimTokenResponseInfo <- o A..: "info" - pure CreateScimTokenResponse {..} +instance ToSchema CreateScimTokenResponse where + schema = + object "CreateScimTokenResponse" $ + CreateScimTokenResponse + <$> (.token) .= field "token" schema + <*> (.info) .= field "info" schema + +data CreateScimTokenResponseV6 = CreateScimTokenResponseV6 + { token :: ScimToken, + info :: ScimTokenInfoV6 + } + deriving (Eq, Show, Generic) + deriving (Arbitrary) via (GenericUniform CreateScimTokenResponseV6) + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema.Schema CreateScimTokenResponseV6) -instance A.ToJSON CreateScimTokenResponse where - toJSON CreateScimTokenResponse {..} = - A.object - [ "token" A..= createScimTokenResponseToken, - "info" A..= createScimTokenResponseInfo - ] +instance ToSchema CreateScimTokenResponseV6 where + schema = + object "CreateScimTokenResponseV6" $ + CreateScimTokenResponseV6 + <$> (.token) .= field "token" schema + <*> (.info) .= field "info" schema -- | Type used for responses of endpoints that return a list of SCIM tokens. -- Wrapped into an object to allow extensibility later on. @@ -446,84 +484,23 @@ data ScimTokenList = ScimTokenList { scimTokenListTokens :: [ScimTokenInfo] } deriving (Eq, Show) + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema.Schema ScimTokenList) -instance A.FromJSON ScimTokenList where - parseJSON = A.withObject "ScimTokenList" $ \o -> do - scimTokenListTokens <- o A..: "tokens" - pure ScimTokenList {..} - -instance A.ToJSON ScimTokenList where - toJSON ScimTokenList {..} = - A.object - [ "tokens" A..= scimTokenListTokens - ] - --- Swagger - -instance ToParamSchema ScimToken where - toParamSchema _ = toParamSchema (Proxy @Text) - -instance ToSchema ScimToken where - declareNamedSchema _ = - declareNamedSchema (Proxy @Text) - & mapped . schema . description ?~ "Authentication token" +instance ToSchema ScimTokenList where + schema = object "ScimTokenList" $ ScimTokenList <$> (.scimTokenListTokens) .= field "tokens" (array schema) -instance ToSchema ScimTokenInfo where - declareNamedSchema _ = do - teamSchema <- declareSchemaRef (Proxy @TeamId) - idSchema <- declareSchemaRef (Proxy @ScimTokenId) - createdAtSchema <- declareSchemaRef (Proxy @UTCTime) - idpSchema <- declareSchemaRef (Proxy @SAML.IdPId) - descrSchema <- declareSchemaRef (Proxy @Text) - pure $ - NamedSchema (Just "ScimTokenInfo") $ - mempty - & type_ ?~ OpenApiObject - & properties - .~ [ ("team", teamSchema), - ("id", idSchema), - ("created_at", createdAtSchema), - ("idp", idpSchema), - ("description", descrSchema) - ] - & required .~ ["team", "id", "created_at", "description"] +data ScimTokenListV6 = ScimTokenListV6 + { scimTokenListTokens :: [ScimTokenInfoV6] + } + deriving (Eq, Show) + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema.Schema ScimTokenListV6) -instance ToSchema CreateScimToken where - declareNamedSchema _ = do - textSchema <- declareSchemaRef (Proxy @Text) - pure $ - NamedSchema (Just "CreateScimToken") $ - mempty - & type_ ?~ OpenApiObject - & properties - .~ [ ("description", textSchema), - ("password", textSchema), - ("verification_code", textSchema) - ] - & required .~ ["description"] +instance ToSchema ScimTokenListV6 where + schema = object "ScimTokenListV6" $ ScimTokenListV6 <$> (.scimTokenListTokens) .= field "tokens" (array schema) -instance ToSchema CreateScimTokenResponse where - declareNamedSchema _ = do - tokenSchema <- declareSchemaRef (Proxy @ScimToken) - infoSchema <- declareSchemaRef (Proxy @ScimTokenInfo) - pure $ - NamedSchema (Just "CreateScimTokenResponse") $ - mempty - & type_ ?~ OpenApiObject - & properties - .~ [ ("token", tokenSchema), - ("info", infoSchema) - ] - & required .~ ["token", "info"] +newtype ScimTokenName = ScimTokenName {fromScimTokenName :: Text} + deriving (Eq, Show) + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema.Schema ScimTokenName) -instance ToSchema ScimTokenList where - declareNamedSchema _ = do - infoListSchema <- declareSchemaRef (Proxy @[ScimTokenInfo]) - pure $ - NamedSchema (Just "ScimTokenList") $ - mempty - & type_ ?~ OpenApiObject - & properties - .~ [ ("tokens", infoListSchema) - ] - & required .~ ["tokens"] +instance ToSchema ScimTokenName where + schema = object "ScimTokenName" $ ScimTokenName <$> fromScimTokenName .= field "name" schema diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual.hs index e57d209f02d..3a898d764ce 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual.hs @@ -32,6 +32,7 @@ import Test.Wire.API.Golden.Manual.ConversationRemoveMembers import Test.Wire.API.Golden.Manual.ConversationsResponse import Test.Wire.API.Golden.Manual.CreateGroupConversation import Test.Wire.API.Golden.Manual.CreateScimToken +import Test.Wire.API.Golden.Manual.CreateScimTokenResponse import Test.Wire.API.Golden.Manual.FeatureConfigEvent import Test.Wire.API.Golden.Manual.FederationDomainConfig import Test.Wire.API.Golden.Manual.FederationRestriction @@ -153,6 +154,10 @@ tests = (testObject_CreateScimToken_3, "testObject_CreateScimToken_3.json"), (testObject_CreateScimToken_4, "testObject_CreateScimToken_4.json") ], + testGroup "CreateScimTokenResponse" $ + testObjects + [ (testObject_CreateScimTokenResponse_1, "testObject_CreateScimTokenResponse_1.json") + ], testGroup "Contact" $ testObjects [ (testObject_Contact_1, "testObject_Contact_1.json"), diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/CreateScimToken.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/CreateScimToken.hs index 51c9bd8ecad..e2c32ffcf55 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/CreateScimToken.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/CreateScimToken.hs @@ -21,7 +21,7 @@ import Data.Code import Data.Misc (plainTextPassword6Unsafe) import Data.Range (unsafeRange) import Data.Text.Ascii (AsciiChars (validate)) -import Imports (Maybe (Just, Nothing), fromRight, undefined) +import Imports import Wire.API.User.Scim (CreateScimToken (..)) testObject_CreateScimToken_1 :: CreateScimToken @@ -30,6 +30,7 @@ testObject_CreateScimToken_1 = "description" (Just (plainTextPassword6Unsafe "very-geheim")) (Just (Value {asciiValue = unsafeRange (fromRight undefined (validate "123456"))})) + Nothing testObject_CreateScimToken_2 :: CreateScimToken testObject_CreateScimToken_2 = @@ -37,6 +38,7 @@ testObject_CreateScimToken_2 = "description2" (Just (plainTextPassword6Unsafe "secret")) Nothing + Nothing testObject_CreateScimToken_3 :: CreateScimToken testObject_CreateScimToken_3 = @@ -44,6 +46,7 @@ testObject_CreateScimToken_3 = "description3" Nothing (Just (Value {asciiValue = unsafeRange (fromRight undefined (validate "654321"))})) + Nothing testObject_CreateScimToken_4 :: CreateScimToken testObject_CreateScimToken_4 = @@ -51,3 +54,4 @@ testObject_CreateScimToken_4 = "description4" Nothing Nothing + (Just "scim connection name") diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/CreateScimTokenResponse.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/CreateScimTokenResponse.hs new file mode 100644 index 00000000000..799a9fb775b --- /dev/null +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/CreateScimTokenResponse.hs @@ -0,0 +1,38 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2022 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . + +module Test.Wire.API.Golden.Manual.CreateScimTokenResponse where + +import Data.Id (Id (Id)) +import Data.Time (Day (ModifiedJulianDay)) +import Data.Time.Clock (UTCTime (UTCTime, utctDay, utctDayTime)) +import Data.UUID qualified as UUID +import Imports +import Wire.API.User.Scim + +testObject_CreateScimTokenResponse_1 :: CreateScimTokenResponse +testObject_CreateScimTokenResponse_1 = + CreateScimTokenResponse + (ScimToken "token") + ( ScimTokenInfo + (Id (fromJust (UUID.fromString "2853751e-9fb6-4425-b1bd-bd8aa2640c69"))) + (Id (fromJust (UUID.fromString "e25faea1-ee2d-4fd8-bf25-e6748d392b23"))) + (UTCTime {utctDay = ModifiedJulianDay 60605, utctDayTime = 65090}) + Nothing + "description" + "token name" + ) diff --git a/libs/wire-api/test/golden/testObject_CreateScimTokenResponse_1.json b/libs/wire-api/test/golden/testObject_CreateScimTokenResponse_1.json new file mode 100644 index 00000000000..3896abc8201 --- /dev/null +++ b/libs/wire-api/test/golden/testObject_CreateScimTokenResponse_1.json @@ -0,0 +1,10 @@ +{ + "info": { + "created_at": "2024-10-22T18:04:50Z", + "description": "description", + "id": "e25faea1-ee2d-4fd8-bf25-e6748d392b23", + "team": "2853751e-9fb6-4425-b1bd-bd8aa2640c69", + "name": "token name" + }, + "token": "token" +} diff --git a/libs/wire-api/test/golden/testObject_CreateScimToken_4.json b/libs/wire-api/test/golden/testObject_CreateScimToken_4.json index a79a8f35565..cd71c759b31 100644 --- a/libs/wire-api/test/golden/testObject_CreateScimToken_4.json +++ b/libs/wire-api/test/golden/testObject_CreateScimToken_4.json @@ -1,5 +1,6 @@ { "description": "description4", "password": null, - "verification_code": null + "verification_code": null, + "name": "scim connection name" } diff --git a/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/Aeson.hs b/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/Aeson.hs index 65be7b6ef80..ee312a10edf 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/Aeson.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/Aeson.hs @@ -203,6 +203,7 @@ tests = testRoundTrip @Push.Token.PushToken, testRoundTrip @Push.Token.PushTokenList, testRoundTrip @Scim.CreateScimToken, + testRoundTrip @Scim.CreateScimTokenResponse, testRoundTrip @SystemSettings.SystemSettings, testRoundTrip @SystemSettings.SystemSettingsPublic, testRoundTrip @SystemSettings.SystemSettingsInternal, diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal index f5eac2bf6d2..d7835a6419b 100644 --- a/libs/wire-api/wire-api.cabal +++ b/libs/wire-api/wire-api.cabal @@ -588,6 +588,7 @@ test-suite wire-api-golden-tests Test.Wire.API.Golden.Manual.ConvIdsPage Test.Wire.API.Golden.Manual.CreateGroupConversation Test.Wire.API.Golden.Manual.CreateScimToken + Test.Wire.API.Golden.Manual.CreateScimTokenResponse Test.Wire.API.Golden.Manual.FeatureConfigEvent Test.Wire.API.Golden.Manual.FederationDomainConfig Test.Wire.API.Golden.Manual.FederationRestriction diff --git a/services/brig/test/integration/API/UserPendingActivation.hs b/services/brig/test/integration/API/UserPendingActivation.hs index c5a95445519..b82eb251957 100644 --- a/services/brig/test/integration/API/UserPendingActivation.hs +++ b/services/brig/test/integration/API/UserPendingActivation.hs @@ -104,9 +104,10 @@ createScimToken spar' owner = do CreateScimTokenResponse tok _ <- createToken spar' owner $ CreateScimToken - { createScimTokenDescr = "testCreateToken", - createScimTokenPassword = Just defPassword, - createScimTokenCode = Nothing + { description = "testCreateToken", + password = Just defPassword, + verificationCode = Nothing, + name = Nothing } pure tok diff --git a/services/spar/default.nix b/services/spar/default.nix index 8e5b8b51e4f..e6424e6e32b 100644 --- a/services/spar/default.nix +++ b/services/spar/default.nix @@ -174,6 +174,7 @@ mkDerivation { lens-aeson MonadRandom mtl + network-uri optparse-applicative polysemy polysemy-plugin diff --git a/services/spar/spar.cabal b/services/spar/spar.cabal index 2435d71165b..a9b452682e4 100644 --- a/services/spar/spar.cabal +++ b/services/spar/spar.cabal @@ -40,6 +40,7 @@ library Spar.Schema.V16 Spar.Schema.V17 Spar.Schema.V18 + Spar.Schema.V19 Spar.Schema.V2 Spar.Schema.V3 Spar.Schema.V4 @@ -368,6 +369,7 @@ executable spar-integration , lens-aeson , MonadRandom , mtl + , network-uri , optparse-applicative , polysemy , polysemy-plugin diff --git a/services/spar/src/Spar/Schema/Run.hs b/services/spar/src/Spar/Schema/Run.hs index ac273fb83c4..e3f35f9ba2e 100644 --- a/services/spar/src/Spar/Schema/Run.hs +++ b/services/spar/src/Spar/Schema/Run.hs @@ -32,6 +32,7 @@ import qualified Spar.Schema.V15 as V15 import qualified Spar.Schema.V16 as V16 import qualified Spar.Schema.V17 as V17 import qualified Spar.Schema.V18 as V18 +import qualified Spar.Schema.V19 as V19 import qualified Spar.Schema.V2 as V2 import qualified Spar.Schema.V3 as V3 import qualified Spar.Schema.V4 as V4 @@ -78,7 +79,8 @@ migrations = V15.migration, V16.migration, V17.migration, - V18.migration + V18.migration, + V19.migration -- TODO: Add a migration that removes unused fields -- (we don't want to risk running a migration which would -- effectively break the currently deployed spar service) diff --git a/services/spar/src/Spar/Schema/V19.hs b/services/spar/src/Spar/Schema/V19.hs new file mode 100644 index 00000000000..6c55b7950c1 --- /dev/null +++ b/services/spar/src/Spar/Schema/V19.hs @@ -0,0 +1,36 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2022 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . + +module Spar.Schema.V19 + ( migration, + ) +where + +import Cassandra.Schema +import Imports +import Text.RawString.QQ + +migration :: Migration +migration = Migration 19 "Add name column to scim token info" $ do + schema' + [r| + ALTER TABLE team_provisioning_by_team ADD (name text); + |] + schema' + [r| + ALTER TABLE team_provisioning_by_token ADD (name text); + |] diff --git a/services/spar/src/Spar/Scim/Auth.hs b/services/spar/src/Spar/Scim/Auth.hs index 45d34e667af..5bad5826054 100644 --- a/services/spar/src/Spar/Scim/Auth.hs +++ b/services/spar/src/Spar/Scim/Auth.hs @@ -37,7 +37,7 @@ where import Control.Lens hiding (Strict, (.=)) import qualified Data.ByteString.Base64 as ES -import Data.Id (ScimTokenId, UserId) +import Data.Id import qualified Data.Text.Encoding as T import Data.Text.Encoding.Error import Imports @@ -98,10 +98,54 @@ apiScimToken :: ) => ServerT APIScimToken (Sem r) apiScimToken = - Named @"auth-tokens-create" createScimToken + Named @"auth-tokens-create@v6" createScimTokenV6 + :<|> Named @"auth-tokens-create" createScimToken + :<|> Named @"auth-tokens-put-name" updateScimTokenName :<|> Named @"auth-tokens-delete" deleteScimToken + :<|> Named @"auth-tokens-list@v6" listScimTokensV6 :<|> Named @"auth-tokens-list" listScimTokens +updateScimTokenName :: + ( Member BrigAccess r, + Member ScimTokenStore r, + Member (Error E.SparError) r, + Member GalleyAccess r + ) => + UserId -> + ScimTokenId -> + ScimTokenName -> + Sem r () +updateScimTokenName lusr tokenId name = do + teamid <- Intra.Brig.authorizeScimTokenManagement (Just lusr) + ScimTokenStore.updateName teamid tokenId name.fromScimTokenName + +-- | > docs/reference/provisioning/scim-token.md {#RefScimTokenCreate} +-- +-- Create a token for user's team. +createScimTokenV6 :: + forall r. + ( Member Random r, + Member (Input Opts) r, + Member GalleyAccess r, + Member BrigAccess r, + Member ScimTokenStore r, + Member IdPConfigStore r, + Member Now r, + Member (Error E.SparError) r + ) => + -- | Who is trying to create a token + Maybe UserId -> + -- | Request body + CreateScimToken -> + Sem r CreateScimTokenResponseV6 +createScimTokenV6 zusr req = responseToV6 <$> createScimToken zusr req + where + responseToV6 :: CreateScimTokenResponse -> CreateScimTokenResponseV6 + responseToV6 (CreateScimTokenResponse token info) = CreateScimTokenResponseV6 token (infoToV6 info) + + infoToV6 :: ScimTokenInfo -> ScimTokenInfoV6 + infoToV6 ScimTokenInfo {..} = ScimTokenInfoV6 {..} + -- | > docs/reference/provisioning/scim-token.md {#RefScimTokenCreate} -- -- Create a token for user's team. @@ -122,9 +166,8 @@ createScimToken :: CreateScimToken -> Sem r CreateScimTokenResponse createScimToken zusr Api.CreateScimToken {..} = do - let descr = createScimTokenDescr teamid <- Intra.Brig.authorizeScimTokenManagement zusr - BrigAccess.ensureReAuthorised zusr createScimTokenPassword createScimTokenCode (Just User.CreateScimToken) + BrigAccess.ensureReAuthorised zusr password verificationCode (Just User.CreateScimToken) tokenNumber <- length <$> ScimTokenStore.lookupByTeam teamid maxTokens <- inputs maxScimTokens unless (tokenNumber < maxTokens) $ @@ -148,7 +191,8 @@ createScimToken zusr Api.CreateScimToken {..} = do stiTeam = teamid, stiCreatedAt = now, stiIdP = midpid, - stiDescr = descr + stiDescr = description, + stiName = fromMaybe (idToText tokenid) name } ScimTokenStore.insert token info pure $ CreateScimTokenResponse token info @@ -179,6 +223,23 @@ deleteScimToken zusr tokenid = do ScimTokenStore.delete teamid tokenid pure NoContent +listScimTokensV6 :: + ( Member GalleyAccess r, + Member BrigAccess r, + Member ScimTokenStore r, + Member (Error E.SparError) r + ) => + -- | Who is trying to list tokens + Maybe UserId -> + Sem r ScimTokenListV6 +listScimTokensV6 zusr = toV6 <$> listScimTokens zusr + where + toV6 :: ScimTokenList -> ScimTokenListV6 + toV6 (ScimTokenList tokens) = ScimTokenListV6 $ map infoToV6 tokens + + infoToV6 :: ScimTokenInfo -> ScimTokenInfoV6 + infoToV6 ScimTokenInfo {..} = ScimTokenInfoV6 {..} + -- | > docs/reference/provisioning/scim-token.md {#RefScimTokenList} -- -- List all tokens belonging to user's team. Tokens themselves are not available, only diff --git a/services/spar/src/Spar/Sem/ScimTokenStore.hs b/services/spar/src/Spar/Sem/ScimTokenStore.hs index eb4ec41735d..03014de6974 100644 --- a/services/spar/src/Spar/Sem/ScimTokenStore.hs +++ b/services/spar/src/Spar/Sem/ScimTokenStore.hs @@ -22,13 +22,14 @@ module Spar.Sem.ScimTokenStore insert, lookup, lookupByTeam, + updateName, delete, deleteByTeam, ) where import Data.Id -import Imports (Maybe) +import Imports hiding (lookup) import Polysemy import Wire.API.User.Scim @@ -36,6 +37,7 @@ data ScimTokenStore m a where Insert :: ScimToken -> ScimTokenInfo -> ScimTokenStore m () Lookup :: ScimToken -> ScimTokenStore m (Maybe ScimTokenInfo) LookupByTeam :: TeamId -> ScimTokenStore m [ScimTokenInfo] + UpdateName :: TeamId -> ScimTokenId -> Text -> ScimTokenStore m () Delete :: TeamId -> ScimTokenId -> ScimTokenStore m () DeleteByTeam :: TeamId -> ScimTokenStore m () diff --git a/services/spar/src/Spar/Sem/ScimTokenStore/Cassandra.hs b/services/spar/src/Spar/Sem/ScimTokenStore/Cassandra.hs index 6f56b34e77c..70dc4e223d0 100644 --- a/services/spar/src/Spar/Sem/ScimTokenStore/Cassandra.hs +++ b/services/spar/src/Spar/Sem/ScimTokenStore/Cassandra.hs @@ -48,8 +48,9 @@ scimTokenStoreToCassandra = Insert st sti -> insertScimToken st sti Lookup st -> lookupScimToken st LookupByTeam tid -> getScimTokens tid - Delete tid ur -> deleteScimToken tid ur - DeleteByTeam tid -> deleteTeamScimTokens tid + UpdateName team token name -> updateScimTokenName team token name + Delete team token -> deleteScimToken team token + DeleteByTeam team -> deleteTeamScimTokens team ---------------------------------------------------------------------- -- SCIM auth @@ -67,25 +68,25 @@ insertScimToken token ScimTokenInfo {..} = retry x5 . batch $ do setType BatchLogged setConsistency LocalQuorum let tokenHash = hashScimToken token - addPrepQuery insByToken (ScimTokenLookupKeyHashed tokenHash, stiTeam, stiId, stiCreatedAt, stiIdP, stiDescr) - addPrepQuery insByTeam (ScimTokenLookupKeyHashed tokenHash, stiTeam, stiId, stiCreatedAt, stiIdP, stiDescr) + addPrepQuery insByToken (ScimTokenLookupKeyHashed tokenHash, stiTeam, stiId, stiCreatedAt, stiIdP, stiDescr, Just stiName) + addPrepQuery insByTeam (ScimTokenLookupKeyHashed tokenHash, stiTeam, stiId, stiCreatedAt, stiIdP, stiDescr, Just stiName) insByToken, insByTeam :: PrepQuery W ScimTokenRow () insByToken = [r| INSERT INTO team_provisioning_by_token - (token_, team, id, created_at, idp, descr) - VALUES (?, ?, ?, ?, ?, ?) + (token_, team, id, created_at, idp, descr, name) + VALUES (?, ?, ?, ?, ?, ?, ?) |] insByTeam = [r| INSERT INTO team_provisioning_by_team - (token_, team, id, created_at, idp, descr) - VALUES (?, ?, ?, ?, ?, ?) + (token_, team, id, created_at, idp, descr, name) + VALUES (?, ?, ?, ?, ?, ?, ?) |] scimTokenLookupKey :: ScimTokenRow -> ScimTokenLookupKey -scimTokenLookupKey (key, _, _, _, _, _) = key +scimTokenLookupKey (key, _, _, _, _, _, _) = key -- | Check whether a token exists and if yes, what team and IdP are -- associated with it. @@ -110,7 +111,7 @@ lookupScimToken token = do sel :: PrepQuery R (ScimTokenHash, ScimToken) ScimTokenRow sel = [r| - SELECT token_, team, id, created_at, idp, descr + SELECT token_, team, id, created_at, idp, descr, name FROM team_provisioning_by_token WHERE token_ in (?, ?) |] @@ -130,9 +131,9 @@ connvertPlaintextToken token ScimTokenInfo {..} = retry x5 . batch $ do setConsistency LocalQuorum let tokenHash = hashScimToken token -- enter by new lookup key - addPrepQuery insByToken (ScimTokenLookupKeyHashed tokenHash, stiTeam, stiId, stiCreatedAt, stiIdP, stiDescr) + addPrepQuery insByToken (ScimTokenLookupKeyHashed tokenHash, stiTeam, stiId, stiCreatedAt, stiIdP, stiDescr, Just stiName) -- update info table - addPrepQuery insByTeam (ScimTokenLookupKeyHashed tokenHash, stiTeam, stiId, stiCreatedAt, stiIdP, stiDescr) + addPrepQuery insByTeam (ScimTokenLookupKeyHashed tokenHash, stiTeam, stiId, stiCreatedAt, stiIdP, stiDescr, Just stiName) -- remove old lookup key addPrepQuery delByTokenLookup (Identity (ScimTokenLookupKeyPlaintext token)) @@ -145,12 +146,12 @@ getScimTokens team = do -- We don't need pagination here because the limit should be pretty low -- (e.g. 16). If the limit grows, we might have to introduce pagination. rows <- retry x1 . query sel $ params LocalQuorum (Identity team) - pure $ sortOn stiCreatedAt $ map fromScimTokenRow rows + pure $ sortOn (.stiCreatedAt) $ map fromScimTokenRow rows where sel :: PrepQuery R (Identity TeamId) ScimTokenRow sel = [r| - SELECT token_, team, id, created_at, idp, descr + SELECT token_, team, id, created_at, idp, descr, name FROM team_provisioning_by_team WHERE team = ? |] @@ -168,13 +169,13 @@ deleteScimToken team tokenid = do addPrepQuery delById (team, tokenid) for_ mbToken $ \(Identity key) -> addPrepQuery delByTokenLookup (Identity key) - where - selById :: PrepQuery R (TeamId, ScimTokenId) (Identity ScimTokenLookupKey) - selById = - [r| - SELECT token_ FROM team_provisioning_by_team - WHERE team = ? AND id = ? - |] + +selById :: PrepQuery R (TeamId, ScimTokenId) (Identity ScimTokenLookupKey) +selById = + [r| + SELECT token_ FROM team_provisioning_by_team + WHERE team = ? AND id = ? +|] delById :: PrepQuery W (TeamId, ScimTokenId) () delById = @@ -208,8 +209,41 @@ deleteTeamScimTokens team = do delByTeam :: PrepQuery W (Identity TeamId) () delByTeam = "DELETE FROM team_provisioning_by_team WHERE team = ?" -type ScimTokenRow = (ScimTokenLookupKey, TeamId, ScimTokenId, UTCTime, Maybe SAML.IdPId, Text) +updateScimTokenName :: (HasCallStack, MonadClient m) => TeamId -> ScimTokenId -> Text -> m () +updateScimTokenName team tokenid name = do + mbToken <- retry x1 . query1 selById $ params LocalQuorum (team, tokenid) + retry x5 . batch $ do + setType BatchLogged + setConsistency LocalQuorum + addPrepQuery updateNameById (name, team, tokenid) + for_ mbToken $ \(Identity key) -> + addPrepQuery updateNameByTokenLookup (name, key) + where + updateNameById :: PrepQuery W (Text, TeamId, ScimTokenId) () + updateNameById = + [r| + UPDATE team_provisioning_by_team + SET name = ? + WHERE team = ? AND id = ? + |] + + updateNameByTokenLookup :: PrepQuery W (Text, ScimTokenLookupKey) () + updateNameByTokenLookup = + [r| + UPDATE team_provisioning_by_token + SET name = ? + WHERE token_ = ? + |] + +type ScimTokenRow = (ScimTokenLookupKey, TeamId, ScimTokenId, UTCTime, Maybe SAML.IdPId, Text, Maybe Text) fromScimTokenRow :: ScimTokenRow -> ScimTokenInfo -fromScimTokenRow (_, stiTeam, stiId, stiCreatedAt, stiIdP, stiDescr) = - ScimTokenInfo {..} +fromScimTokenRow (_, stiTeam, stiId, stiCreatedAt, stiIdP, stiDescr, stiName) = + ScimTokenInfo + { stiId, + stiTeam, + stiCreatedAt, + stiIdP, + stiDescr, + stiName = fromMaybe (idToText stiId) stiName + } diff --git a/services/spar/src/Spar/Sem/ScimTokenStore/Mem.hs b/services/spar/src/Spar/Sem/ScimTokenStore/Mem.hs index 255d9a8e2ad..48b869fb0f0 100644 --- a/services/spar/src/Spar/Sem/ScimTokenStore/Mem.hs +++ b/services/spar/src/Spar/Sem/ScimTokenStore/Mem.hs @@ -36,6 +36,10 @@ scimTokenStoreToMem = (runState mempty .) $ reinterpret $ \case Insert st sti -> modify $ M.insert st sti Lookup st -> gets $ M.lookup st - LookupByTeam tid -> gets $ filter ((== tid) . stiTeam) . M.elems - Delete tid stid -> modify $ M.filter $ \sti -> not $ stiTeam sti == tid && stiId sti == stid - DeleteByTeam tid -> modify $ M.filter ((/= tid) . stiTeam) + LookupByTeam tid -> gets $ filter ((== tid) . (.stiTeam)) . M.elems + UpdateName tid stid name -> modify $ M.map $ \sti -> + if (.stiTeam) sti == tid && (.stiId) sti == stid + then sti {stiName = name} + else sti + Delete tid stid -> modify $ M.filter $ \sti -> not $ (.stiTeam) sti == tid && (.stiId) sti == stid + DeleteByTeam tid -> modify $ M.filter ((/= tid) . (.stiTeam)) diff --git a/services/spar/test-integration/Test/Spar/Scim/AuthSpec.hs b/services/spar/test-integration/Test/Spar/Scim/AuthSpec.hs index 7d2b945b95f..eb285a5e61b 100644 --- a/services/spar/test-integration/Test/Spar/Scim/AuthSpec.hs +++ b/services/spar/test-integration/Test/Spar/Scim/AuthSpec.hs @@ -97,9 +97,10 @@ testCreateToken = do createToken owner CreateScimToken - { createScimTokenDescr = "testCreateToken", - createScimTokenPassword = Just defPassword, - createScimTokenCode = Nothing + { description = "testCreateToken", + password = Just defPassword, + verificationCode = Nothing, + name = Nothing } -- Try to do @GET /Users@ and check that it succeeds let fltr = filterBy "externalId" "67c196a0-cd0e-11ea-93c7-ef550ee48502" @@ -120,17 +121,17 @@ testCreateTokenWithVerificationCode = do user <- getUserBrig owner let email = fromMaybe undefined (userEmail =<< user) - let reqMissingCode = CreateScimToken "testCreateToken" (Just defPassword) Nothing + let reqMissingCode = CreateScimToken "testCreateToken" (Just defPassword) Nothing Nothing createTokenFailsWith owner reqMissingCode 403 "code-authentication-required" void $ requestVerificationCode (env ^. teBrig) email Public.CreateScimToken let wrongCode = Code.Value $ unsafeRange (fromRight undefined (validate "123456")) - let reqWrongCode = CreateScimToken "testCreateToken" (Just defPassword) (Just wrongCode) + let reqWrongCode = CreateScimToken "testCreateToken" (Just defPassword) (Just wrongCode) Nothing createTokenFailsWith owner reqWrongCode 403 "code-authentication-failed" void $ retryNUntil 6 ((==) 200 . statusCode) $ requestVerificationCode (env ^. teBrig) email Public.CreateScimToken code <- getVerificationCode (env ^. teBrig) owner Public.CreateScimToken - let reqWithCode = CreateScimToken "testCreateToken" (Just defPassword) (Just code) + let reqWithCode = CreateScimToken "testCreateToken" (Just defPassword) (Just code) Nothing CreateScimTokenResponse token _ <- createToken owner reqWithCode -- Try to do @GET /Users@ and check that it succeeds @@ -177,25 +178,28 @@ testTokenLimit = do createToken owner CreateScimToken - { createScimTokenDescr = "testTokenLimit / #1", - createScimTokenPassword = Just defPassword, - createScimTokenCode = Nothing + { description = "testTokenLimit / #1", + password = Just defPassword, + verificationCode = Nothing, + name = Nothing } _ <- createToken owner CreateScimToken - { createScimTokenDescr = "testTokenLimit / #2", - createScimTokenPassword = Just defPassword, - createScimTokenCode = Nothing + { description = "testTokenLimit / #2", + password = Just defPassword, + verificationCode = Nothing, + name = Nothing } -- Try to create the third token and see that it fails createToken_ owner CreateScimToken - { createScimTokenDescr = "testTokenLimit / #3", - createScimTokenPassword = Just defPassword, - createScimTokenCode = Nothing + { description = "testTokenLimit / #3", + password = Just defPassword, + verificationCode = Nothing, + name = Nothing } (env ^. teSpar) !!! checkErr 403 (Just "token-limit-reached") @@ -214,13 +218,13 @@ testNumIdPs = do SAML.SampleIdP metadata _ _ _ <- SAML.makeSampleIdPMetadata void $ call $ Util.callIdpCreate apiversion spar (Just owner) metadata - createToken owner (CreateScimToken "eins" (Just defPassword) Nothing) - >>= deleteToken owner . stiId . createScimTokenResponseInfo + createToken owner (CreateScimToken "eins" (Just defPassword) Nothing Nothing) + >>= deleteToken owner . (.stiId) . (.info) addSomeIdP - createToken owner (CreateScimToken "zwei" (Just defPassword) Nothing) - >>= deleteToken owner . stiId . createScimTokenResponseInfo + createToken owner (CreateScimToken "zwei" (Just defPassword) Nothing Nothing) + >>= deleteToken owner . (.stiId) . (.info) addSomeIdP - createToken_ owner (CreateScimToken "drei" (Just defPassword) Nothing) (env ^. teSpar) + createToken_ owner (CreateScimToken "drei" (Just defPassword) Nothing Nothing) (env ^. teSpar) !!! checkErr 400 (Just "more-than-one-idp") -- @SF.Provisioning @TSFI.RESTfulAPI @S2 @@ -244,9 +248,10 @@ testCreateTokenAuthorizesOnlyAdmins = do createToken_ uid CreateScimToken - { createScimTokenDescr = "testCreateToken", - createScimTokenPassword = Just defPassword, - createScimTokenCode = Nothing + { description = "testCreateToken", + password = Just defPassword, + verificationCode = Nothing, + name = Nothing } (env ^. teSpar) @@ -272,9 +277,10 @@ testCreateTokenRequiresPassword = do createToken_ owner CreateScimToken - { createScimTokenDescr = "testCreateTokenRequiresPassword", - createScimTokenPassword = Nothing, - createScimTokenCode = Nothing + { description = "testCreateTokenRequiresPassword", + password = Nothing, + verificationCode = Nothing, + name = Nothing } (env ^. teSpar) !!! checkErr 403 (Just "access-denied") @@ -282,9 +288,10 @@ testCreateTokenRequiresPassword = do createToken_ owner CreateScimToken - { createScimTokenDescr = "testCreateTokenRequiresPassword", - createScimTokenPassword = Just (plainTextPassword6Unsafe "wrong password"), - createScimTokenCode = Nothing + { description = "testCreateTokenRequiresPassword", + password = Just (plainTextPassword6Unsafe "wrong password"), + verificationCode = Nothing, + name = Nothing } (env ^. teSpar) !!! checkErr 403 (Just "access-denied") @@ -309,22 +316,24 @@ testListTokens = do createToken owner CreateScimToken - { createScimTokenDescr = "testListTokens / #1", - createScimTokenPassword = Just defPassword, - createScimTokenCode = Nothing + { description = "testListTokens / #1", + password = Just defPassword, + verificationCode = Nothing, + name = Nothing } _ <- createToken owner CreateScimToken - { createScimTokenDescr = "testListTokens / #2", - createScimTokenPassword = Just defPassword, - createScimTokenCode = Nothing + { description = "testListTokens / #2", + password = Just defPassword, + verificationCode = Nothing, + name = Nothing } -- Check that the token is on the list - list <- scimTokenListTokens <$> listTokens owner + list <- (.scimTokenListTokens) <$> listTokens owner liftIO $ - map stiDescr list + map (.stiDescr) list `shouldBe` ["testListTokens / #1", "testListTokens / #2"] testPlaintextTokensAreConverted :: TestSpar () @@ -418,16 +427,17 @@ testDeletedTokensAreUnusable = do createToken owner CreateScimToken - { createScimTokenDescr = "testDeletedTokensAreUnusable", - createScimTokenPassword = Just defPassword, - createScimTokenCode = Nothing + { description = "testDeletedTokensAreUnusable", + password = Just defPassword, + verificationCode = Nothing, + name = Nothing } -- An operation with the token should succeed let fltr = filterBy "externalId" "67c196a0-cd0e-11ea-93c7-ef550ee48502" listUsers_ (Just token) (Just fltr) (env ^. teSpar) !!! const 200 === statusCode -- Delete the token and now the operation should fail - deleteToken owner (stiId tokenInfo) + deleteToken owner tokenInfo.stiId listUsers_ (Just token) Nothing (env ^. teSpar) !!! checkErr 401 Nothing @@ -443,14 +453,15 @@ testDeletedTokensAreUnlistable = do createToken owner CreateScimToken - { createScimTokenDescr = "testDeletedTokensAreUnlistable", - createScimTokenPassword = Just defPassword, - createScimTokenCode = Nothing + { description = "testDeletedTokensAreUnlistable", + password = Just defPassword, + verificationCode = Nothing, + name = Nothing } -- Delete the token - deleteToken owner (stiId tokenInfo) + deleteToken owner tokenInfo.stiId -- Check that the token is not on the list - list <- scimTokenListTokens <$> listTokens owner + list <- (.scimTokenListTokens) <$> listTokens owner liftIO $ list `shouldBe` [] ---------------------------------------------------------------------------- diff --git a/services/spar/test-integration/Util/Core.hs b/services/spar/test-integration/Util/Core.hs index 74aacb800cb..6d92d56e0df 100644 --- a/services/spar/test-integration/Util/Core.hs +++ b/services/spar/test-integration/Util/Core.hs @@ -47,6 +47,7 @@ module Util.Core -- * HTTP call, endpointToReq, + mkVersionedRequest, -- * Other randomEmail, @@ -139,7 +140,7 @@ where import Bilge hiding (getCookie, host, port) -- we use Web.Cookie instead of the http-client type import qualified Bilge import Bilge.Assert (Assertions, (!!!), ()) @@ -196,6 +200,8 @@ import URI.ByteString as URI import Util.Options import Util.Types import qualified Web.Cookie as Web +import Web.HttpApiData +import Wire.API.Routes.Version import Wire.API.Team (Icon (..)) import qualified Wire.API.Team as Galley import Wire.API.Team.Feature @@ -259,9 +265,9 @@ mkEnv tstOpts opts = do mgr :: Manager <- newManager defaultManagerSettings sparCtxLogger <- Log.mkLogger (samlToLevel $ saml opts ^. SAML.cfgLogLevel) (logNetStrings opts) (logFormat opts) cql :: ClientState <- initCassandra opts sparCtxLogger - let brig = endpointToReq tstOpts.brig - galley = endpointToReq tstOpts.galley - spar = endpointToReq tstOpts.spar + let brig = mkVersionedRequest tstOpts.brig + galley = mkVersionedRequest tstOpts.galley + spar = mkVersionedRequest tstOpts.spar sparEnv = Spar.Env {..} wireIdPAPIVersion = WireIdPAPIV2 sparCtxOpts = opts @@ -565,17 +571,42 @@ nextUserRef = liftIO $ do (SAML.Issuer $ SAML.unsafeParseURI ("http://" <> tenant)) <$> nextSubject +-- FUTUREWORK: use an endpoint from latest API version getTeams :: (HasCallStack, MonadHttp m, MonadIO m) => UserId -> GalleyReq -> m Galley.TeamList getTeams u gly = do r <- get - ( gly + ( unversioned + . gly . paths ["teams"] . zAuthAccess u "conn" . expect2xx ) pure $ responseJsonUnsafe r +-- | Note: Apply this function last when composing (Request -> Request) functions +unversioned :: Request -> Request +unversioned r = + r + { HTTP.path = + maybe + (HTTP.path r) + (B8.pack "/" <>) + (removeVersionPrefix . removeSlash' $ HTTP.path r) + } + where + removeVersionPrefix :: ByteString -> Maybe ByteString + removeVersionPrefix bs = do + let (x, s) = B8.splitAt 1 bs + guard (x == B8.pack "v") + (_, s') <- B8.readInteger s + pure (B8.tail s') + + removeSlash' :: ByteString -> ByteString + removeSlash' s = case B8.uncons s of + Just ('/', s') -> s' + _ -> s + getTeamMemberIds :: (HasCallStack) => UserId -> TeamId -> TestSpar [UserId] getTeamMemberIds usr tid = (^. Team.userId) <$$> getTeamMembers usr tid @@ -668,6 +699,24 @@ zConn = header "Z-Connection" endpointToReq :: Endpoint -> (Bilge.Request -> Bilge.Request) endpointToReq ep = Bilge.host (cs ep.host) . Bilge.port ep.port +mkVersionedRequest :: Endpoint -> Request -> Request +mkVersionedRequest ep = maybeAddPrefix . endpointToReq ep + +maybeAddPrefix :: Request -> Request +maybeAddPrefix r = case pathSegments $ getUri r of + ("i" : _) -> r + ("api-internal" : _) -> r + _ -> addPrefix r + +addPrefix :: Request -> Request +addPrefix r = r {HTTP.path = toHeader latestVersion <> "/" <> removeSlash (HTTP.path r)} + where + removeSlash s = case B8.uncons s of + Just ('/', s') -> s' + _ -> s + latestVersion :: Version + latestVersion = maxBound + -- spar specifics shouldRespondWith :: diff --git a/services/spar/test-integration/Util/Scim.hs b/services/spar/test-integration/Util/Scim.hs index bf2b7ebe9ae..d95bde89583 100644 --- a/services/spar/test-integration/Util/Scim.hs +++ b/services/spar/test-integration/Util/Scim.hs @@ -114,7 +114,8 @@ registerScimToken teamid midpid = do stiId = scimTokenId, stiCreatedAt = now, stiIdP = midpid, - stiDescr = "test token" + stiDescr = "test token", + stiName = "test token" } pure tok @@ -626,7 +627,7 @@ class IsUser u where instance IsUser ValidScimUser where maybeUserId = Nothing maybeHandle = Just (Just <$> handle) - maybeName = Just (Just <$> name) + maybeName = Just (Just <$> (.name)) maybeTenant = Just (fmap SAML._uidTenant . veidUref . externalId) maybeSubject = Just (fmap SAML._uidSubject . veidUref . externalId) maybeScimExternalId = Just (runValidScimIdEither Intra.urefToExternalId (Just . fromEmail) . externalId) diff --git a/services/spar/test/Arbitrary.hs b/services/spar/test/Arbitrary.hs index bc7cc42d9c2..b9d3f0de56a 100644 --- a/services/spar/test/Arbitrary.hs +++ b/services/spar/test/Arbitrary.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TypeSynonymInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} {-# OPTIONS_GHC -Wno-redundant-constraints #-} @@ -45,26 +44,18 @@ instance Arbitrary IdPList where instance Arbitrary WireIdP where arbitrary = WireIdP <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -deriving instance Arbitrary ScimToken - instance Arbitrary ScimTokenHash where arbitrary = hashScimToken <$> arbitrary -instance Arbitrary ScimTokenInfo where - arbitrary = - ScimTokenInfo - <$> arbitrary - <*> arbitrary - <*> arbitrary - <*> arbitrary - <*> arbitrary - -instance Arbitrary CreateScimTokenResponse where - arbitrary = CreateScimTokenResponse <$> arbitrary <*> arbitrary - instance Arbitrary ScimTokenList where arbitrary = ScimTokenList <$> arbitrary +instance Arbitrary ScimTokenListV6 where + arbitrary = ScimTokenListV6 <$> arbitrary + +instance Arbitrary ScimTokenName where + arbitrary = ScimTokenName <$> arbitrary + instance Arbitrary NoContent where arbitrary = pure NoContent diff --git a/services/spar/test/Test/Spar/Scim/UserSpec.hs b/services/spar/test/Test/Spar/Scim/UserSpec.hs index 9d759d600ac..09d09eee3ad 100644 --- a/services/spar/test/Test/Spar/Scim/UserSpec.hs +++ b/services/spar/test/Test/Spar/Scim/UserSpec.hs @@ -79,7 +79,7 @@ deleteUserAndAssertDeletionInSpar :: ScimTokenInfo -> Sem r (Either ScimError ()) deleteUserAndAssertDeletionInSpar acc tokenInfo = do - let tid = stiTeam tokenInfo + let tid = tokenInfo.stiTeam email = (fromJust . emailIdentity . fromJust . userIdentity) acc uid = userId acc ScimExternalIdStore.insert tid (fromEmail email) uid @@ -150,5 +150,5 @@ someActiveUser tokenInfo = do userAssets = [], userHandle = parseHandle "some-handle", userIdentity = (Just . EmailIdentity . fromJust . emailAddressText) "someone@wire.com", - userTeam = Just $ stiTeam tokenInfo + userTeam = Just $ tokenInfo.stiTeam }