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 474f55f109..17b4689d25 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Spar.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Spar.hs @@ -41,6 +41,7 @@ import Wire.API.Routes.Named import Wire.API.Routes.Public import Wire.API.Routes.Version import Wire.API.Routes.Versioned +import Wire.API.Servant.Tentatively import Wire.API.SwaggerServant import Wire.API.User.IdentityProvider import Wire.API.User.Saml @@ -142,7 +143,7 @@ type IdpGetAll = Get '[JSON] IdPList -- | See also: 'validateNewIdP', 'idpCreate', 'idpCreateXML'. type IdpCreate = - ReqBodyCustomError '[RawXML, JSON] "wai-error" IdPMetadataInfo + ReqBodyCustomError '[RawXML, JSON] "internal-error" (Tentatively IdPMetadataInfo) :> QueryParam' '[Optional, Strict] "replaces" SAML.IdPId :> QueryParam' '[Optional, Strict] "api_version" WireIdPAPIVersion -- see also: 'DeprecateSSOAPIV1' -- FUTUREWORK: The handle is restricted to 32 characters. Can we find a more reasonable upper bound and create a type for it? Also see `IdpUpdate`. @@ -150,7 +151,7 @@ type IdpCreate = :> PostCreated '[JSON] IdP type IdpUpdate = - ReqBodyCustomError '[RawXML, JSON] "wai-error" IdPMetadataInfo + ReqBodyCustomError '[RawXML, JSON] "internal-error" (Tentatively IdPMetadataInfo) :> Capture "id" SAML.IdPId -- FUTUREWORK: The handle is restricted to 32 characters. Can we find a more reasonable upper bound and create a type for it? Also see `IdpCreate`. :> QueryParam' '[Optional, Strict] "handle" (Range 1 32 Text) diff --git a/libs/wire-api/src/Wire/API/Servant/Tentatively.hs b/libs/wire-api/src/Wire/API/Servant/Tentatively.hs new file mode 100644 index 0000000000..2ff5cd9c68 --- /dev/null +++ b/libs/wire-api/src/Wire/API/Servant/Tentatively.hs @@ -0,0 +1,63 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2025 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 Wire.API.Servant.Tentatively + ( Tentatively (Tentatively), + AccessGranted, + forceTentatively, + ) +where + +import Data.Bifunctor +import Data.ByteString.Lazy.Char8 as LBS +import Data.Text qualified as T +import Imports +import Servant +import Servant.API.Extended + +-- | Parse data coming in through servant only *tentatively* until after the handler has +-- carried out some dynamic access control. +-- +-- FUTUREWORK: can we hide authentication and access control deeper in servant such that the +-- handler doesn't need to explicitly call it? +newtype Tentatively a = Tentatively {forceTentatively :: AccessGranted -> Either Text a} + +-- | Token to give to a tentatively parsed value to force the parser function. +-- +-- FUTUREWORK: we could make this abstract and only allow the access control code to construct +-- any values, then the application logic would not be able to parse unauthorized data even by +-- accident. But that would require some rethinking how and where we do access control. +type AccessGranted = () + +instance {-# OVERLAPPING #-} (FromHttpApiData a) => FromHttpApiData (Tentatively a) where + parseUrlPiece raw = + pure . Tentatively $ \() -> parseUrlPiece @a raw + +instance {-# OVERLAPPING #-} (MimeUnrender ct a) => MimeUnrender ct (Tentatively a) where + mimeUnrender proxy payload = + pure . Tentatively $ \() -> first T.pack $ mimeUnrender proxy payload + +instance MakeCustomError "internal-error" (Tentatively a) where + makeCustomError msg = + err500 + { errBody = + "parsing part of a request wrapped in `Tentatively` failed with " + <> LBS.pack (show msg) + <> ". this is a bug in wire-server." + } + +-- TODO: move this module to extended? diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal index ef0b190963..f351adfdd3 100644 --- a/libs/wire-api/wire-api.cabal +++ b/libs/wire-api/wire-api.cabal @@ -214,6 +214,7 @@ library Wire.API.Routes.Version.Wai Wire.API.Routes.Versioned Wire.API.Routes.WebSocket + Wire.API.Servant.Tentatively Wire.API.ServantProto Wire.API.SwaggerHelper Wire.API.SwaggerServant diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs index 07c78eaee4..e49c52bb79 100644 --- a/services/spar/src/Spar/API.hs +++ b/services/spar/src/Spar/API.hs @@ -107,6 +107,8 @@ import qualified URI.ByteString as URI import Wire.API.Routes.Internal.Spar import Wire.API.Routes.Named import Wire.API.Routes.Public.Spar +import Wire.API.Servant.Tentatively +import qualified Wire.API.Servant.Tentatively as Tentatively import Wire.API.Team.Member (HiddenPerm (CreateUpdateDeleteIdp, ReadIdp)) import Wire.API.User import Wire.API.User.IdentityProvider @@ -122,7 +124,9 @@ app ctx0 req cont = do let rid = getRequestId defaultRequestIdHeaderName req let ctx = ctx0 {sparCtxRequestId = rid} SAML.setHttpCachePolicy - ( serve + ( serve -- TODO: "instance MimeUnrender JSON (Tentatively IdPMetadataInfo)" missing, + -- probably because IdPMetadataInfo doesn't have one. is this something we didn't + -- need before? (Proxy @SparAPI) (hoistServer (Proxy @SparAPI) (runSparToHandler ctx) (api $ sparCtxOpts ctx) :: Server SparAPI) ) @@ -607,13 +611,14 @@ idpCreate :: Member (Error SparError) r ) => Maybe UserId -> - IdPMetadataInfo -> + Tentatively IdPMetadataInfo -> Maybe SAML.IdPId -> Maybe WireIdPAPIVersion -> Maybe (Range 1 32 Text) -> Sem r IdP -idpCreate zusr (IdPMetadataValue rawIdpMetadata idpmeta) mReplaces (fromMaybe defWireIdPAPIVersion -> apiversion) mHandle = withDebugLog "idpCreateXML" (Just . show . (^. SAML.idpId)) $ do +idpCreate zusr tentativeMetaData mReplaces (fromMaybe defWireIdPAPIVersion -> apiversion) mHandle = withDebugLog "idpCreateXML" (Just . show . (^. SAML.idpId)) $ do teamid <- Brig.getZUsrCheckPerm zusr CreateUpdateDeleteIdp + IdPMetadataValue rawIdpMetadata idpmeta <- forceIt tentativeMetaData GalleyAccess.assertSSOEnabled teamid idp <- maybe (IdPConfigStore.newHandle teamid) (pure . IdPHandle . fromRange) mHandle @@ -624,6 +629,10 @@ idpCreate zusr (IdPMetadataValue rawIdpMetadata idpmeta) mReplaces (fromMaybe de IdPConfigStore.setReplacedBy (Replaced replaces) (Replacing (idp ^. SAML.idpId)) pure idp +-- what should we give you, forceIt? an error action? a function that takes an http error and throws it in the locally appropriate fashion? +forceIt :: (Applicative m) => Tentatively a -> m a +forceIt = undefined -- t e = Tentatively.forceTentatively t & either e pure + idpCreateV7 :: ( Member Random r, Member (Logger String) r, @@ -635,7 +644,7 @@ idpCreateV7 :: Member (Error SparError) r ) => Maybe UserId -> - IdPMetadataInfo -> + Tentatively IdPMetadataInfo -> Maybe SAML.IdPId -> Maybe WireIdPAPIVersion -> Maybe (Range 1 32 Text) -> @@ -724,9 +733,6 @@ validateNewIdP apiversion _idpMetadata teamId mReplaces idHandle = withDebugLog pure SAML.IdPConfig {..} --- | FUTUREWORK: 'idpUpdateXML' is only factored out of this function for symmetry with --- 'idpCreate', which is not a good reason. make this one function and pass around --- 'IdPMetadataInfo' directly where convenient. idpUpdate :: ( Member Random r, Member (Logger String) r, @@ -737,31 +743,14 @@ idpUpdate :: Member (Error SparError) r ) => Maybe UserId -> - IdPMetadataInfo -> + Tentatively IdPMetadataInfo -> SAML.IdPId -> Maybe (Range 1 32 Text) -> Sem r IdP -idpUpdate zusr (IdPMetadataValue raw xml) = idpUpdateXML zusr raw xml - -idpUpdateXML :: - ( Member Random r, - Member (Logger String) r, - Member GalleyAccess r, - Member BrigAccess r, - Member IdPConfigStore r, - Member IdPRawMetadataStore r, - Member (Error SparError) r - ) => - Maybe UserId -> - Text -> - SAML.IdPMetadata -> - SAML.IdPId -> - Maybe (Range 1 32 Text) -> - Sem r IdP -idpUpdateXML zusr raw idpmeta idpid mHandle = withDebugLog "idpUpdateXML" (Just . show . (^. SAML.idpId)) $ do - (teamid, idp) <- validateIdPUpdate zusr idpmeta idpid +idpUpdate zusr idpmeta idpid mHandle = withDebugLog "idpUpdateCore" (Just . show . (^. SAML.idpId)) $ do + (idpText, teamid, idp) <- validateIdPUpdate zusr idpmeta idpid GalleyAccess.assertSSOEnabled teamid - IdPRawMetadataStore.store (idp ^. SAML.idpId) raw + IdPRawMetadataStore.store (idp ^. SAML.idpId) idpText let idp' :: IdP = case mHandle of Just idpHandle -> idp & (SAML.idpExtraInfo . handle) .~ IdPHandle (fromRange idpHandle) Nothing -> idp @@ -792,12 +781,16 @@ validateIdPUpdate :: Member (Error SparError) r ) => Maybe UserId -> - SAML.IdPMetadata -> + Tentatively IdPMetadataInfo -> SAML.IdPId -> - m (TeamId, IdP) -validateIdPUpdate zusr _idpMetadata _idpId = withDebugLog "validateIdPUpdate" (Just . show . (_2 %~ (^. SAML.idpId))) $ do + m (Text, TeamId, IdP) +validateIdPUpdate zusr tentativeIdpMeta _idpId = withDebugLog "validateIdPUpdate" (const $ Just $ show _idpId) $ do + -- access control previousIdP <- IdPConfigStore.getConfig _idpId (_, teamId) <- authorizeIdP zusr previousIdP + + -- parse xml & continue with application logic. + IdPMetadataValue idpText _idpMetadata <- forceIt tentativeIdpMeta unless (previousIdP ^. SAML.idpExtraInfo . team == teamId) $ throw errUnknownIdP _idpExtraInfo <- do @@ -827,7 +820,7 @@ validateIdPUpdate zusr _idpMetadata _idpId = withDebugLog "validateIdPUpdate" (J let requri = _idpMetadata ^. SAML.edRequestURI enforceHttps requri - pure (teamId, SAML.IdPConfig {..}) + pure (idpText, teamId, SAML.IdPConfig {..}) where -- If the new issuer was previously used, it has to be removed from the list of old issuers, -- to prevent it from getting deleted in a later step diff --git a/services/spar/src/Spar/Orphans.hs b/services/spar/src/Spar/Orphans.hs index 5258bccfc3..0603fb14dd 100644 --- a/services/spar/src/Spar/Orphans.hs +++ b/services/spar/src/Spar/Orphans.hs @@ -24,16 +24,8 @@ module Spar.Orphans ) where -import qualified Data.Text.Lazy as LText import Imports -import qualified SAML2.WebSSO as SAML import Servant (MimeRender (..), PlainText) -import Servant.API.Extended -import Spar.Error -import Wire.API.User.IdentityProvider (IdPMetadataInfo) instance MimeRender PlainText Void where mimeRender _ = error "instance MimeRender HTML Void: impossible" - -instance MakeCustomError "wai-error" IdPMetadataInfo where - makeCustomError = sparToServerError . SAML.CustomError . SparNewIdPBadMetadata . LText.pack