diff --git a/changelog.d/3-bug-fixes/WPB-5810 b/changelog.d/3-bug-fixes/WPB-5810 new file mode 100644 index 0000000000..2ae3978128 --- /dev/null +++ b/changelog.d/3-bug-fixes/WPB-5810 @@ -0,0 +1 @@ +Do not match on the `Accept` header for service provider endpoints with no response body diff --git a/integration/integration.cabal b/integration/integration.cabal index ad3983a4df..6bf252ef0d 100644 --- a/integration/integration.cabal +++ b/integration/integration.cabal @@ -123,6 +123,7 @@ library Test.Presence Test.Roles Test.Search + Test.Services Test.User Testlib.App Testlib.Assertions diff --git a/integration/test/API/Brig.hs b/integration/test/API/Brig.hs index 36d428db1f..06c191dbe3 100644 --- a/integration/test/API/Brig.hs +++ b/integration/test/API/Brig.hs @@ -3,9 +3,12 @@ module API.Brig where import API.Common import Data.Aeson qualified as Aeson import Data.ByteString.Base64 qualified as Base64 +import Data.CaseInsensitive qualified as CI import Data.Foldable import Data.Function +import Data.Text qualified as T import Data.Text.Encoding qualified as T +import Data.Vector qualified as V import GHC.Stack import Testlib.Prelude @@ -19,6 +22,80 @@ data AddUser = AddUser instance Default AddUser where def = AddUser Nothing Nothing Nothing Nothing +data NewProvider = NewProvider + { newProviderName :: String, + newProviderDesc :: String, + newProviderEmail :: String, + newProviderPassword :: Maybe String, + newProviderUrl :: String + } + +instance Default NewProvider where + def = + NewProvider + "New Provider" + "Just a provider" + "provider@example.com" + Nothing + "https://example.com" + +instance ToJSON NewProvider where + toJSON NewProvider {..} = + Aeson.object + [ "name" .= newProviderName, + "description" .= newProviderDesc, + "email" .= newProviderEmail, + "password" .= newProviderPassword, + "url" .= newProviderUrl + ] + +data NewService = NewService + { newServiceName :: String, + newServiceSummary :: String, + newServiceDescr :: String, + newServiceUrl :: String, + newServiceKey :: ByteString, + newServiceToken :: Maybe String, + newServiceAssets :: [String], + newServiceTags :: [String] + } + +instance Default NewService where + def = + NewService + "New Service" + "Just a service" + "Just a service description" + "https://example.com" + ( T.encodeUtf8 . T.unlines . fmap T.pack $ + [ "-----BEGIN PUBLIC KEY-----", + "MIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEAu+Kg/PHHU3atXrUbKnw0", + "G06FliXcNt3lMwl2os5twEDcPPFw/feGiAKymxp+7JqZDrseS5D9THGrW+OQRIPH", + "WvUBdiLfGrZqJO223DB6D8K2Su/odmnjZJ2z23rhXoEArTplu+Dg9K+c2LVeXTKV", + "VPOaOzgtAB21XKRiQ4ermqgi3/njr03rXyq/qNkuNd6tNcg+HAfGxfGvvCSYBfiS", + "bUKr/BeArYRcjzr/h5m1In6fG/if9GEI6m8dxHT9JbY53wiksowy6ajCuqskIFg8", + "7X883H+LA/d6X5CTiPv1VMxXdBUiGPuC9IT/6CNQ1/LFt0P37ax58+LGYlaFo7la", + "nQIDAQAB", + "-----END PUBLIC KEY-----" + ] + ) + (Just "secret-token") + [] + ["music", "quiz", "weather"] + +instance ToJSON NewService where + toJSON NewService {..} = + Aeson.object + [ "name" .= newServiceName, + "summary" .= newServiceSummary, + "description" .= newServiceDescr, + "base_url" .= newServiceUrl, + "public_key" .= (T.unpack . T.decodeUtf8) newServiceKey, + "auth_token" .= newServiceToken, + "assets" .= Aeson.Array (V.fromList (Aeson.String . T.pack <$> newServiceAssets)), + "tags" .= Aeson.Array (V.fromList (Aeson.String . T.pack <$> newServiceTags)) + ] + addUser :: (HasCallStack, MakesValue dom) => dom -> AddUser -> App Response addUser dom opts = do req <- baseRequest dom Brig Versioned "register" @@ -409,3 +486,105 @@ getSwaggerInternalJson service = do rawBaseRequest OwnDomain Nginz Unversioned $ joinHttpPath ["api-internal", "swagger-ui", service <> "-swagger.json"] submit "GET" req + +newProvider :: + ( HasCallStack, + MakesValue provider, + MakesValue user + ) => + user -> + provider -> + App Value +newProvider user provider = do + p <- make provider + req <- + baseRequest user Brig Versioned $ + joinHttpPath ["provider", "register"] + submit "POST" (addJSON p req) `bindResponse` \resp -> do + resp.status `shouldMatchInt` 201 + resp.json + +activateProvider :: + ( HasCallStack, + MakesValue dom + ) => + dom -> + String -> + String -> + App () +activateProvider dom key code = do + d <- make dom + req <- + rawBaseRequest d Brig Versioned $ + joinHttpPath ["provider", "activate"] + let ps = [("key", key), ("code", code)] + submit "GET" (addQueryParams ps req) `bindResponse` \resp -> do + resp.status `shouldMatchOneOf` [Number 200, Number 204] + +-- | Returns the value of the Set-Cookie header that is to be used to +-- authenticate to provider endpoints. +loginProvider :: + ( HasCallStack, + MakesValue dom + ) => + dom -> + String -> + String -> + App ByteString +loginProvider dom email pass = do + d <- asString dom + req <- + rawBaseRequest d Brig Versioned $ + joinHttpPath ["provider", "login"] + submit "POST" (addJSONObject ["email" .= email, "password" .= pass] req) `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + let hs = headers resp + setCookieHeader = CI.mk (T.encodeUtf8 . T.pack $ "Set-Cookie") + pure . fromJust . foldMap (\(k, v) -> guard (k == setCookieHeader) $> v) $ hs + +newService :: + ( HasCallStack, + MakesValue dom + ) => + dom -> + String -> + NewService -> + App Value +newService dom providerId service = do + s <- make service + domain <- asString dom + req <- + rawBaseRequest domain Brig Versioned $ + joinHttpPath ["provider", "services"] + let addHdrs = + addHeader "Z-Type" "provider" + . addHeader "Z-Provider" providerId + submit "POST" (addJSON s . addHdrs $ req) `bindResponse` \resp -> do + resp.status `shouldMatchInt` 201 + resp.json + +updateService :: + ( HasCallStack, + MakesValue dom, + MakesValue serviceId + ) => + dom -> + String -> + serviceId -> + Maybe String -> + Maybe String -> + App Response +updateService dom providerId serviceId mAcceptHeader newName = do + sId <- asString serviceId + domain <- asString dom + req <- + rawBaseRequest domain Brig Versioned $ + joinHttpPath ["provider", "services", sId] + let addHdrs = + addHeader "Z-Type" "provider" + . addHeader "Z-Provider" providerId + . maybe id (addHeader "Accept") mAcceptHeader + submit "PUT" + . addHdrs + . addJSONObject ["name" .= n | n <- maybeToList newName] + $ req diff --git a/integration/test/API/BrigInternal.hs b/integration/test/API/BrigInternal.hs index e08351b430..e0492dd357 100644 --- a/integration/test/API/BrigInternal.hs +++ b/integration/test/API/BrigInternal.hs @@ -205,3 +205,15 @@ getConnStatusInternal body dom = do joinHttpPath ["i", "users", "connections-status", "v2"] submit "POST" do req & addJSONObject body + +getProviderActivationCodeInternal :: + (HasCallStack, MakesValue dom) => + dom -> + String -> + App Response +getProviderActivationCodeInternal dom email = do + d <- make dom + req <- + rawBaseRequest d Brig Unversioned $ + joinHttpPath ["i", "provider", "activation-code"] + submit "GET" (addQueryParams [("email", email)] req) diff --git a/integration/test/SetupHelpers.hs b/integration/test/SetupHelpers.hs index be86bbfc69..e7d8c749f0 100644 --- a/integration/test/SetupHelpers.hs +++ b/integration/test/SetupHelpers.hs @@ -245,3 +245,27 @@ getOne2OneConversation user1 user2 cnvState = do qIds <- for others (%. "qualified_id") pure $ qIds == users && t head <$> filterM (isWith [user2]) l + +-- | Create a provider, get an activation code, activate the provider and log it +-- in. The return value is the created provider. +setupProvider :: + ( HasCallStack, + MakesValue user + ) => + user -> + NewProvider -> + App Value +setupProvider u np@(NewProvider {..}) = do + dom <- objDomain u + provider <- newProvider u np + pass <- provider %. "password" & asString + (key, code) <- do + pair <- + getProviderActivationCodeInternal dom newProviderEmail `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + resp.json + k <- pair %. "key" & asString + c <- pair %. "code" & asString + pure (k, c) + activateProvider dom key code + loginProvider dom newProviderEmail pass $> provider diff --git a/integration/test/Test/Services.hs b/integration/test/Test/Services.hs new file mode 100644 index 0000000000..3156a98561 --- /dev/null +++ b/integration/test/Test/Services.hs @@ -0,0 +1,42 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2023 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.Services where + +import API.Brig +import API.Common +import SetupHelpers +import Testlib.Prelude + +testUpdateServiceUpdateAcceptHeader :: HasCallStack => App () +testUpdateServiceUpdateAcceptHeader = do + let dom = OwnDomain + email <- randomEmail + alice <- randomUser dom def + provider <- setupProvider alice def {newProviderEmail = email} + pId <- provider %. "id" & asString + service <- newService dom pId def + sId <- service %. "id" + void $ + updateService dom pId sId (Just "application/json") (Just "brand new service") + >>= getBody 200 + void $ + updateService dom pId sId (Just "text/plain") (Just "even newer service") + >>= getBody 200 + void $ + updateService dom pId sId Nothing (Just "really old service") + >>= getBody 200 diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig/Services.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig/Services.hs index 8fab900fca..0fff51c6f9 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig/Services.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig/Services.hs @@ -73,7 +73,7 @@ type ServicesAPI = :> "services" :> Capture "service-id" ServiceId :> ReqBody '[JSON] Public.UpdateService - :> Put '[PlainText] NoContent + :> MultiVerb1 'PUT '[PlainText, JSON] (RespondEmpty 200 "Provider service updated") ) :<|> Named "put-provider-services-connection-by-service-id" @@ -88,7 +88,7 @@ type ServicesAPI = :> Capture "service-id" ServiceId :> "connection" :> ReqBody '[JSON] Public.UpdateServiceConn - :> Put '[PlainText] NoContent + :> MultiVerb1 'PUT '[PlainText, JSON] (RespondEmpty 200 "Provider service connection updated") ) :<|> Named "delete-provider-services-by-service-id" diff --git a/services/brig/src/Brig/Provider/API.hs b/services/brig/src/Brig/Provider/API.hs index 5a5c7f9485..a0dc6e56e7 100644 --- a/services/brig/src/Brig/Provider/API.hs +++ b/services/brig/src/Brig/Provider/API.hs @@ -92,7 +92,7 @@ import OpenSSL.PEM qualified as SSL import OpenSSL.RSA qualified as SSL import OpenSSL.Random (randBytes) import Polysemy -import Servant (NoContent (..), ServerT, (:<|>) (..)) +import Servant (ServerT, (:<|>) (..)) import Ssl.Util qualified as SSL import System.Logger.Class (MonadLogger) import UnliftIO.Async (pooledMapConcurrentlyN_) @@ -392,7 +392,7 @@ updateService :: ProviderId -> ServiceId -> Public.UpdateService -> - (Handler r) NoContent + Handler r () updateService pid sid upd = do guardSecondFactorDisabled Nothing _ <- wrapClientE (DB.lookupAccount pid) >>= maybeInvalidProvider @@ -420,14 +420,13 @@ updateService pid sid upd = do newAssets tagsChange (serviceEnabled svc) - $> NoContent updateServiceConn :: Member GalleyProvider r => ProviderId -> ServiceId -> Public.UpdateServiceConn -> - (Handler r) NoContent + Handler r () updateServiceConn pid sid upd = do guardSecondFactorDisabled Nothing pass <- wrapClientE (DB.lookupPassword pid) >>= maybeBadCredentials @@ -461,7 +460,6 @@ updateServiceConn pid sid upd = do if sconEnabled scon then DB.deleteServiceIndexes pid sid name tags else DB.insertServiceIndexes pid sid name tags - pure NoContent -- TODO: Send informational email to provider.