From beaa248b342d9cf24c66519c1eef7dd6cd36f271 Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Fri, 1 Oct 2021 18:07:33 -0700
Subject: [PATCH 01/13] Remove wrapMonadClientSem

Put it into the Cassandra interpreter instead
---
 services/spar/src/Spar/API.hs                 | 78 +++++++++----------
 services/spar/src/Spar/App.hs                 | 42 ++++------
 services/spar/src/Spar/Scim/Auth.hs           | 14 ++--
 services/spar/src/Spar/Scim/User.hs           | 28 +++----
 .../src/Spar/Sem/SAMLUserStore/Cassandra.hs   | 19 ++++-
 5 files changed, 89 insertions(+), 92 deletions(-)

diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs
index ae21f03f0f..e46ac461a4 100644
--- a/services/spar/src/Spar/API.hs
+++ b/services/spar/src/Spar/API.hs
@@ -246,13 +246,13 @@ authreq _ DoInitiateBind Nothing _ _ _ = throwSpar SparInitBindWithoutAuth
 authreq authreqttl _ zusr msucc merr idpid = do
   vformat <- validateAuthreqParams msucc merr
   form@(SAML.FormRedirect _ ((^. SAML.rqID) -> reqid)) <- do
-    idp :: IdP <- wrapMonadClientSem (IdPEffect.getConfig idpid) >>= maybe (throwSpar (SparIdPNotFound (cs $ show idpid))) pure
+    idp :: IdP <- liftSem (IdPEffect.getConfig idpid) >>= maybe (throwSpar (SparIdPNotFound (cs $ show idpid))) pure
     let mbtid :: Maybe TeamId
         mbtid = case fromMaybe defWireIdPAPIVersion (idp ^. SAML.idpExtraInfo . wiApiVersion) of
           WireIdPAPIV1 -> Nothing
           WireIdPAPIV2 -> Just $ idp ^. SAML.idpExtraInfo . wiTeam
     liftSem $ SAML2.authReq authreqttl (SamlProtocolSettings.spIssuer mbtid) idpid
-  wrapMonadClientSem $ AReqIDStore.storeVerdictFormat authreqttl reqid vformat
+  liftSem $ AReqIDStore.storeVerdictFormat authreqttl reqid vformat
   cky <- initializeBindCookie zusr authreqttl
   liftSem $ Logger.log SAML.Debug $ "setting bind cookie: " <> show cky
   pure $ addHeader cky form
@@ -279,7 +279,7 @@ initializeBindCookie zusr authreqttl = do
       then liftSem $ Just . cs . ES.encode <$> Random.bytes 32
       else pure Nothing
   cky <- fmap SetBindCookie . liftSem . SAML2.toggleCookie derivedOptsBindCookiePath $ (,authreqttl) <$> msecret
-  forM_ zusr $ \userid -> wrapMonadClientSem $ BindCookieStore.insert cky userid authreqttl
+  forM_ zusr $ \userid -> liftSem $ BindCookieStore.insert cky userid authreqttl
   pure cky
 
 redirectURLMaxLength :: Int
@@ -348,7 +348,7 @@ authresp mbtid ckyraw arbody = logErrors $ liftSem $ SAML2.authResp mbtid (SamlP
 
 ssoSettings :: Member DefaultSsoCode r => Spar r SsoSettings
 ssoSettings = do
-  SsoSettings <$> wrapMonadClientSem DefaultSsoCode.get
+  SsoSettings <$> liftSem DefaultSsoCode.get
 
 ----------------------------------------------------------------------------
 -- IdP API
@@ -379,7 +379,7 @@ idpGetRaw ::
 idpGetRaw zusr idpid = do
   idp <- getIdPConfig idpid
   _ <- liftSem $ authorizeIdP zusr idp
-  wrapMonadClientSem (IdPEffect.getRawMetadata idpid) >>= \case
+  liftSem (IdPEffect.getRawMetadata idpid) >>= \case
     Just txt -> pure $ RawIdPMetadata txt
     Nothing -> throwSpar $ SparIdPNotFound (cs $ show idpid)
 
@@ -397,7 +397,7 @@ idpGetAll ::
   Spar r IdPList
 idpGetAll zusr = withDebugLog "idpGetAll" (const Nothing) $ do
   teamid <- liftSem $ Brig.getZUsrCheckPerm zusr ReadIdp
-  _idplProviders <- wrapMonadClientSem $ IdPEffect.getConfigsByTeam teamid
+  _idplProviders <- liftSem $ IdPEffect.getConfigsByTeam teamid
   pure IdPList {..}
 
 -- | Delete empty IdPs, or if @"purge=true"@ in the HTTP query, delete all users
@@ -431,13 +431,13 @@ idpDelete zusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (cons
   let issuer = idp ^. SAML.idpMetadata . SAML.edIssuer
       team = idp ^. SAML.idpExtraInfo . wiTeam
   -- if idp is not empty: fail or purge
-  idpIsEmpty <- wrapMonadClientSem $ isNothing <$> SAMLUserStore.getAnyByIssuer issuer
+  idpIsEmpty <- liftSem $ isNothing <$> SAMLUserStore.getAnyByIssuer issuer
   let doPurge :: Spar r ()
       doPurge = do
-        some <- wrapMonadClientSem (SAMLUserStore.getSomeByIssuer issuer)
+        some <- liftSem (SAMLUserStore.getSomeByIssuer issuer)
         forM_ some $ \(uref, uid) -> do
           liftSem $ BrigAccess.delete uid
-          wrapMonadClientSem (SAMLUserStore.delete uid uref)
+          liftSem (SAMLUserStore.delete uid uref)
         unless (null some) doPurge
   when (not idpIsEmpty) $ do
     if purge
@@ -445,17 +445,16 @@ idpDelete zusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (cons
       else throwSpar SparIdPHasBoundUsers
   updateOldIssuers idp
   updateReplacingIdP idp
-  wrapSpar $ do
-    -- Delete tokens associated with given IdP (we rely on the fact that
-    -- each IdP has exactly one team so we can look up all tokens
-    -- associated with the team and then filter them)
-    tokens <- liftSem $ ScimTokenStore.getByTeam team
-    for_ tokens $ \ScimTokenInfo {..} ->
-      when (stiIdP == Just idpid) $ liftSem $ ScimTokenStore.delete team stiId
-    -- Delete IdP config
-    liftSem $ do
-      IdPEffect.deleteConfig idpid issuer team
-      IdPEffect.deleteRawMetadata idpid
+  -- Delete tokens associated with given IdP (we rely on the fact that
+  -- each IdP has exactly one team so we can look up all tokens
+  -- associated with the team and then filter them)
+  tokens <- liftSem $ ScimTokenStore.getByTeam team
+  for_ tokens $ \ScimTokenInfo {..} ->
+    when (stiIdP == Just idpid) $ liftSem $ ScimTokenStore.delete team stiId
+  -- Delete IdP config
+  liftSem $ do
+    IdPEffect.deleteConfig idpid issuer team
+    IdPEffect.deleteRawMetadata idpid
   return NoContent
   where
     updateOldIssuers :: IdP -> Spar r ()
@@ -469,13 +468,12 @@ idpDelete zusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (cons
 
     updateReplacingIdP :: IdP -> Spar r ()
     updateReplacingIdP idp = forM_ (idp ^. SAML.idpExtraInfo . wiOldIssuers) $ \oldIssuer -> do
-      wrapSpar $ do
-        getIdPIdByIssuer oldIssuer (idp ^. SAML.idpExtraInfo . wiTeam) >>= \case
-          Data.GetIdPFound iid -> liftSem $ IdPEffect.clearReplacedBy $ Data.Replaced iid
-          Data.GetIdPNotFound -> pure ()
-          Data.GetIdPDanglingId _ -> pure ()
-          Data.GetIdPNonUnique _ -> pure ()
-          Data.GetIdPWrongTeam _ -> pure ()
+      getIdPIdByIssuer oldIssuer (idp ^. SAML.idpExtraInfo . wiTeam) >>= \case
+        Data.GetIdPFound iid -> liftSem $ IdPEffect.clearReplacedBy $ Data.Replaced iid
+        Data.GetIdPNotFound -> pure ()
+        Data.GetIdPDanglingId _ -> pure ()
+        Data.GetIdPNonUnique _ -> pure ()
+        Data.GetIdPWrongTeam _ -> pure ()
 
 -- | This handler only does the json parsing, and leaves all authorization checks and
 -- application logic to 'idpCreateXML'.
@@ -520,9 +518,9 @@ idpCreateXML zusr raw idpmeta mReplaces (fromMaybe defWireIdPAPIVersion -> apive
   liftSem $ GalleyAccess.assertSSOEnabled teamid
   assertNoScimOrNoIdP teamid
   idp <- validateNewIdP apiversion idpmeta teamid mReplaces
-  wrapMonadClientSem $ IdPEffect.storeRawMetadata (idp ^. SAML.idpId) raw
+  liftSem $ IdPEffect.storeRawMetadata (idp ^. SAML.idpId) raw
   storeIdPConfig idp
-  forM_ mReplaces $ \replaces -> wrapMonadClientSem $ do
+  forM_ mReplaces $ \replaces -> liftSem $ do
     IdPEffect.setReplacedBy (Data.Replaced replaces) (Data.Replacing (idp ^. SAML.idpId))
   pure idp
 
@@ -532,8 +530,8 @@ idpCreateXML zusr raw idpmeta mReplaces (fromMaybe defWireIdPAPIVersion -> apive
 -- tokens with IdPs.  https://wearezeta.atlassian.net/browse/SQSERVICES-165
 assertNoScimOrNoIdP :: Members '[ScimTokenStore, IdPEffect.IdP] r => TeamId -> Spar r ()
 assertNoScimOrNoIdP teamid = do
-  numTokens <- length <$> wrapMonadClientSem (ScimTokenStore.getByTeam teamid)
-  numIdps <- length <$> wrapMonadClientSem (IdPEffect.getConfigsByTeam teamid)
+  numTokens <- length <$> liftSem (ScimTokenStore.getByTeam teamid)
+  numIdps <- length <$> liftSem (IdPEffect.getConfigsByTeam teamid)
   when (numTokens > 0 && numIdps > 0) $ do
     throwSpar $
       SparProvisioningMoreThanOneIdP
@@ -573,12 +571,12 @@ validateNewIdP apiversion _idpMetadata teamId mReplaces = withDebugLog "validate
   oldIssuers :: [SAML.Issuer] <- case mReplaces of
     Nothing -> pure []
     Just replaces -> do
-      idp <- wrapMonadClientSem (IdPEffect.getConfig replaces) >>= maybe (throwSpar (SparIdPNotFound (cs $ show mReplaces))) pure
+      idp <- liftSem (IdPEffect.getConfig replaces) >>= maybe (throwSpar (SparIdPNotFound (cs $ show mReplaces))) pure
       pure $ (idp ^. SAML.idpMetadata . SAML.edIssuer) : (idp ^. SAML.idpExtraInfo . wiOldIssuers)
   let requri = _idpMetadata ^. SAML.edRequestURI
       _idpExtraInfo = WireIdP teamId (Just apiversion) oldIssuers Nothing
   enforceHttps requri
-  idp <- wrapSpar $ getIdPConfigByIssuer (_idpMetadata ^. SAML.edIssuer) teamId
+  idp <- getIdPConfigByIssuer (_idpMetadata ^. SAML.edIssuer) teamId
   liftSem $ Logger.log SAML.Debug $ show (apiversion, _idpMetadata, teamId, mReplaces)
   liftSem $ Logger.log SAML.Debug $ show (_idpId, oldIssuers, idp)
 
@@ -642,7 +640,7 @@ idpUpdateXML ::
 idpUpdateXML zusr raw idpmeta idpid = withDebugLog "idpUpdate" (Just . show . (^. SAML.idpId)) $ do
   (teamid, idp) <- validateIdPUpdate zusr idpmeta idpid
   liftSem $ GalleyAccess.assertSSOEnabled teamid
-  wrapMonadClientSem $ IdPEffect.storeRawMetadata (idp ^. SAML.idpId) raw
+  liftSem $ IdPEffect.storeRawMetadata (idp ^. SAML.idpId) raw
   -- (if raw metadata is stored and then spar goes out, raw metadata won't match the
   -- structured idp config.  since this will lead to a 5xx response, the client is epected to
   -- try again, which would clean up cassandra state.)
@@ -671,7 +669,7 @@ validateIdPUpdate ::
   m (TeamId, IdP)
 validateIdPUpdate zusr _idpMetadata _idpId = withDebugLog "validateNewIdP" (Just . show . (_2 %~ (^. SAML.idpId))) $ do
   previousIdP <-
-    wrapMonadClientSem (IdPEffect.getConfig _idpId) >>= \case
+    liftSem (IdPEffect.getConfig _idpId) >>= \case
       Nothing -> throwError errUnknownIdPId
       Just idp -> pure idp
   teamId <- liftSem $ authorizeIdP zusr previousIdP
@@ -683,7 +681,7 @@ validateIdPUpdate zusr _idpMetadata _idpId = withDebugLog "validateNewIdP" (Just
     if previousIssuer == newIssuer
       then pure $ previousIdP ^. SAML.idpExtraInfo
       else do
-        foundConfig <- wrapSpar $ getIdPConfigByIssuerAllowOld newIssuer (Just teamId)
+        foundConfig <- getIdPConfigByIssuerAllowOld newIssuer (Just teamId)
         notInUseByOthers <- case foundConfig of
           Data.GetIdPFound c -> pure $ c ^. SAML.idpId == _idpId
           Data.GetIdPNotFound -> pure True
@@ -737,20 +735,20 @@ internalStatus = pure NoContent
 -- get deleted.
 internalDeleteTeam :: Members '[ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => TeamId -> Spar r NoContent
 internalDeleteTeam team = do
-  wrapSpar $ deleteTeam team
+  deleteTeam team
   pure NoContent
 
 internalPutSsoSettings :: Members '[DefaultSsoCode, IdPEffect.IdP] r => SsoSettings -> Spar r NoContent
 internalPutSsoSettings SsoSettings {defaultSsoCode = Nothing} = do
-  wrapMonadClientSem $ DefaultSsoCode.delete
+  liftSem $ DefaultSsoCode.delete
   pure NoContent
 internalPutSsoSettings SsoSettings {defaultSsoCode = Just code} = do
-  wrapMonadClientSem (IdPEffect.getConfig code) >>= \case
+  liftSem (IdPEffect.getConfig code) >>= \case
     Nothing ->
       -- this will return a 404, which is not quite right,
       -- but it's an internal endpoint and the message clearly says
       -- "Could not find IdP".
       throwSpar $ SparIdPNotFound mempty
     Just _ -> do
-      wrapMonadClientSem $ DefaultSsoCode.store code
+      liftSem $ DefaultSsoCode.store code
       pure NoContent
diff --git a/services/spar/src/Spar/App.hs b/services/spar/src/Spar/App.hs
index 7b7bfc9d3b..cb442b8428 100644
--- a/services/spar/src/Spar/App.hs
+++ b/services/spar/src/Spar/App.hs
@@ -24,7 +24,7 @@
 module Spar.App
   ( Spar (..),
     Env (..),
-    wrapMonadClientSem,
+    liftSem,
     verdictHandler,
     GetUserResult (..),
     getUserIdByUref,
@@ -36,8 +36,6 @@ module Spar.App
     getIdPConfigByIssuer,
     getIdPConfigByIssuerAllowOld,
     deleteTeam,
-    wrapSpar,
-    liftSem,
     getIdPConfig,
     storeIdPConfig,
     getIdPConfigByIssuerOptionalSPId,
@@ -53,7 +51,6 @@ import Control.Exception (assert)
 import Control.Lens hiding ((.=))
 import qualified Control.Monad.Catch as Catch
 import Control.Monad.Except
-import Control.Monad.Trans.Except (except)
 import Data.Aeson as Aeson (encode, object, (.=))
 import Data.Aeson.Text as Aeson (encodeToLazyText)
 import qualified Data.ByteString.Builder as Builder
@@ -154,14 +151,14 @@ runSparInSem (Spar action) =
     Right a -> pure a
 
 getIdPConfig :: Member IdPEffect.IdP r => IdPId -> Spar r IdP
-getIdPConfig = (>>= maybe (throwSpar (SparIdPNotFound mempty)) pure) . wrapMonadClientSem . IdPEffect.getConfig
+getIdPConfig = (>>= maybe (throwSpar (SparIdPNotFound mempty)) pure) . liftSem . IdPEffect.getConfig
 
 storeIdPConfig :: Member IdPEffect.IdP r => IdP -> Spar r ()
-storeIdPConfig idp = wrapMonadClientSem $ IdPEffect.storeConfig idp
+storeIdPConfig idp = liftSem $ IdPEffect.storeConfig idp
 
 getIdPConfigByIssuerOptionalSPId :: Member IdPEffect.IdP r => Issuer -> Maybe TeamId -> Spar r IdP
 getIdPConfigByIssuerOptionalSPId issuer mbteam = do
-  wrapSpar (getIdPConfigByIssuerAllowOld issuer mbteam) >>= \case
+  getIdPConfigByIssuerAllowOld issuer mbteam >>= \case
     Data.GetIdPFound idp -> pure idp
     Data.GetIdPNotFound -> throwSpar $ SparIdPNotFound mempty
     res@(Data.GetIdPDanglingId _) -> throwSpar $ SparIdPNotFound (cs $ show res)
@@ -178,21 +175,8 @@ instance Member (Final IO) r => Catch.MonadCatch (Sem r) where
     handler' <- bindS handler
     pure $ m' `Catch.catch` \e -> handler' $ e <$ st
 
--- | Call a 'Sem' command in the 'Spar' monad.  Catch all (IO) exceptions and
--- re-throw them as 500 in Handler.
-wrapMonadClientSem :: Sem r a -> Spar r a
-wrapMonadClientSem action =
-  Spar $
-    lift action
-      `Catch.catch` (throwSpar . SparCassandraError . cs . show @SomeException)
-
-wrapSpar :: Spar r a -> Spar r a
-wrapSpar action = Spar $ do
-  fromSpar $
-    wrapMonadClientSem (runExceptT $ fromSpar action) >>= Spar . except
-
 insertUser :: Member SAMLUserStore r => SAML.UserRef -> UserId -> Spar r ()
-insertUser uref uid = wrapMonadClientSem $ SAMLUserStore.insert uref uid
+insertUser uref uid = liftSem $ SAMLUserStore.insert uref uid
 
 -- | Look up user locally in table @spar.user@ or @spar.scim_user@ (depending on the
 -- argument), then in brig, then return the 'UserId'.  If either lookup fails, or user is not
@@ -216,7 +200,7 @@ getUserIdByUref mbteam uref = userId <$$> getUserByUref mbteam uref
 
 getUserByUref :: Members '[BrigAccess, SAMLUserStore] r => Maybe TeamId -> SAML.UserRef -> Spar r (GetUserResult User)
 getUserByUref mbteam uref = do
-  muid <- wrapMonadClientSem $ SAMLUserStore.get uref
+  muid <- liftSem $ SAMLUserStore.get uref
   case muid of
     Nothing -> pure GetUserNotFound
     Just uid -> do
@@ -244,7 +228,7 @@ instance Functor GetUserResult where
 -- FUTUREWORK: Remove and reinstatate getUser, in AuthID refactoring PR
 getUserIdByScimExternalId :: Members '[BrigAccess, ScimExternalIdStore] r => TeamId -> Email -> Spar r (Maybe UserId)
 getUserIdByScimExternalId tid email = do
-  muid <- wrapMonadClientSem $ (ScimExternalIdStore.lookup tid email)
+  muid <- liftSem $ (ScimExternalIdStore.lookup tid email)
   case muid of
     Nothing -> pure Nothing
     Just uid -> do
@@ -327,7 +311,7 @@ autoprovisionSamlUserWithId mbteam buid suid = do
     guardScimTokens :: IdP -> Spar r ()
     guardScimTokens idp = do
       let teamid = idp ^. idpExtraInfo . wiTeam
-      scimtoks <- wrapMonadClientSem $ ScimTokenStore.getByTeam teamid
+      scimtoks <- liftSem $ ScimTokenStore.getByTeam teamid
       unless (null scimtoks) $ do
         throwSpar SparSamlCredentialsNotFound
 
@@ -358,7 +342,7 @@ bindUser buid userref = do
     let err :: Spar r a
         err = throwSpar . SparBindFromWrongOrNoTeam . cs . show $ buid
     teamid :: TeamId <-
-      wrapSpar (getIdPConfigByIssuerAllowOld (userref ^. uidTenant) Nothing) >>= \case
+      getIdPConfigByIssuerAllowOld (userref ^. uidTenant) Nothing >>= \case
         Data.GetIdPFound idp -> pure $ idp ^. idpExtraInfo . wiTeam
         Data.GetIdPNotFound -> err
         Data.GetIdPDanglingId _ -> err -- database inconsistency
@@ -414,7 +398,7 @@ verdictHandler cky mbteam aresp verdict = do
   -- the InResponseTo attribute MUST match the request's ID.
   liftSem $ Logger.log SAML.Debug $ "entering verdictHandler: " <> show (fromBindCookie <$> cky, aresp, verdict)
   reqid <- either (throwSpar . SparNoRequestRefInResponse . cs) pure $ SAML.rspInResponseTo aresp
-  format :: Maybe VerdictFormat <- wrapMonadClientSem $ AReqIDStore.getVerdictFormat reqid
+  format :: Maybe VerdictFormat <- liftSem $ AReqIDStore.getVerdictFormat reqid
   resp <- case format of
     Just (VerdictFormatWeb) ->
       verdictHandlerResult cky mbteam verdict >>= verdictHandlerWeb
@@ -485,9 +469,9 @@ findUserIdWithOldIssuer mbteam (SAML.UserRef issuer subject) = do
 -- the old IdP is not needed any more next time.
 moveUserToNewIssuer :: Members '[BrigAccess, SAMLUserStore] r => SAML.UserRef -> SAML.UserRef -> UserId -> Spar r ()
 moveUserToNewIssuer oldUserRef newUserRef uid = do
-  wrapMonadClientSem $ SAMLUserStore.insert newUserRef uid
+  liftSem $ SAMLUserStore.insert newUserRef uid
   liftSem $ BrigAccess.setVeid uid (UrefOnly newUserRef)
-  wrapMonadClientSem $ SAMLUserStore.delete uid oldUserRef
+  liftSem $ SAMLUserStore.delete uid oldUserRef
 
 verdictHandlerResultCore ::
   HasCallStack =>
@@ -511,7 +495,7 @@ verdictHandlerResultCore bindCky mbteam = \case
     pure $ VerifyHandlerDenied reasons
   SAML.AccessGranted userref -> do
     uid :: UserId <- do
-      viaBindCookie <- maybe (pure Nothing) (wrapMonadClientSem . BindCookieStore.lookup) bindCky
+      viaBindCookie <- maybe (pure Nothing) (liftSem . BindCookieStore.lookup) bindCky
       viaSparCassandra <- getUserIdByUref mbteam userref
       -- race conditions: if the user has been created on spar, but not on brig, 'getUser'
       -- returns 'Nothing'.  this is ok assuming 'createUser', 'bindUser' (called below) are
diff --git a/services/spar/src/Spar/Scim/Auth.hs b/services/spar/src/Spar/Scim/Auth.hs
index 6b8241f8c4..805e0d8898 100644
--- a/services/spar/src/Spar/Scim/Auth.hs
+++ b/services/spar/src/Spar/Scim/Auth.hs
@@ -49,7 +49,7 @@ import Polysemy.Error
 import Polysemy.Input
 import qualified SAML2.WebSSO as SAML
 import Servant (NoContent (NoContent), ServerT, (:<|>) ((:<|>)))
-import Spar.App (Spar, liftSem, wrapMonadClientSem)
+import Spar.App (Spar, liftSem, liftSem)
 import qualified Spar.Error as E
 import qualified Spar.Intra.BrigApp as Intra.Brig
 import Spar.Sem.BrigAccess (BrigAccess)
@@ -75,7 +75,7 @@ instance Member ScimTokenStore r => Scim.Class.Auth.AuthDB SparTag (Spar r) wher
     Scim.throwScim (Scim.unauthorized "Token not provided")
   authCheck (Just token) =
     maybe (Scim.throwScim (Scim.unauthorized "Invalid token")) pure
-      =<< lift (wrapMonadClientSem (ScimTokenStore.lookup token))
+      =<< lift (liftSem (ScimTokenStore.lookup token))
 
 ----------------------------------------------------------------------------
 -- Token API
@@ -125,11 +125,11 @@ createScimToken zusr CreateScimToken {..} = do
   let descr = createScimTokenDescr
   teamid <- liftSem $ Intra.Brig.authorizeScimTokenManagement zusr
   liftSem $ BrigAccess.ensureReAuthorised zusr createScimTokenPassword
-  tokenNumber <- fmap length $ wrapMonadClientSem $ ScimTokenStore.getByTeam teamid
+  tokenNumber <- fmap length $ liftSem $ ScimTokenStore.getByTeam teamid
   maxTokens <- liftSem $ inputs maxScimTokens
   unless (tokenNumber < maxTokens) $
     E.throwSpar E.SparProvisioningTokenLimitReached
-  idps <- wrapMonadClientSem $ IdPEffect.getConfigsByTeam teamid
+  idps <- liftSem $ IdPEffect.getConfigsByTeam teamid
 
   let caseOneOrNoIdP :: Maybe SAML.IdPId -> Spar r CreateScimTokenResponse
       caseOneOrNoIdP midpid = do
@@ -144,7 +144,7 @@ createScimToken zusr CreateScimToken {..} = do
                   stiIdP = midpid,
                   stiDescr = descr
                 }
-        wrapMonadClientSem $ ScimTokenStore.insert token info
+        liftSem $ ScimTokenStore.insert token info
         pure $ CreateScimTokenResponse token info
 
   case idps of
@@ -169,7 +169,7 @@ deleteScimToken ::
   Spar r NoContent
 deleteScimToken zusr tokenid = do
   teamid <- liftSem $ Intra.Brig.authorizeScimTokenManagement zusr
-  wrapMonadClientSem $ ScimTokenStore.delete teamid tokenid
+  liftSem $ ScimTokenStore.delete teamid tokenid
   pure NoContent
 
 -- | > docs/reference/provisioning/scim-token.md {#RefScimTokenList}
@@ -183,4 +183,4 @@ listScimTokens ::
   Spar r ScimTokenList
 listScimTokens zusr = do
   teamid <- liftSem $ Intra.Brig.authorizeScimTokenManagement zusr
-  ScimTokenList <$> wrapMonadClientSem (ScimTokenStore.getByTeam teamid)
+  ScimTokenList <$> liftSem (ScimTokenStore.getByTeam teamid)
diff --git a/services/spar/src/Spar/Scim/User.hs b/services/spar/src/Spar/Scim/User.hs
index 64cbd0d6e9..535fa4dcb7 100644
--- a/services/spar/src/Spar/Scim/User.hs
+++ b/services/spar/src/Spar/Scim/User.hs
@@ -66,7 +66,7 @@ import Network.URI (URI, parseURI)
 import Polysemy
 import Polysemy.Input
 import qualified SAML2.WebSSO as SAML
-import Spar.App (GetUserResult (..), Spar, getUserIdByScimExternalId, getUserIdByUref, liftSem, validateEmailIfExists, wrapMonadClientSem)
+import Spar.App (GetUserResult (..), Spar, getUserIdByScimExternalId, getUserIdByUref, liftSem, validateEmailIfExists, liftSem)
 import qualified Spar.Intra.BrigApp as Brig
 import Spar.Scim.Auth ()
 import Spar.Scim.Types (normalizeLikeStored)
@@ -141,7 +141,7 @@ instance
           . logFilter filter'
       )
       $ do
-        mIdpConfig <- maybe (pure Nothing) (lift . wrapMonadClientSem . IdPEffect.getConfig) stiIdP
+        mIdpConfig <- maybe (pure Nothing) (lift . liftSem . IdPEffect.getConfig) stiIdP
         case filter' of
           Scim.FilterAttrCompare (Scim.AttrPath schema attrName _subAttr) Scim.OpEq (Scim.ValString val)
             | Scim.isUserSchema schema -> do
@@ -164,7 +164,7 @@ instance
           . logTokenInfo tokeninfo
       )
       $ do
-        mIdpConfig <- maybe (pure Nothing) (lift . wrapMonadClientSem . IdPEffect.getConfig) stiIdP
+        mIdpConfig <- maybe (pure Nothing) (lift . liftSem . IdPEffect.getConfig) stiIdP
         let notfound = Scim.notFound "User" (idToText uid)
         brigUser <- lift (liftSem $ BrigAccess.getAccount Brig.WithPendingInvitations uid) >>= maybe (throwError notfound) pure
         unless (userTeam (accountUser brigUser) == Just stiTeam) (throwError notfound)
@@ -215,7 +215,7 @@ validateScimUser tokinfo user = do
 
 tokenInfoToIdP :: Member IdPEffect.IdP r => ScimTokenInfo -> Scim.ScimHandler (Spar r) (Maybe IdP)
 tokenInfoToIdP ScimTokenInfo {stiIdP} = do
-  maybe (pure Nothing) (lift . wrapMonadClientSem . IdPEffect.getConfig) stiIdP
+  maybe (pure Nothing) (lift . liftSem . IdPEffect.getConfig) stiIdP
 
 -- | Validate a handle (@userName@).
 validateHandle :: MonadError Scim.ScimError m => Text -> m Handle
@@ -468,7 +468,7 @@ createValidScimUser tokeninfo@ScimTokenInfo {stiTeam} vsu@(ST.ValidScimUser veid
       lift $ liftSem $ Logger.debug ("createValidScimUser: spar says " <> show storedUser)
 
       -- {(arianvp): these two actions we probably want to make transactional.}
-      lift . wrapMonadClientSem $ do
+      lift . liftSem $ do
         -- Store scim timestamps, saml credentials, scim externalId locally in spar.
         ScimUserTimesStore.write storedUser
         ST.runValidExternalId
@@ -555,7 +555,7 @@ updateValidScimUser tokinfo@ScimTokenInfo {stiTeam} uid newValidScimUser =
                 let new = ST.scimActiveFlagToAccountStatus old (Just $ newValidScimUser ^. ST.vsuActive)
                 when (new /= old) $ BrigAccess.setStatus uid new
 
-          wrapMonadClientSem $ ScimUserTimesStore.write newScimStoredUser
+          liftSem $ ScimUserTimesStore.write newScimStoredUser
           pure newScimStoredUser
 
 updateVsuUref ::
@@ -577,7 +577,7 @@ updateVsuUref team uid old new = do
     (mo, mn@(Just newuref)) | mo /= mn -> validateEmailIfExists uid newuref
     _ -> pure ()
 
-  wrapMonadClientSem $ do
+  liftSem $ do
     old & ST.runValidExternalId (SAMLUserStore.delete uid) (ScimExternalIdStore.delete team)
     new & ST.runValidExternalId (`SAMLUserStore.insert` uid) (\email -> ScimExternalIdStore.insert team email uid)
 
@@ -671,18 +671,18 @@ deleteScimUser tokeninfo@ScimTokenInfo {stiTeam, stiIdP} uid =
             throwError $
               Scim.notFound "user" (idToText uid)
 
-          mIdpConfig <- maybe (pure Nothing) (lift . wrapMonadClientSem . IdPEffect.getConfig) stiIdP
+          mIdpConfig <- maybe (pure Nothing) (lift . liftSem . IdPEffect.getConfig) stiIdP
 
           case Brig.veidFromBrigUser brigUser ((^. SAML.idpMetadata . SAML.edIssuer) <$> mIdpConfig) of
             Left _ -> pure ()
             Right veid ->
-              lift . wrapMonadClientSem $
+              lift . liftSem $
                 ST.runValidExternalId
                   (SAMLUserStore.delete uid)
                   (ScimExternalIdStore.delete stiTeam)
                   veid
 
-          lift . wrapMonadClientSem $ ScimUserTimesStore.delete uid
+          lift . liftSem $ ScimUserTimesStore.delete uid
           lift . liftSem $ BrigAccess.delete uid
           return ()
 
@@ -798,14 +798,14 @@ synthesizeStoredUser usr veid =
       let readState :: Spar r (RI.RichInfo, Maybe (UTCTimeMillis, UTCTimeMillis), URIBS.URI)
           readState = do
             richInfo <- liftSem $ BrigAccess.getRichInfo uid
-            accessTimes <- wrapMonadClientSem (ScimUserTimesStore.read uid)
+            accessTimes <- liftSem (ScimUserTimesStore.read uid)
             baseuri <- liftSem $ inputs $ derivedOptsScimBaseURI . derivedOpts
             pure (richInfo, accessTimes, baseuri)
 
       let writeState :: Maybe (UTCTimeMillis, UTCTimeMillis) -> ManagedBy -> RI.RichInfo -> Scim.StoredUser ST.SparTag -> Spar r ()
           writeState oldAccessTimes oldManagedBy oldRichInfo storedUser = do
             when (isNothing oldAccessTimes) $ do
-              wrapMonadClientSem $ ScimUserTimesStore.write storedUser
+              liftSem $ ScimUserTimesStore.write storedUser
             when (oldManagedBy /= ManagedByScim) $ do
               liftSem $ BrigAccess.setManagedBy uid ManagedByScim
             let newRichInfo = view ST.sueRichInfo . Scim.extra . Scim.value . Scim.thing $ storedUser
@@ -926,7 +926,7 @@ scimFindUserByEmail mIdpConfig stiTeam email = do
   where
     withUref :: SAML.UserRef -> Spar r (Maybe UserId)
     withUref uref = do
-      wrapMonadClientSem (SAMLUserStore.get uref) >>= \case
+      liftSem (SAMLUserStore.get uref) >>= \case
         Nothing -> maybe (pure Nothing) withEmailOnly $ Brig.urefToEmail uref
         Just uid -> pure (Just uid)
 
@@ -936,7 +936,7 @@ scimFindUserByEmail mIdpConfig stiTeam email = do
         -- FUTUREWORK: we could also always lookup brig, that's simpler and possibly faster,
         -- and it never should be visible in spar, but not in brig.
         inspar, inbrig :: Spar r (Maybe UserId)
-        inspar = wrapMonadClientSem $ ScimExternalIdStore.lookup stiTeam eml
+        inspar = liftSem $ ScimExternalIdStore.lookup stiTeam eml
         inbrig = liftSem $ userId . accountUser <$$> BrigAccess.getByEmail eml
 
 logFilter :: Filter -> (Msg -> Msg)
diff --git a/services/spar/src/Spar/Sem/SAMLUserStore/Cassandra.hs b/services/spar/src/Spar/Sem/SAMLUserStore/Cassandra.hs
index 409c5a4b2f..44acc3ebb7 100644
--- a/services/spar/src/Spar/Sem/SAMLUserStore/Cassandra.hs
+++ b/services/spar/src/Spar/Sem/SAMLUserStore/Cassandra.hs
@@ -2,11 +2,17 @@
 
 module Spar.Sem.SAMLUserStore.Cassandra where
 
+import qualified Control.Monad.Catch as Catch
 import Cassandra
 import Imports
 import Polysemy
 import qualified Spar.Data as Data
 import Spar.Sem.SAMLUserStore
+import Polysemy.Final
+import Spar.Error
+import Polysemy.Error
+import Data.String.Conversions (cs)
+import qualified SAML2.WebSSO.Error as SAML
 
 samlUserStoreToCassandra ::
   forall m r a.
@@ -23,6 +29,15 @@ samlUserStoreToCassandra =
       DeleteByIssuer is -> Data.deleteSAMLUsersByIssuer is
       Delete uid ur -> Data.deleteSAMLUser uid ur
 
-interpretClientToIO :: Member (Final IO) r => ClientState -> Sem (Embed Client ': r) a -> Sem r a
+interpretClientToIO ::
+  Members '[Error SparError, Final IO] r =>
+  ClientState ->
+  Sem (Embed Client ': r) a ->
+  Sem r a
 interpretClientToIO ctx = interpret $ \case
-  Embed action -> embedFinal $ runClient ctx action
+  Embed action -> withStrategicToFinal @IO $ do
+    action' <- liftS $ runClient ctx action
+    st <- getInitialStateS
+    handler' <- bindS $ throw @SparError . SAML.CustomError . SparCassandraError . cs . show @SomeException
+    pure $ action' `Catch.catch` \e -> handler' $ e <$ st
+

From 6d25c73ac60a15c9357e3b07aa823a0c1754a393 Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Fri, 1 Oct 2021 18:20:50 -0700
Subject: [PATCH 02/13] Remove MonadIO instance

---
 services/spar/src/Spar/API.hs                       |  4 ----
 services/spar/src/Spar/App.hs                       | 11 ++---------
 services/spar/src/Spar/Error.hs                     | 10 +++++-----
 services/spar/src/Spar/Scim.hs                      |  9 +++------
 services/spar/src/Spar/Scim/Auth.hs                 | 11 +++++++----
 services/spar/src/Spar/Scim/User.hs                 |  2 +-
 .../spar/src/Spar/Sem/SAMLUserStore/Cassandra.hs    | 13 ++++++-------
 7 files changed, 24 insertions(+), 36 deletions(-)

diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs
index e46ac461a4..f4860f27f6 100644
--- a/services/spar/src/Spar/API.hs
+++ b/services/spar/src/Spar/API.hs
@@ -93,7 +93,6 @@ import Spar.Sem.ScimTokenStore (ScimTokenStore)
 import qualified Spar.Sem.ScimTokenStore as ScimTokenStore
 import Spar.Sem.ScimUserTimesStore (ScimUserTimesStore)
 import System.Logger (Msg)
-import qualified System.Logger as TinyLog
 import qualified URI.ByteString as URI
 import Wire.API.Cookie
 import Wire.API.Routes.Public.Spar
@@ -109,7 +108,6 @@ api ::
   Members
     '[ GalleyAccess,
        BrigAccess,
-       Input TinyLog.Logger,
        Input Opts,
        BindCookieStore,
        AssIDStore,
@@ -145,7 +143,6 @@ apiSSO ::
   Members
     '[ GalleyAccess,
        Logger String,
-       Input TinyLog.Logger,
        Input Opts,
        BrigAccess,
        BindCookieStore,
@@ -306,7 +303,6 @@ authresp ::
     '[ Random,
        Logger String,
        Input Opts,
-       Input TinyLog.Logger,
        GalleyAccess,
        BrigAccess,
        BindCookieStore,
diff --git a/services/spar/src/Spar/App.hs b/services/spar/src/Spar/App.hs
index cb442b8428..44344ea672 100644
--- a/services/spar/src/Spar/App.hs
+++ b/services/spar/src/Spar/App.hs
@@ -65,7 +65,6 @@ import qualified Network.Wai.Utilities.Error as Wai
 import Polysemy
 import Polysemy.Error
 import Polysemy.Final
-import Polysemy.Input (Input, input)
 import SAML2.Util (renderURI)
 import SAML2.WebSSO
   ( IdPId (..),
@@ -131,9 +130,6 @@ instance MonadError SparError (Spar r) where
   throwError err = Spar $ throwError err
   catchError m handler = Spar $ catchError (fromSpar m) $ fromSpar . handler
 
-instance MonadIO (Spar r) where
-  liftIO m = Spar $ lift $ embedFinal m
-
 data Env = Env
   { sparCtxOpts :: Opts,
     sparCtxLogger :: TinyLog.Logger,
@@ -376,7 +372,6 @@ verdictHandler ::
   HasCallStack =>
   Members
     '[ Random,
-       Input TinyLog.Logger,
        Logger String,
        GalleyAccess,
        BrigAccess,
@@ -420,7 +415,6 @@ verdictHandlerResult ::
   HasCallStack =>
   Members
     '[ Random,
-       Input TinyLog.Logger,
        Logger String,
        GalleyAccess,
        BrigAccess,
@@ -440,14 +434,13 @@ verdictHandlerResult bindCky mbteam verdict = do
   liftSem $ Logger.log SAML.Debug $ "leaving verdictHandlerResult" <> show result
   pure result
 
-catchVerdictErrors :: forall r. Member (Input TinyLog.Logger) r => Spar r VerdictHandlerResult -> Spar r VerdictHandlerResult
+catchVerdictErrors :: forall r. Spar r VerdictHandlerResult -> Spar r VerdictHandlerResult
 catchVerdictErrors = (`catchError` hndlr)
   where
     hndlr :: SparError -> Spar r VerdictHandlerResult
     hndlr err = do
-      logr <- liftSem input
       -- TODO(sandy): When we remove this line, we can get rid of the @Input TinyLog.Logger@ effect
-      waiErr <- renderSparErrorWithLogging logr err
+      waiErr <- renderSparErrorWithLogging undefined err
       pure $ case waiErr of
         Right (werr :: Wai.Error) -> VerifyHandlerError (cs $ Wai.label werr) (cs $ Wai.message werr)
         Left (serr :: ServerError) -> VerifyHandlerError "unknown-error" (cs (errReasonPhrase serr) <> " " <> cs (errBody serr))
diff --git a/services/spar/src/Spar/Error.hs b/services/spar/src/Spar/Error.hs
index 1bb2be8d96..c8ff6dd8db 100644
--- a/services/spar/src/Spar/Error.hs
+++ b/services/spar/src/Spar/Error.hs
@@ -111,9 +111,9 @@ data SparCustomError
   deriving (Eq, Show)
 
 sparToServerErrorWithLogging :: MonadIO m => Log.Logger -> SparError -> m ServerError
-sparToServerErrorWithLogging logger err = do
+sparToServerErrorWithLogging _logger err = do
   let errServant = sparToServerError err
-  liftIO $ Wai.logError logger (Nothing :: Maybe Wai.Request) (servantToWaiError errServant)
+  -- liftIO $ Wai.logError logger (Nothing :: Maybe Wai.Request) (servantToWaiError errServant)
   pure errServant
 
 servantToWaiError :: ServerError -> Wai.Error
@@ -132,10 +132,10 @@ waiToServant waierr@(Wai.Error status label _ _) =
       errHeaders = []
     }
 
-renderSparErrorWithLogging :: MonadIO m => Log.Logger -> SparError -> m (Either ServerError Wai.Error)
-renderSparErrorWithLogging logger err = do
+renderSparErrorWithLogging :: Applicative m => Log.Logger -> SparError -> m (Either ServerError Wai.Error)
+renderSparErrorWithLogging _logger err = do
   let errPossiblyWai = renderSparError err
-  liftIO $ Wai.logError logger (Nothing :: Maybe Wai.Request) (either servantToWaiError id $ errPossiblyWai)
+  -- liftIO $ Wai.logError logger (Nothing :: Maybe Wai.Request) (either servantToWaiError id $ errPossiblyWai)
   pure errPossiblyWai
 
 renderSparError :: SparError -> Either ServerError Wai.Error
diff --git a/services/spar/src/Spar/Scim.hs b/services/spar/src/Spar/Scim.hs
index 8f6d0db176..4a4f5a8082 100644
--- a/services/spar/src/Spar/Scim.hs
+++ b/services/spar/src/Spar/Scim.hs
@@ -70,7 +70,7 @@ import Data.String.Conversions (cs)
 import Imports
 import Polysemy
 import Polysemy.Error (Error)
-import Polysemy.Input (Input, input)
+import Polysemy.Input (Input)
 import qualified SAML2.WebSSO as SAML
 import Servant
 import Servant.API.Generic
@@ -95,7 +95,6 @@ import Spar.Sem.ScimExternalIdStore (ScimExternalIdStore)
 import Spar.Sem.ScimTokenStore (ScimTokenStore)
 import Spar.Sem.ScimUserTimesStore (ScimUserTimesStore)
 import System.Logger (Msg)
-import qualified System.Logger as TinyLog
 import qualified Web.Scim.Capabilities.MetaSchema as Scim.Meta
 import qualified Web.Scim.Class.Auth as Scim.Auth
 import qualified Web.Scim.Class.User as Scim.User
@@ -117,8 +116,7 @@ configuration = Scim.Meta.empty
 apiScim ::
   forall r.
   Members
-    '[ Input TinyLog.Logger,
-       Random,
+    '[ Random,
        Input Opts,
        Logger (Msg -> Msg),
        Logger String,
@@ -165,8 +163,7 @@ apiScim =
           Right (Left sparError) -> do
             -- We caught some other Spar exception. It is rendered and wrapped into a scim error
             -- with the same status and message, and no scim error type.
-            logger <- input @TinyLog.Logger
-            err :: ServerError <- embedFinal @IO $ sparToServerErrorWithLogging logger sparError
+            err :: ServerError <- embedFinal @IO $ sparToServerErrorWithLogging undefined sparError
             pure . Left . SAML.CustomError . SparScimError $
               Scim.ScimError
                 { schemas = [Scim.Schema.Error20],
diff --git a/services/spar/src/Spar/Scim/Auth.hs b/services/spar/src/Spar/Scim/Auth.hs
index 805e0d8898..fecf122c98 100644
--- a/services/spar/src/Spar/Scim/Auth.hs
+++ b/services/spar/src/Spar/Scim/Auth.hs
@@ -39,7 +39,6 @@ import Control.Lens hiding (Strict, (.=))
 import qualified Data.ByteString.Base64 as ES
 import Data.Id (ScimTokenId, UserId)
 import Data.String.Conversions (cs)
-import Data.Time (getCurrentTime)
 import Imports
 -- FUTUREWORK: these imports are not very handy.  split up Spar.Scim into
 -- Spar.Scim.{Core,User,Group} to avoid at least some of the hscim name clashes?
@@ -49,13 +48,15 @@ import Polysemy.Error
 import Polysemy.Input
 import qualified SAML2.WebSSO as SAML
 import Servant (NoContent (NoContent), ServerT, (:<|>) ((:<|>)))
-import Spar.App (Spar, liftSem, liftSem)
+import Spar.App (Spar, liftSem)
 import qualified Spar.Error as E
 import qualified Spar.Intra.BrigApp as Intra.Brig
 import Spar.Sem.BrigAccess (BrigAccess)
 import qualified Spar.Sem.BrigAccess as BrigAccess
 import Spar.Sem.GalleyAccess (GalleyAccess)
 import qualified Spar.Sem.IdP as IdPEffect
+import Spar.Sem.Now (Now)
+import qualified Spar.Sem.Now as Now
 import Spar.Sem.Random (Random)
 import qualified Spar.Sem.Random as Random
 import Spar.Sem.ScimTokenStore (ScimTokenStore)
@@ -91,6 +92,7 @@ apiScimToken ::
        GalleyAccess,
        BrigAccess,
        ScimTokenStore,
+       Now,
        IdPEffect.IdP,
        Error E.SparError
      ]
@@ -113,6 +115,7 @@ createScimToken ::
        BrigAccess,
        ScimTokenStore,
        IdPEffect.IdP,
+       Now,
        Error E.SparError
      ]
     r =>
@@ -135,12 +138,12 @@ createScimToken zusr CreateScimToken {..} = do
       caseOneOrNoIdP midpid = do
         token <- liftSem $ ScimToken . cs . ES.encode <$> Random.bytes 32
         tokenid <- liftSem $ Random.scimTokenId
-        now <- liftIO getCurrentTime
+        now <- liftSem Now.get
         let info =
               ScimTokenInfo
                 { stiId = tokenid,
                   stiTeam = teamid,
-                  stiCreatedAt = now,
+                  stiCreatedAt = SAML.fromTime now,
                   stiIdP = midpid,
                   stiDescr = descr
                 }
diff --git a/services/spar/src/Spar/Scim/User.hs b/services/spar/src/Spar/Scim/User.hs
index 535fa4dcb7..6139ce1c56 100644
--- a/services/spar/src/Spar/Scim/User.hs
+++ b/services/spar/src/Spar/Scim/User.hs
@@ -66,7 +66,7 @@ import Network.URI (URI, parseURI)
 import Polysemy
 import Polysemy.Input
 import qualified SAML2.WebSSO as SAML
-import Spar.App (GetUserResult (..), Spar, getUserIdByScimExternalId, getUserIdByUref, liftSem, validateEmailIfExists, liftSem)
+import Spar.App (GetUserResult (..), Spar, getUserIdByScimExternalId, getUserIdByUref, liftSem, validateEmailIfExists)
 import qualified Spar.Intra.BrigApp as Brig
 import Spar.Scim.Auth ()
 import Spar.Scim.Types (normalizeLikeStored)
diff --git a/services/spar/src/Spar/Sem/SAMLUserStore/Cassandra.hs b/services/spar/src/Spar/Sem/SAMLUserStore/Cassandra.hs
index 44acc3ebb7..c2711056ae 100644
--- a/services/spar/src/Spar/Sem/SAMLUserStore/Cassandra.hs
+++ b/services/spar/src/Spar/Sem/SAMLUserStore/Cassandra.hs
@@ -2,17 +2,17 @@
 
 module Spar.Sem.SAMLUserStore.Cassandra where
 
-import qualified Control.Monad.Catch as Catch
 import Cassandra
+import qualified Control.Monad.Catch as Catch
+import Data.String.Conversions (cs)
 import Imports
 import Polysemy
-import qualified Spar.Data as Data
-import Spar.Sem.SAMLUserStore
-import Polysemy.Final
-import Spar.Error
 import Polysemy.Error
-import Data.String.Conversions (cs)
+import Polysemy.Final
 import qualified SAML2.WebSSO.Error as SAML
+import qualified Spar.Data as Data
+import Spar.Error
+import Spar.Sem.SAMLUserStore
 
 samlUserStoreToCassandra ::
   forall m r a.
@@ -40,4 +40,3 @@ interpretClientToIO ctx = interpret $ \case
     st <- getInitialStateS
     handler' <- bindS $ throw @SparError . SAML.CustomError . SparCassandraError . cs . show @SomeException
     pure $ action' `Catch.catch` \e -> handler' $ e <$ st
-

From 17cb0e4cceecbebed3bbb873b35ed93052725c09 Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Fri, 1 Oct 2021 19:05:52 -0700
Subject: [PATCH 03/13] Remove MonadError instance

---
 services/spar/src/Spar/API.hs       |  88 +++++++++++++------
 services/spar/src/Spar/App.hs       | 127 ++++++++++++++++++++--------
 services/spar/src/Spar/Scim.hs      |   5 +-
 services/spar/src/Spar/Scim/Auth.hs |   6 +-
 4 files changed, 158 insertions(+), 68 deletions(-)

diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs
index f4860f27f6..661b66f7ee 100644
--- a/services/spar/src/Spar/API.hs
+++ b/services/spar/src/Spar/API.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# OPTIONS_GHC -fplugin=Polysemy.Plugin #-}
 
 -- This file is part of the Wire Server implementation.
 --
@@ -197,6 +198,7 @@ apiINTERNAL ::
     '[ ScimTokenStore,
        DefaultSsoCode,
        IdPEffect.IdP,
+       Error SparError,
        SAMLUserStore
      ]
     r =>
@@ -212,7 +214,16 @@ appName = "spar"
 ----------------------------------------------------------------------------
 -- SSO API
 
-authreqPrecheck :: Member IdPEffect.IdP r => Maybe URI.URI -> Maybe URI.URI -> SAML.IdPId -> Spar r NoContent
+authreqPrecheck ::
+  Members
+    '[ IdPEffect.IdP,
+       Error SparError
+     ]
+    r =>
+  Maybe URI.URI ->
+  Maybe URI.URI ->
+  SAML.IdPId ->
+  Spar r NoContent
 authreqPrecheck msucc merr idpid =
   validateAuthreqParams msucc merr
     *> getIdPConfig idpid
@@ -228,6 +239,7 @@ authreq ::
        AReqIDStore,
        SAML2,
        SamlProtocolSettings,
+       Error SparError,
        IdPEffect.IdP
      ]
     r =>
@@ -238,12 +250,12 @@ authreq ::
   Maybe URI.URI ->
   SAML.IdPId ->
   Spar r (WithSetBindCookie (SAML.FormRedirect SAML.AuthnRequest))
-authreq _ DoInitiateLogin (Just _) _ _ _ = throwSpar SparInitLoginWithAuth
-authreq _ DoInitiateBind Nothing _ _ _ = throwSpar SparInitBindWithoutAuth
+authreq _ DoInitiateLogin (Just _) _ _ _ = throwSparSem SparInitLoginWithAuth
+authreq _ DoInitiateBind Nothing _ _ _ = throwSparSem SparInitBindWithoutAuth
 authreq authreqttl _ zusr msucc merr idpid = do
   vformat <- validateAuthreqParams msucc merr
   form@(SAML.FormRedirect _ ((^. SAML.rqID) -> reqid)) <- do
-    idp :: IdP <- liftSem (IdPEffect.getConfig idpid) >>= maybe (throwSpar (SparIdPNotFound (cs $ show idpid))) pure
+    idp :: IdP <- liftSem (IdPEffect.getConfig idpid) >>= maybe (throwSparSem (SparIdPNotFound (cs $ show idpid))) pure
     let mbtid :: Maybe TeamId
         mbtid = case fromMaybe defWireIdPAPIVersion (idp ^. SAML.idpExtraInfo . wiApiVersion) of
           WireIdPAPIV1 -> Nothing
@@ -282,20 +294,20 @@ initializeBindCookie zusr authreqttl = do
 redirectURLMaxLength :: Int
 redirectURLMaxLength = 140
 
-validateAuthreqParams :: Maybe URI.URI -> Maybe URI.URI -> Spar r VerdictFormat
+validateAuthreqParams :: Member (Error SparError) r => Maybe URI.URI -> Maybe URI.URI -> Spar r VerdictFormat
 validateAuthreqParams msucc merr = case (msucc, merr) of
   (Nothing, Nothing) -> pure VerdictFormatWeb
   (Just ok, Just err) -> do
     validateRedirectURL `mapM_` [ok, err]
     pure $ VerdictFormatMobile ok err
-  _ -> throwSpar $ SparBadInitiateLoginQueryParams "need-both-redirect-urls"
+  _ -> throwSparSem $ SparBadInitiateLoginQueryParams "need-both-redirect-urls"
 
-validateRedirectURL :: URI.URI -> Spar r ()
+validateRedirectURL :: Member (Error SparError) r => URI.URI -> Spar r ()
 validateRedirectURL uri = do
   unless ((SBS.take 4 . URI.schemeBS . URI.uriScheme $ uri) == "wire") $ do
-    throwSpar $ SparBadInitiateLoginQueryParams "invalid-schema"
+    throwSparSem $ SparBadInitiateLoginQueryParams "invalid-schema"
   unless ((SBS.length $ URI.serializeURIRef' uri) <= redirectURLMaxLength) $ do
-    throwSpar $ SparBadInitiateLoginQueryParams "url-too-long"
+    throwSparSem $ SparBadInitiateLoginQueryParams "url-too-long"
 
 authresp ::
   forall r.
@@ -377,7 +389,7 @@ idpGetRaw zusr idpid = do
   _ <- liftSem $ authorizeIdP zusr idp
   liftSem (IdPEffect.getRawMetadata idpid) >>= \case
     Just txt -> pure $ RawIdPMetadata txt
-    Nothing -> throwSpar $ SparIdPNotFound (cs $ show idpid)
+    Nothing -> throwSparSem $ SparIdPNotFound (cs $ show idpid)
 
 idpGetAll ::
   Members
@@ -438,7 +450,7 @@ idpDelete zusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (cons
   when (not idpIsEmpty) $ do
     if purge
       then doPurge
-      else throwSpar SparIdPHasBoundUsers
+      else throwSparSem SparIdPHasBoundUsers
   updateOldIssuers idp
   updateReplacingIdP idp
   -- Delete tokens associated with given IdP (we rely on the fact that
@@ -524,12 +536,20 @@ idpCreateXML zusr raw idpmeta mReplaces (fromMaybe defWireIdPAPIVersion -> apive
 -- data contains no information about the idp issuer, only the user name, so no valid saml
 -- credentials can be created.  To fix this, we need to implement a way to associate scim
 -- tokens with IdPs.  https://wearezeta.atlassian.net/browse/SQSERVICES-165
-assertNoScimOrNoIdP :: Members '[ScimTokenStore, IdPEffect.IdP] r => TeamId -> Spar r ()
+assertNoScimOrNoIdP ::
+  Members
+    '[ ScimTokenStore,
+       Error SparError,
+       IdPEffect.IdP
+     ]
+    r =>
+  TeamId ->
+  Spar r ()
 assertNoScimOrNoIdP teamid = do
   numTokens <- length <$> liftSem (ScimTokenStore.getByTeam teamid)
   numIdps <- length <$> liftSem (IdPEffect.getConfigsByTeam teamid)
   when (numTokens > 0 && numIdps > 0) $ do
-    throwSpar $
+    throwSparSem $
       SparProvisioningMoreThanOneIdP
         "Teams with SCIM tokens can only have at most one IdP"
 
@@ -556,7 +576,13 @@ assertNoScimOrNoIdP teamid = do
 validateNewIdP ::
   forall m r.
   (HasCallStack, m ~ Spar r) =>
-  Members '[Random, Logger String, IdPEffect.IdP] r =>
+  Members
+    '[ Random,
+       Logger String,
+       IdPEffect.IdP,
+       Error SparError
+     ]
+    r =>
   WireIdPAPIVersion ->
   SAML.IdPMetadata ->
   TeamId ->
@@ -567,7 +593,7 @@ validateNewIdP apiversion _idpMetadata teamId mReplaces = withDebugLog "validate
   oldIssuers :: [SAML.Issuer] <- case mReplaces of
     Nothing -> pure []
     Just replaces -> do
-      idp <- liftSem (IdPEffect.getConfig replaces) >>= maybe (throwSpar (SparIdPNotFound (cs $ show mReplaces))) pure
+      idp <- liftSem (IdPEffect.getConfig replaces) >>= maybe (throwSparSem (SparIdPNotFound (cs $ show mReplaces))) pure
       pure $ (idp ^. SAML.idpMetadata . SAML.edIssuer) : (idp ^. SAML.idpExtraInfo . wiOldIssuers)
   let requri = _idpMetadata ^. SAML.edRequestURI
       _idpExtraInfo = WireIdP teamId (Just apiversion) oldIssuers Nothing
@@ -581,11 +607,11 @@ validateNewIdP apiversion _idpMetadata teamId mReplaces = withDebugLog "validate
       -- we're not using any properties of the arguments in this function.)
       handleIdPClash = case apiversion of
         WireIdPAPIV1 -> const $ do
-          throwSpar $ SparNewIdPAlreadyInUse "you can't create an IdP with api_version v1 if the issuer is already in use on the wire instance."
+          throwSparSem $ SparNewIdPAlreadyInUse "you can't create an IdP with api_version v1 if the issuer is already in use on the wire instance."
         WireIdPAPIV2 -> \case
           (Right _) -> do
             -- idp' was found by lookup with teamid, so it's in the same team.
-            throwSpar $ SparNewIdPAlreadyInUse "if the exisitng IdP is registered for a team, the new one can't have it."
+            throwSparSem $ SparNewIdPAlreadyInUse "if the exisitng IdP is registered for a team, the new one can't have it."
           (Left _) -> do
             -- this idp *id* is from a different team, and we're in the 'WireIdPAPIV2' case, so this is fine.
             pure ()
@@ -593,7 +619,7 @@ validateNewIdP apiversion _idpMetadata teamId mReplaces = withDebugLog "validate
   case idp of
     Data.GetIdPFound idp' {- same team -} -> handleIdPClash (Right idp')
     Data.GetIdPNotFound -> pure ()
-    res@(Data.GetIdPDanglingId _) -> throwSpar . SparIdPNotFound . ("validateNewIdP: " <>) . cs . show $ res -- database inconsistency
+    res@(Data.GetIdPDanglingId _) -> throwSparSem . SparIdPNotFound . ("validateNewIdP: " <>) . cs . show $ res -- database inconsistency
     Data.GetIdPNonUnique ids' {- same team didn't yield anything, but there are at least two other teams with this issuer already -} -> handleIdPClash (Left ids')
     Data.GetIdPWrongTeam id' {- different team -} -> handleIdPClash (Left id')
 
@@ -666,11 +692,11 @@ validateIdPUpdate ::
 validateIdPUpdate zusr _idpMetadata _idpId = withDebugLog "validateNewIdP" (Just . show . (_2 %~ (^. SAML.idpId))) $ do
   previousIdP <-
     liftSem (IdPEffect.getConfig _idpId) >>= \case
-      Nothing -> throwError errUnknownIdPId
+      Nothing -> liftSem $ throw errUnknownIdPId
       Just idp -> pure idp
   teamId <- liftSem $ authorizeIdP zusr previousIdP
   unless (previousIdP ^. SAML.idpExtraInfo . wiTeam == teamId) $ do
-    throwError errUnknownIdP
+    liftSem $ throw errUnknownIdP
   _idpExtraInfo <- do
     let previousIssuer = previousIdP ^. SAML.idpMetadata . SAML.edIssuer
         newIssuer = _idpMetadata ^. SAML.edIssuer
@@ -681,12 +707,12 @@ validateIdPUpdate zusr _idpMetadata _idpId = withDebugLog "validateNewIdP" (Just
         notInUseByOthers <- case foundConfig of
           Data.GetIdPFound c -> pure $ c ^. SAML.idpId == _idpId
           Data.GetIdPNotFound -> pure True
-          res@(Data.GetIdPDanglingId _) -> throwSpar . SparIdPNotFound . ("validateIdPUpdate: " <>) . cs . show $ res -- impossible
-          res@(Data.GetIdPNonUnique _) -> throwSpar . SparIdPNotFound . ("validateIdPUpdate: " <>) . cs . show $ res -- impossible (because team id was used in lookup)
+          res@(Data.GetIdPDanglingId _) -> throwSparSem . SparIdPNotFound . ("validateIdPUpdate: " <>) . cs . show $ res -- impossible
+          res@(Data.GetIdPNonUnique _) -> throwSparSem . SparIdPNotFound . ("validateIdPUpdate: " <>) . cs . show $ res -- impossible (because team id was used in lookup)
           Data.GetIdPWrongTeam _ -> pure False
         if notInUseByOthers
           then pure $ (previousIdP ^. SAML.idpExtraInfo) & wiOldIssuers %~ nub . (previousIssuer :)
-          else throwSpar SparIdPIssuerInUse
+          else throwSparSem SparIdPIssuerInUse
   let requri = _idpMetadata ^. SAML.edRequestURI
   enforceHttps requri
   pure (teamId, SAML.IdPConfig {..})
@@ -716,10 +742,10 @@ authorizeIdP (Just zusr) idp = do
   GalleyAccess.assertHasPermission teamid CreateUpdateDeleteIdp zusr
   pure teamid
 
-enforceHttps :: URI.URI -> Spar r ()
+enforceHttps :: Member (Error SparError) r => URI.URI -> Spar r ()
 enforceHttps uri = do
   unless ((uri ^. URI.uriSchemeL . URI.schemeBSL) == "https") $ do
-    throwSpar . SparNewIdPWantHttps . cs . SAML.renderURI $ uri
+    throwSparSem . SparNewIdPWantHttps . cs . SAML.renderURI $ uri
 
 ----------------------------------------------------------------------------
 -- Internal API
@@ -734,7 +760,15 @@ internalDeleteTeam team = do
   deleteTeam team
   pure NoContent
 
-internalPutSsoSettings :: Members '[DefaultSsoCode, IdPEffect.IdP] r => SsoSettings -> Spar r NoContent
+internalPutSsoSettings ::
+  Members
+    '[ DefaultSsoCode,
+       Error SparError,
+       IdPEffect.IdP
+     ]
+    r =>
+  SsoSettings ->
+  Spar r NoContent
 internalPutSsoSettings SsoSettings {defaultSsoCode = Nothing} = do
   liftSem $ DefaultSsoCode.delete
   pure NoContent
@@ -744,7 +778,7 @@ internalPutSsoSettings SsoSettings {defaultSsoCode = Just code} = do
       -- this will return a 404, which is not quite right,
       -- but it's an internal endpoint and the message clearly says
       -- "Could not find IdP".
-      throwSpar $ SparIdPNotFound mempty
+      throwSparSem $ SparIdPNotFound mempty
     Just _ -> do
       liftSem $ DefaultSsoCode.store code
       pure NoContent
diff --git a/services/spar/src/Spar/App.hs b/services/spar/src/Spar/App.hs
index 44344ea672..b2298f4adf 100644
--- a/services/spar/src/Spar/App.hs
+++ b/services/spar/src/Spar/App.hs
@@ -25,6 +25,7 @@ module Spar.App
   ( Spar (..),
     Env (..),
     liftSem,
+    throwSparSem,
     verdictHandler,
     GetUserResult (..),
     getUserIdByUref,
@@ -118,6 +119,9 @@ newtype Spar r a = Spar {fromSpar :: Member (Final IO) r => ExceptT SparError (S
 liftSem :: Sem r a -> Spar r a
 liftSem r = Spar $ lift r
 
+throwSparSem :: Member (Error SparError) r => SparCustomError -> Spar r a
+throwSparSem = liftSem . throw . SAML.CustomError
+
 instance Applicative (Spar r) where
   pure a = Spar $ pure a
   liftA2 f a b = Spar $ liftA2 f (fromSpar a) (fromSpar b)
@@ -126,10 +130,6 @@ instance Monad (Spar r) where
   return = pure
   f >>= a = Spar $ fromSpar f >>= fromSpar . a
 
-instance MonadError SparError (Spar r) where
-  throwError err = Spar $ throwError err
-  catchError m handler = Spar $ catchError (fromSpar m) $ fromSpar . handler
-
 data Env = Env
   { sparCtxOpts :: Opts,
     sparCtxLogger :: TinyLog.Logger,
@@ -146,20 +146,27 @@ runSparInSem (Spar action) =
     Left err -> throw err
     Right a -> pure a
 
-getIdPConfig :: Member IdPEffect.IdP r => IdPId -> Spar r IdP
-getIdPConfig = (>>= maybe (throwSpar (SparIdPNotFound mempty)) pure) . liftSem . IdPEffect.getConfig
+getIdPConfig ::
+  Members
+    '[ IdPEffect.IdP,
+       Error SparError
+     ]
+    r =>
+  IdPId ->
+  Spar r IdP
+getIdPConfig = (>>= maybe (throwSparSem (SparIdPNotFound mempty)) pure) . liftSem . IdPEffect.getConfig
 
 storeIdPConfig :: Member IdPEffect.IdP r => IdP -> Spar r ()
 storeIdPConfig idp = liftSem $ IdPEffect.storeConfig idp
 
-getIdPConfigByIssuerOptionalSPId :: Member IdPEffect.IdP r => Issuer -> Maybe TeamId -> Spar r IdP
+getIdPConfigByIssuerOptionalSPId :: Members '[IdPEffect.IdP, Error SparError] r => Issuer -> Maybe TeamId -> Spar r IdP
 getIdPConfigByIssuerOptionalSPId issuer mbteam = do
   getIdPConfigByIssuerAllowOld issuer mbteam >>= \case
     Data.GetIdPFound idp -> pure idp
-    Data.GetIdPNotFound -> throwSpar $ SparIdPNotFound mempty
-    res@(Data.GetIdPDanglingId _) -> throwSpar $ SparIdPNotFound (cs $ show res)
-    res@(Data.GetIdPNonUnique _) -> throwSpar $ SparIdPNotFound (cs $ show res)
-    res@(Data.GetIdPWrongTeam _) -> throwSpar $ SparIdPNotFound (cs $ show res)
+    Data.GetIdPNotFound -> throwSparSem $ SparIdPNotFound mempty
+    res@(Data.GetIdPDanglingId _) -> throwSparSem $ SparIdPNotFound (cs $ show res)
+    res@(Data.GetIdPNonUnique _) -> throwSparSem $ SparIdPNotFound (cs $ show res)
+    res@(Data.GetIdPWrongTeam _) -> throwSparSem $ SparIdPNotFound (cs $ show res)
 
 instance Member (Final IO) r => Catch.MonadThrow (Sem r) where
   throwM = embedFinal . Catch.throwM @IO
@@ -248,9 +255,19 @@ getUserIdByScimExternalId tid email = do
 -- FUTUREWORK: once we support <https://github.com/wireapp/hscim scim>, brig will refuse to delete
 -- users that have an sso id, unless the request comes from spar.  then we can make users
 -- undeletable in the team admin page, and ask admins to go talk to their IdP system.
-createSamlUserWithId :: Members '[BrigAccess, SAMLUserStore] r => TeamId -> UserId -> SAML.UserRef -> Spar r ()
+createSamlUserWithId ::
+  Members
+    '[ Error SparError,
+       BrigAccess,
+       SAMLUserStore
+     ]
+    r =>
+  TeamId ->
+  UserId ->
+  SAML.UserRef ->
+  Spar r ()
 createSamlUserWithId teamid buid suid = do
-  uname <- either (throwSpar . SparBadUserName . cs) pure $ Intra.mkUserName Nothing (UrefOnly suid)
+  uname <- either (throwSparSem . SparBadUserName . cs) pure $ Intra.mkUserName Nothing (UrefOnly suid)
   buid' <- liftSem $ BrigAccess.createSAML suid buid teamid uname ManagedByWire
   assert (buid == buid') $ pure ()
   insertUser suid buid
@@ -264,6 +281,7 @@ autoprovisionSamlUser ::
        BrigAccess,
        ScimTokenStore,
        IdPEffect.IdP,
+       Error SparError,
        SAMLUserStore
      ]
     r =>
@@ -283,6 +301,7 @@ autoprovisionSamlUserWithId ::
        BrigAccess,
        ScimTokenStore,
        IdPEffect.IdP,
+       Error SparError,
        SAMLUserStore
      ]
     r =>
@@ -301,7 +320,7 @@ autoprovisionSamlUserWithId mbteam buid suid = do
     guardReplacedIdP :: IdP -> Spar r ()
     guardReplacedIdP idp = do
       unless (isNothing $ idp ^. idpExtraInfo . wiReplacedBy) $ do
-        throwSpar $ SparCannotCreateUsersOnReplacedIdP (cs . SAML.idPIdToST $ idp ^. idpId)
+        throwSparSem $ SparCannotCreateUsersOnReplacedIdP (cs . SAML.idPIdToST $ idp ^. idpId)
 
     -- IdPs in teams with scim tokens are not allowed to auto-provision.
     guardScimTokens :: IdP -> Spar r ()
@@ -309,7 +328,7 @@ autoprovisionSamlUserWithId mbteam buid suid = do
       let teamid = idp ^. idpExtraInfo . wiTeam
       scimtoks <- liftSem $ ScimTokenStore.getByTeam teamid
       unless (null scimtoks) $ do
-        throwSpar SparSamlCredentialsNotFound
+        throwSparSem SparSamlCredentialsNotFound
 
 -- | If user's 'NameID' is an email address and the team has email validation for SSO enabled,
 -- make brig initiate the email validate procedure.
@@ -332,17 +351,28 @@ validateEmailIfExists uid = \case
 --
 -- Before returning, change account status or fail if account is nto active or pending an
 -- invitation.
-bindUser :: Members '[BrigAccess, IdPEffect.IdP, SAMLUserStore] r => UserId -> SAML.UserRef -> Spar r UserId
+bindUser ::
+  forall r.
+  Members
+    '[ BrigAccess,
+       IdPEffect.IdP,
+       Error SparError,
+       SAMLUserStore
+     ]
+    r =>
+  UserId ->
+  SAML.UserRef ->
+  Spar r UserId
 bindUser buid userref = do
   oldStatus <- do
     let err :: Spar r a
-        err = throwSpar . SparBindFromWrongOrNoTeam . cs . show $ buid
+        err = throwSparSem . SparBindFromWrongOrNoTeam . cs . show $ buid
     teamid :: TeamId <-
       getIdPConfigByIssuerAllowOld (userref ^. uidTenant) Nothing >>= \case
         Data.GetIdPFound idp -> pure $ idp ^. idpExtraInfo . wiTeam
         Data.GetIdPNotFound -> err
         Data.GetIdPDanglingId _ -> err -- database inconsistency
-        Data.GetIdPNonUnique is -> throwSpar $ SparUserRefInNoOrMultipleTeams (cs $ show (buid, is))
+        Data.GetIdPNonUnique is -> throwSparSem $ SparUserRefInNoOrMultipleTeams (cs $ show (buid, is))
         Data.GetIdPWrongTeam _ -> err -- impossible
     acc <- liftSem (BrigAccess.getAccount Intra.WithPendingInvitations buid) >>= maybe err pure
     teamid' :: TeamId <- userTeam (accountUser acc) & maybe err pure
@@ -351,7 +381,7 @@ bindUser buid userref = do
   insertUser userref buid
   buid <$ do
     liftSem $ BrigAccess.setVeid buid (UrefOnly userref)
-    let err = throwSpar . SparBindFromBadAccountStatus . cs . show
+    let err = throwSparSem . SparBindFromBadAccountStatus . cs . show
     case oldStatus of
       Active -> pure ()
       Suspended -> err oldStatus
@@ -379,6 +409,9 @@ verdictHandler ::
        AReqIDStore,
        ScimTokenStore,
        IdPEffect.IdP,
+       Error SparError,
+       -- TODO(sandy): Remove Final IO when removing runSparInSem
+       Final IO,
        SAMLUserStore
      ]
     r =>
@@ -392,7 +425,7 @@ verdictHandler cky mbteam aresp verdict = do
   -- <SubjectConfirmation> [...] If the containing message is in response to an <AuthnRequest>, then
   -- the InResponseTo attribute MUST match the request's ID.
   liftSem $ Logger.log SAML.Debug $ "entering verdictHandler: " <> show (fromBindCookie <$> cky, aresp, verdict)
-  reqid <- either (throwSpar . SparNoRequestRefInResponse . cs) pure $ SAML.rspInResponseTo aresp
+  reqid <- either (throwSparSem . SparNoRequestRefInResponse . cs) pure $ SAML.rspInResponseTo aresp
   format :: Maybe VerdictFormat <- liftSem $ AReqIDStore.getVerdictFormat reqid
   resp <- case format of
     Just (VerdictFormatWeb) ->
@@ -401,7 +434,7 @@ verdictHandler cky mbteam aresp verdict = do
       verdictHandlerResult cky mbteam verdict >>= verdictHandlerMobile granted denied
     Nothing ->
       -- (this shouldn't happen too often, see 'storeVerdictFormat')
-      throwSpar SparNoSuchRequest
+      throwSparSem SparNoSuchRequest
   liftSem $ Logger.log SAML.Debug $ "leaving verdictHandler: " <> show resp
   pure resp
 
@@ -421,6 +454,9 @@ verdictHandlerResult ::
        BindCookieStore,
        ScimTokenStore,
        IdPEffect.IdP,
+       Error SparError,
+       -- TODO(sandy): Remove Final IO when removing runSparInSem
+       Final IO,
        SAMLUserStore
      ]
     r =>
@@ -434,10 +470,19 @@ verdictHandlerResult bindCky mbteam verdict = do
   liftSem $ Logger.log SAML.Debug $ "leaving verdictHandlerResult" <> show result
   pure result
 
-catchVerdictErrors :: forall r. Spar r VerdictHandlerResult -> Spar r VerdictHandlerResult
-catchVerdictErrors = (`catchError` hndlr)
+catchVerdictErrors ::
+  forall r.
+  Members
+    '[ Error SparError,
+       -- TODO(sandy): Remove Final IO when removing runSparInSem
+       Final IO
+     ]
+    r =>
+  Spar r VerdictHandlerResult ->
+  Spar r VerdictHandlerResult
+catchVerdictErrors = liftSem . (`catch` hndlr) . runSparInSem
   where
-    hndlr :: SparError -> Spar r VerdictHandlerResult
+    hndlr :: SparError -> Sem r VerdictHandlerResult
     hndlr err = do
       -- TODO(sandy): When we remove this line, we can get rid of the @Input TinyLog.Logger@ effect
       waiErr <- renderSparErrorWithLogging undefined err
@@ -448,7 +493,18 @@ catchVerdictErrors = (`catchError` hndlr)
 -- | If a user attempts to login presenting a new IdP issuer, but there is no entry in
 -- @"spar.user"@ for her: lookup @"old_issuers"@ from @"spar.idp"@ for the new IdP, and
 -- traverse the old IdPs in search for the old entry.  Return that old entry.
-findUserIdWithOldIssuer :: forall r. Members '[BrigAccess, IdPEffect.IdP, SAMLUserStore] r => Maybe TeamId -> SAML.UserRef -> Spar r (GetUserResult (SAML.UserRef, UserId))
+findUserIdWithOldIssuer ::
+  forall r.
+  Members
+    '[ BrigAccess,
+       IdPEffect.IdP,
+       SAMLUserStore,
+       Error SparError
+     ]
+    r =>
+  Maybe TeamId ->
+  SAML.UserRef ->
+  Spar r (GetUserResult (SAML.UserRef, UserId))
 findUserIdWithOldIssuer mbteam (SAML.UserRef issuer subject) = do
   idp <- getIdPConfigByIssuerOptionalSPId issuer mbteam
   let tryFind :: GetUserResult (SAML.UserRef, UserId) -> Issuer -> Spar r (GetUserResult (SAML.UserRef, UserId))
@@ -476,6 +532,7 @@ verdictHandlerResultCore ::
        BindCookieStore,
        ScimTokenStore,
        IdPEffect.IdP,
+       Error SparError,
        SAMLUserStore
      ]
     r =>
@@ -501,10 +558,10 @@ verdictHandlerResultCore bindCky mbteam = \case
             SparUserRefInNoOrMultipleTeams . cs $
               show (userref, viaBindCookie, viaSparCassandra, viaSparCassandraOldIssuer)
       case (viaBindCookie, viaSparCassandra, viaSparCassandraOldIssuer) of
-        (_, GetUserNoTeam, _) -> throwSpar err
-        (_, GetUserWrongTeam, _) -> throwSpar err
-        (_, _, GetUserNoTeam) -> throwSpar err
-        (_, _, GetUserWrongTeam) -> throwSpar err
+        (_, GetUserNoTeam, _) -> throwSparSem err
+        (_, GetUserWrongTeam, _) -> throwSparSem err
+        (_, _, GetUserNoTeam) -> throwSparSem err
+        (_, _, GetUserWrongTeam) -> throwSparSem err
         -- This is the first SSO authentication, so we auto-create a user. We know the user
         -- has not been created via SCIM because then we would've ended up in the
         -- "reauthentication" branch.
@@ -519,11 +576,11 @@ verdictHandlerResultCore bindCky mbteam = \case
           -- Redundant binding (no change to Brig or Spar)
           | uid == uid' -> pure uid
           -- Attempt to use ssoid for a second Wire user
-          | otherwise -> throwSpar SparBindUserRefTaken
+          | otherwise -> throwSparSem SparBindUserRefTaken
         -- same two cases as above, but between last login and bind there was an issuer update.
         (Just uid, GetUserNotFound, GetUserFound (oldUserRef, uid'))
           | uid == uid' -> moveUserToNewIssuer oldUserRef userref uid >> pure uid
-          | otherwise -> throwSpar SparBindUserRefTaken
+          | otherwise -> throwSparSem SparBindUserRefTaken
         (Just _, GetUserFound _, GetUserFound _) ->
           -- to see why, consider the condition on the call to 'findUserWithOldIssuer' above.
           error "impossible."
@@ -609,22 +666,22 @@ easyHtml doc =
 -- | If the client is mobile, it has picked error and success redirect urls (see
 -- 'mkVerdictGrantedFormatMobile', 'mkVerdictDeniedFormatMobile'); variables in these URLs are here
 -- substituted and the client is redirected accordingly.
-verdictHandlerMobile :: HasCallStack => URI.URI -> URI.URI -> VerdictHandlerResult -> Spar r SAML.ResponseVerdict
+verdictHandlerMobile :: (HasCallStack, Member (Error SparError) r) => URI.URI -> URI.URI -> VerdictHandlerResult -> Spar r SAML.ResponseVerdict
 verdictHandlerMobile granted denied = \case
   VerifyHandlerGranted cky uid ->
     mkVerdictGrantedFormatMobile granted cky uid
       & either
-        (throwSpar . SparCouldNotSubstituteSuccessURI . cs)
+        (throwSparSem . SparCouldNotSubstituteSuccessURI . cs)
         (pure . successPage cky)
   VerifyHandlerDenied reasons ->
     mkVerdictDeniedFormatMobile denied "forbidden"
       & either
-        (throwSpar . SparCouldNotSubstituteFailureURI . cs)
+        (throwSparSem . SparCouldNotSubstituteFailureURI . cs)
         (pure . forbiddenPage "forbidden" (explainDeniedReason <$> reasons))
   VerifyHandlerError lbl msg ->
     mkVerdictDeniedFormatMobile denied lbl
       & either
-        (throwSpar . SparCouldNotSubstituteFailureURI . cs)
+        (throwSparSem . SparCouldNotSubstituteFailureURI . cs)
         (pure . forbiddenPage lbl [msg])
   where
     forbiddenPage :: ST -> [ST] -> URI.URI -> SAML.ResponseVerdict
diff --git a/services/spar/src/Spar/Scim.hs b/services/spar/src/Spar/Scim.hs
index 4a4f5a8082..ccdaee6500 100644
--- a/services/spar/src/Spar/Scim.hs
+++ b/services/spar/src/Spar/Scim.hs
@@ -75,12 +75,11 @@ import qualified SAML2.WebSSO as SAML
 import Servant
 import Servant.API.Generic
 import Servant.Server.Generic (AsServerT)
-import Spar.App (Spar (..))
+import Spar.App (Spar (..), throwSparSem)
 import Spar.Error
   ( SparCustomError (SparScimError),
     SparError,
     sparToServerErrorWithLogging,
-    throwSpar,
   )
 import Spar.Scim.Auth
 import Spar.Scim.User
@@ -139,7 +138,7 @@ apiScim =
     hoistScim =
       hoistServer
         (Proxy @(ScimSiteAPI SparTag))
-        (wrapScimErrors . Scim.fromScimHandler (throwSpar . SparScimError))
+        (wrapScimErrors . Scim.fromScimHandler (throwSparSem . SparScimError))
     -- Wrap /all/ errors into the format required by SCIM, even server exceptions that have
     -- nothing to do with SCIM.
     --
diff --git a/services/spar/src/Spar/Scim/Auth.hs b/services/spar/src/Spar/Scim/Auth.hs
index fecf122c98..bf77601d53 100644
--- a/services/spar/src/Spar/Scim/Auth.hs
+++ b/services/spar/src/Spar/Scim/Auth.hs
@@ -48,7 +48,7 @@ import Polysemy.Error
 import Polysemy.Input
 import qualified SAML2.WebSSO as SAML
 import Servant (NoContent (NoContent), ServerT, (:<|>) ((:<|>)))
-import Spar.App (Spar, liftSem)
+import Spar.App (Spar, liftSem, throwSparSem)
 import qualified Spar.Error as E
 import qualified Spar.Intra.BrigApp as Intra.Brig
 import Spar.Sem.BrigAccess (BrigAccess)
@@ -131,7 +131,7 @@ createScimToken zusr CreateScimToken {..} = do
   tokenNumber <- fmap length $ liftSem $ ScimTokenStore.getByTeam teamid
   maxTokens <- liftSem $ inputs maxScimTokens
   unless (tokenNumber < maxTokens) $
-    E.throwSpar E.SparProvisioningTokenLimitReached
+    throwSparSem E.SparProvisioningTokenLimitReached
   idps <- liftSem $ IdPEffect.getConfigsByTeam teamid
 
   let caseOneOrNoIdP :: Maybe SAML.IdPId -> Spar r CreateScimTokenResponse
@@ -157,7 +157,7 @@ createScimToken zusr CreateScimToken {..} = do
     -- be changed.  currently, it relies on the fact that there is never more than one IdP.
     -- https://wearezeta.atlassian.net/browse/SQSERVICES-165
     _ ->
-      E.throwSpar $
+      throwSparSem $
         E.SparProvisioningMoreThanOneIdP
           "SCIM tokens can only be created for a team with at most one IdP"
 

From 398b027b6d82270339b5ab367706901ef24c1696 Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Fri, 1 Oct 2021 19:24:27 -0700
Subject: [PATCH 04/13] Remove ExceptT

---
 services/spar/src/Spar/App.hs                  | 11 ++++-------
 services/spar/src/Spar/CanonicalInterpreter.hs |  6 ++----
 services/spar/src/Spar/Scim.hs                 | 18 ++++++++----------
 3 files changed, 14 insertions(+), 21 deletions(-)

diff --git a/services/spar/src/Spar/App.hs b/services/spar/src/Spar/App.hs
index b2298f4adf..3e6e4a30ba 100644
--- a/services/spar/src/Spar/App.hs
+++ b/services/spar/src/Spar/App.hs
@@ -113,11 +113,11 @@ import Wire.API.User.IdentityProvider
 import Wire.API.User.Saml
 import Wire.API.User.Scim (ValidExternalId (..))
 
-newtype Spar r a = Spar {fromSpar :: Member (Final IO) r => ExceptT SparError (Sem r) a}
+newtype Spar r a = Spar {fromSpar :: Member (Final IO) r => Sem r a}
   deriving (Functor)
 
 liftSem :: Sem r a -> Spar r a
-liftSem r = Spar $ lift r
+liftSem = Spar
 
 throwSparSem :: Member (Error SparError) r => SparCustomError -> Spar r a
 throwSparSem = liftSem . throw . SAML.CustomError
@@ -140,11 +140,8 @@ data Env = Env
     sparCtxRequestId :: RequestId
   }
 
-runSparInSem :: Members '[Final IO, Error SparError] r => Spar r a -> Sem r a
-runSparInSem (Spar action) =
-  runExceptT action >>= \case
-    Left err -> throw err
-    Right a -> pure a
+runSparInSem :: Members '[Final IO] r => Spar r a -> Sem r a
+runSparInSem (Spar action) = action
 
 getIdPConfig ::
   Members
diff --git a/services/spar/src/Spar/CanonicalInterpreter.hs b/services/spar/src/Spar/CanonicalInterpreter.hs
index 3cc7481258..bbb40488c8 100644
--- a/services/spar/src/Spar/CanonicalInterpreter.hs
+++ b/services/spar/src/Spar/CanonicalInterpreter.hs
@@ -77,8 +77,7 @@ type CanonicalEffs =
 
 runSparToIO :: Env -> Spar CanonicalEffs a -> IO (Either SparError a)
 runSparToIO ctx (Spar action) =
-  fmap join
-    . runFinal
+  runFinal
     . embedToFinal @IO
     . nowToIO
     . randomToIO
@@ -101,8 +100,7 @@ runSparToIO ctx (Spar action) =
     . assIDStoreToCassandra
     . bindCookieStoreToCassandra
     . sparRouteToServant (saml $ sparCtxOpts ctx)
-    . saml2ToSaml2WebSso
-    $ runExceptT action
+    $ saml2ToSaml2WebSso action
 
 runSparToHandler :: Env -> Spar CanonicalEffs a -> Handler a
 runSparToHandler ctx spar = do
diff --git a/services/spar/src/Spar/Scim.hs b/services/spar/src/Spar/Scim.hs
index ccdaee6500..10f4a47cd4 100644
--- a/services/spar/src/Spar/Scim.hs
+++ b/services/spar/src/Spar/Scim.hs
@@ -65,11 +65,10 @@ module Spar.Scim
 where
 
 import Control.Monad.Catch (try)
-import Control.Monad.Except
 import Data.String.Conversions (cs)
 import Imports
 import Polysemy
-import Polysemy.Error (Error)
+import Polysemy.Error (Error, throw)
 import Polysemy.Input (Input)
 import qualified SAML2.WebSSO as SAML
 import Servant
@@ -147,23 +146,22 @@ apiScim =
     -- properly. See <https://github.com/haskell-servant/servant/issues/1022>
     -- for why it's hard to catch impure exceptions.
     wrapScimErrors :: Spar r a -> Spar r a
-    wrapScimErrors act = Spar $
-      ExceptT $ do
-        result :: Either SomeException (Either SparError a) <- try $ runExceptT $ fromSpar $ act
+    wrapScimErrors act = Spar $ do
+        result :: Either SomeException (Either SparError a) <- undefined -- try $ runExceptT $ fromSpar $ act
         case result of
           Left someException -> do
             -- We caught an exception that's not a Spar exception at all. It is wrapped into
             -- Scim.serverError.
-            pure . Left . SAML.CustomError . SparScimError $
+            throw . SAML.CustomError . SparScimError $
               Scim.serverError (cs (displayException someException))
-          Right err@(Left (SAML.CustomError (SparScimError _))) ->
+          Right (Left err@(SAML.CustomError (SparScimError _))) ->
             -- We caught a 'SparScimError' exception. It is left as-is.
-            pure err
+            throw err
           Right (Left sparError) -> do
             -- We caught some other Spar exception. It is rendered and wrapped into a scim error
             -- with the same status and message, and no scim error type.
             err :: ServerError <- embedFinal @IO $ sparToServerErrorWithLogging undefined sparError
-            pure . Left . SAML.CustomError . SparScimError $
+            throw . SAML.CustomError . SparScimError $
               Scim.ScimError
                 { schemas = [Scim.Schema.Error20],
                   status = Scim.Status $ errHTTPCode err,
@@ -172,7 +170,7 @@ apiScim =
                 }
           Right (Right x) -> do
             -- No exceptions! Good.
-            pure $ Right x
+            pure x
 
 -- | This is similar to 'Scim.siteServer, but does not include the 'Scim.groupServer',
 -- as we don't support it (we don't implement 'Web.Scim.Class.Group.GroupDB').

From c35ed44c456e663b943738c8f938b597d26abbbb Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Fri, 1 Oct 2021 19:30:27 -0700
Subject: [PATCH 05/13] Remove Final IO from Spar

---
 services/spar/src/Spar/API.hs               | 12 ++----
 services/spar/src/Spar/App.hs               | 38 ++--------------
 services/spar/src/Spar/Scim.hs              | 48 ++++++++++-----------
 services/spar/src/Spar/Sem/SAML2/Library.hs | 17 ++++++--
 4 files changed, 45 insertions(+), 70 deletions(-)

diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs
index 661b66f7ee..5c427159d2 100644
--- a/services/spar/src/Spar/API.hs
+++ b/services/spar/src/Spar/API.hs
@@ -125,9 +125,7 @@ api ::
        Now,
        SamlProtocolSettings,
        Logger String,
-       Logger (Msg -> Msg),
-       -- TODO(sandy): Remove me when we get rid of runSparInSem
-       Final IO
+       Logger (Msg -> Msg)
      ]
     r =>
   Opts ->
@@ -156,9 +154,7 @@ apiSSO ::
        Error SparError,
        SAML2,
        SamlProtocolSettings,
-       SAMLUserStore,
-       -- TODO(sandy): Remove me when we get rid of runSparInSem
-       Final IO
+       SAMLUserStore
      ]
     r =>
   Opts ->
@@ -325,9 +321,7 @@ authresp ::
        SAML2,
        SamlProtocolSettings,
        Error SparError,
-       SAMLUserStore,
-       -- TODO(sandy): Remove me when we get rid of runSparInSem
-       Final IO
+       SAMLUserStore
      ]
     r =>
   Maybe TeamId ->
diff --git a/services/spar/src/Spar/App.hs b/services/spar/src/Spar/App.hs
index 3e6e4a30ba..9d90b4005f 100644
--- a/services/spar/src/Spar/App.hs
+++ b/services/spar/src/Spar/App.hs
@@ -1,6 +1,5 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE RecordWildCards #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# OPTIONS_GHC -fplugin=Polysemy.Plugin #-}
 
 -- This file is part of the Wire Server implementation.
@@ -50,7 +49,6 @@ import Brig.Types.Intra (AccountStatus (..), accountStatus, accountUser)
 import qualified Cassandra as Cas
 import Control.Exception (assert)
 import Control.Lens hiding ((.=))
-import qualified Control.Monad.Catch as Catch
 import Control.Monad.Except
 import Data.Aeson as Aeson (encode, object, (.=))
 import Data.Aeson.Text as Aeson (encodeToLazyText)
@@ -65,7 +63,6 @@ import qualified Network.HTTP.Types.Status as Http
 import qualified Network.Wai.Utilities.Error as Wai
 import Polysemy
 import Polysemy.Error
-import Polysemy.Final
 import SAML2.Util (renderURI)
 import SAML2.WebSSO
   ( IdPId (..),
@@ -113,8 +110,8 @@ import Wire.API.User.IdentityProvider
 import Wire.API.User.Saml
 import Wire.API.User.Scim (ValidExternalId (..))
 
-newtype Spar r a = Spar {fromSpar :: Member (Final IO) r => Sem r a}
-  deriving (Functor)
+newtype Spar r a = Spar {fromSpar :: Sem r a}
+  deriving (Functor, Applicative, Monad)
 
 liftSem :: Sem r a -> Spar r a
 liftSem = Spar
@@ -122,14 +119,6 @@ liftSem = Spar
 throwSparSem :: Member (Error SparError) r => SparCustomError -> Spar r a
 throwSparSem = liftSem . throw . SAML.CustomError
 
-instance Applicative (Spar r) where
-  pure a = Spar $ pure a
-  liftA2 f a b = Spar $ liftA2 f (fromSpar a) (fromSpar b)
-
-instance Monad (Spar r) where
-  return = pure
-  f >>= a = Spar $ fromSpar f >>= fromSpar . a
-
 data Env = Env
   { sparCtxOpts :: Opts,
     sparCtxLogger :: TinyLog.Logger,
@@ -140,7 +129,7 @@ data Env = Env
     sparCtxRequestId :: RequestId
   }
 
-runSparInSem :: Members '[Final IO] r => Spar r a -> Sem r a
+runSparInSem :: Spar r a -> Sem r a
 runSparInSem (Spar action) = action
 
 getIdPConfig ::
@@ -165,16 +154,6 @@ getIdPConfigByIssuerOptionalSPId issuer mbteam = do
     res@(Data.GetIdPNonUnique _) -> throwSparSem $ SparIdPNotFound (cs $ show res)
     res@(Data.GetIdPWrongTeam _) -> throwSparSem $ SparIdPNotFound (cs $ show res)
 
-instance Member (Final IO) r => Catch.MonadThrow (Sem r) where
-  throwM = embedFinal . Catch.throwM @IO
-
-instance Member (Final IO) r => Catch.MonadCatch (Sem r) where
-  catch m handler = withStrategicToFinal @IO $ do
-    m' <- runS m
-    st <- getInitialStateS
-    handler' <- bindS handler
-    pure $ m' `Catch.catch` \e -> handler' $ e <$ st
-
 insertUser :: Member SAMLUserStore r => SAML.UserRef -> UserId -> Spar r ()
 insertUser uref uid = liftSem $ SAMLUserStore.insert uref uid
 
@@ -407,8 +386,6 @@ verdictHandler ::
        ScimTokenStore,
        IdPEffect.IdP,
        Error SparError,
-       -- TODO(sandy): Remove Final IO when removing runSparInSem
-       Final IO,
        SAMLUserStore
      ]
     r =>
@@ -452,8 +429,6 @@ verdictHandlerResult ::
        ScimTokenStore,
        IdPEffect.IdP,
        Error SparError,
-       -- TODO(sandy): Remove Final IO when removing runSparInSem
-       Final IO,
        SAMLUserStore
      ]
     r =>
@@ -469,12 +444,7 @@ verdictHandlerResult bindCky mbteam verdict = do
 
 catchVerdictErrors ::
   forall r.
-  Members
-    '[ Error SparError,
-       -- TODO(sandy): Remove Final IO when removing runSparInSem
-       Final IO
-     ]
-    r =>
+  Member (Error SparError) r =>
   Spar r VerdictHandlerResult ->
   Spar r VerdictHandlerResult
 catchVerdictErrors = liftSem . (`catch` hndlr) . runSparInSem
diff --git a/services/spar/src/Spar/Scim.hs b/services/spar/src/Spar/Scim.hs
index 10f4a47cd4..b301c9ecd3 100644
--- a/services/spar/src/Spar/Scim.hs
+++ b/services/spar/src/Spar/Scim.hs
@@ -147,30 +147,30 @@ apiScim =
     -- for why it's hard to catch impure exceptions.
     wrapScimErrors :: Spar r a -> Spar r a
     wrapScimErrors act = Spar $ do
-        result :: Either SomeException (Either SparError a) <- undefined -- try $ runExceptT $ fromSpar $ act
-        case result of
-          Left someException -> do
-            -- We caught an exception that's not a Spar exception at all. It is wrapped into
-            -- Scim.serverError.
-            throw . SAML.CustomError . SparScimError $
-              Scim.serverError (cs (displayException someException))
-          Right (Left err@(SAML.CustomError (SparScimError _))) ->
-            -- We caught a 'SparScimError' exception. It is left as-is.
-            throw err
-          Right (Left sparError) -> do
-            -- We caught some other Spar exception. It is rendered and wrapped into a scim error
-            -- with the same status and message, and no scim error type.
-            err :: ServerError <- embedFinal @IO $ sparToServerErrorWithLogging undefined sparError
-            throw . SAML.CustomError . SparScimError $
-              Scim.ScimError
-                { schemas = [Scim.Schema.Error20],
-                  status = Scim.Status $ errHTTPCode err,
-                  scimType = Nothing,
-                  detail = Just . cs $ errBody err
-                }
-          Right (Right x) -> do
-            -- No exceptions! Good.
-            pure x
+      result :: Either SomeException (Either SparError a) <- undefined -- try $ runExceptT $ fromSpar $ act
+      case result of
+        Left someException -> do
+          -- We caught an exception that's not a Spar exception at all. It is wrapped into
+          -- Scim.serverError.
+          throw . SAML.CustomError . SparScimError $
+            Scim.serverError (cs (displayException someException))
+        Right (Left err@(SAML.CustomError (SparScimError _))) ->
+          -- We caught a 'SparScimError' exception. It is left as-is.
+          throw err
+        Right (Left sparError) -> do
+          -- We caught some other Spar exception. It is rendered and wrapped into a scim error
+          -- with the same status and message, and no scim error type.
+          err :: ServerError <- undefined -- embedFinal @IO $ sparToServerErrorWithLogging undefined sparError
+          throw . SAML.CustomError . SparScimError $
+            Scim.ScimError
+              { schemas = [Scim.Schema.Error20],
+                status = Scim.Status $ errHTTPCode err,
+                scimType = Nothing,
+                detail = Just . cs $ errBody err
+              }
+        Right (Right x) -> do
+          -- No exceptions! Good.
+          pure x
 
 -- | This is similar to 'Scim.siteServer, but does not include the 'Scim.groupServer',
 -- as we don't support it (we don't implement 'Web.Scim.Class.Group.GroupDB').
diff --git a/services/spar/src/Spar/Sem/SAML2/Library.hs b/services/spar/src/Spar/Sem/SAML2/Library.hs
index 3de6992141..d3ebe1d26c 100644
--- a/services/spar/src/Spar/Sem/SAML2/Library.hs
+++ b/services/spar/src/Spar/Sem/SAML2/Library.hs
@@ -11,6 +11,7 @@ import Data.String.Conversions (cs)
 import Imports
 import Polysemy
 import Polysemy.Error
+import Polysemy.Final
 import Polysemy.Input
 import Polysemy.Internal.Tactics
 import SAML2.WebSSO hiding (Error)
@@ -30,9 +31,19 @@ import Wire.API.User.Saml
 
 wrapMonadClientSPImpl :: Members '[Error SparError, Final IO] r => Sem r a -> SPImpl r a
 wrapMonadClientSPImpl action =
-  SPImpl $
-    action
-      `Catch.catch` (throw . SAML.CustomError . SparCassandraError . cs . show @SomeException)
+  SPImpl action
+    `Catch.catch` (SPImpl . throw . SAML.CustomError . SparCassandraError . cs . show @SomeException)
+
+instance Member (Final IO) r => Catch.MonadThrow (SPImpl r) where
+  throwM = SPImpl . embedFinal . Catch.throwM @IO
+
+instance Member (Final IO) r => Catch.MonadCatch (SPImpl r) where
+  catch (SPImpl m) handler = SPImpl $
+    withStrategicToFinal @IO $ do
+      m' <- runS m
+      st <- getInitialStateS
+      handler' <- bindS $ unSPImpl . handler
+      pure $ m' `Catch.catch` \e -> handler' $ e <$ st
 
 newtype SPImpl r a = SPImpl {unSPImpl :: Sem r a}
   deriving (Functor, Applicative, Monad)

From d830733ab4c4456d9650db0ecdb4a3e41346fd76 Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Fri, 1 Oct 2021 19:47:29 -0700
Subject: [PATCH 06/13] Fix one use of undefined

---
 services/spar/src/Spar/API.hs  |  2 ++
 services/spar/src/Spar/Scim.hs | 10 ++++++----
 2 files changed, 8 insertions(+), 4 deletions(-)

diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs
index 5c427159d2..4e56c25896 100644
--- a/services/spar/src/Spar/API.hs
+++ b/services/spar/src/Spar/API.hs
@@ -125,6 +125,8 @@ api ::
        Now,
        SamlProtocolSettings,
        Logger String,
+       -- TODO(sandy): Only necessary for 'fromExceptionSem' in 'apiScim'
+       Final IO,
        Logger (Msg -> Msg)
      ]
     r =>
diff --git a/services/spar/src/Spar/Scim.hs b/services/spar/src/Spar/Scim.hs
index b301c9ecd3..142bbfb56e 100644
--- a/services/spar/src/Spar/Scim.hs
+++ b/services/spar/src/Spar/Scim.hs
@@ -64,17 +64,16 @@ module Spar.Scim
   )
 where
 
-import Control.Monad.Catch (try)
 import Data.String.Conversions (cs)
 import Imports
 import Polysemy
-import Polysemy.Error (Error, throw)
+import Polysemy.Error (Error, fromExceptionSem, runError, throw, try)
 import Polysemy.Input (Input)
 import qualified SAML2.WebSSO as SAML
 import Servant
 import Servant.API.Generic
 import Servant.Server.Generic (AsServerT)
-import Spar.App (Spar (..), throwSparSem)
+import Spar.App (Spar (..), runSparInSem, throwSparSem)
 import Spar.Error
   ( SparCustomError (SparScimError),
     SparError,
@@ -126,6 +125,8 @@ apiScim ::
        ScimUserTimesStore,
        ScimTokenStore,
        IdPEffect.IdP,
+       -- TODO(sandy): Only necessary for 'fromExceptionSem'. But can these errors even happen?
+       Final IO,
        SAMLUserStore
      ]
     r =>
@@ -147,7 +148,8 @@ apiScim =
     -- for why it's hard to catch impure exceptions.
     wrapScimErrors :: Spar r a -> Spar r a
     wrapScimErrors act = Spar $ do
-      result :: Either SomeException (Either SparError a) <- undefined -- try $ runExceptT $ fromSpar $ act
+      result :: Either SomeException (Either SparError a) <-
+        runError $ fromExceptionSem @SomeException $ raise $ try @SparError $ runSparInSem act
       case result of
         Left someException -> do
           -- We caught an exception that's not a Spar exception at all. It is wrapped into

From 610d21645382745d2e4f8c44fdf63e1387dcaf19 Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Sat, 2 Oct 2021 09:51:33 -0700
Subject: [PATCH 07/13] Reporter effect; NO MORE IO

---
 services/spar/spar.cabal                      |  4 ++-
 services/spar/src/Spar/API.hs                 |  4 +++
 services/spar/src/Spar/App.hs                 | 29 ++++++++++++++++---
 .../spar/src/Spar/CanonicalInterpreter.hs     |  6 +++-
 services/spar/src/Spar/Error.hs               | 11 ++-----
 services/spar/src/Spar/Sem/Reporter.hs        | 12 ++++++++
 services/spar/src/Spar/Sem/Reporter/Wai.hs    | 14 +++++++++
 7 files changed, 65 insertions(+), 15 deletions(-)
 create mode 100644 services/spar/src/Spar/Sem/Reporter.hs
 create mode 100644 services/spar/src/Spar/Sem/Reporter/Wai.hs

diff --git a/services/spar/spar.cabal b/services/spar/spar.cabal
index 48e9772c41..e23c70faad 100644
--- a/services/spar/spar.cabal
+++ b/services/spar/spar.cabal
@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: fe28e95f2571e0a2583e7d160ff87f80422801408c265139b1cd2392a425fd72
+-- hash: e1e1abfd9d2fd00bd96a693a9466a13e0b7aef15677f0506941f662094a340a1
 
 name:           spar
 version:        0.1
@@ -57,6 +57,8 @@ library
       Spar.Sem.Now.IO
       Spar.Sem.Random
       Spar.Sem.Random.IO
+      Spar.Sem.Reporter
+      Spar.Sem.Reporter.Wai
       Spar.Sem.SAML2
       Spar.Sem.SAML2.Library
       Spar.Sem.SamlProtocolSettings
diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs
index 4e56c25896..a5ea8360cf 100644
--- a/services/spar/src/Spar/API.hs
+++ b/services/spar/src/Spar/API.hs
@@ -83,6 +83,7 @@ import qualified Spar.Sem.Logger as Logger
 import Spar.Sem.Now (Now)
 import Spar.Sem.Random (Random)
 import qualified Spar.Sem.Random as Random
+import Spar.Sem.Reporter (Reporter)
 import Spar.Sem.SAML2 (SAML2)
 import qualified Spar.Sem.SAML2 as SAML2
 import Spar.Sem.SAMLUserStore (SAMLUserStore)
@@ -125,6 +126,7 @@ api ::
        Now,
        SamlProtocolSettings,
        Logger String,
+       Reporter,
        -- TODO(sandy): Only necessary for 'fromExceptionSem' in 'apiScim'
        Final IO,
        Logger (Msg -> Msg)
@@ -156,6 +158,7 @@ apiSSO ::
        Error SparError,
        SAML2,
        SamlProtocolSettings,
+       Reporter,
        SAMLUserStore
      ]
     r =>
@@ -323,6 +326,7 @@ authresp ::
        SAML2,
        SamlProtocolSettings,
        Error SparError,
+       Reporter,
        SAMLUserStore
      ]
     r =>
diff --git a/services/spar/src/Spar/App.hs b/services/spar/src/Spar/App.hs
index 9d90b4005f..7fcb175a3d 100644
--- a/services/spar/src/Spar/App.hs
+++ b/services/spar/src/Spar/App.hs
@@ -40,6 +40,8 @@ module Spar.App
     storeIdPConfig,
     getIdPConfigByIssuerOptionalSPId,
     runSparInSem,
+    sparToServerErrorWithLogging,
+    renderSparErrorWithLogging,
   )
 where
 
@@ -78,7 +80,7 @@ import qualified SAML2.WebSSO.Types.Email as SAMLEmail
 import Servant
 import qualified Servant.Multipart as Multipart
 import qualified Spar.Data as Data (GetIdPResult (..))
-import Spar.Error
+import Spar.Error hiding (sparToServerErrorWithLogging)
 import qualified Spar.Intra.BrigApp as Intra
 import Spar.Orphans ()
 import Spar.Sem.AReqIDStore (AReqIDStore)
@@ -95,6 +97,8 @@ import Spar.Sem.Logger (Logger)
 import qualified Spar.Sem.Logger as Logger
 import Spar.Sem.Random (Random)
 import qualified Spar.Sem.Random as Random
+import Spar.Sem.Reporter (Reporter)
+import qualified Spar.Sem.Reporter as Reporter
 import Spar.Sem.SAMLUserStore (SAMLUserStore)
 import qualified Spar.Sem.SAMLUserStore as SAMLUserStore
 import Spar.Sem.ScimExternalIdStore (ScimExternalIdStore)
@@ -386,6 +390,7 @@ verdictHandler ::
        ScimTokenStore,
        IdPEffect.IdP,
        Error SparError,
+       Reporter,
        SAMLUserStore
      ]
     r =>
@@ -429,6 +434,7 @@ verdictHandlerResult ::
        ScimTokenStore,
        IdPEffect.IdP,
        Error SparError,
+       Reporter,
        SAMLUserStore
      ]
     r =>
@@ -444,15 +450,18 @@ verdictHandlerResult bindCky mbteam verdict = do
 
 catchVerdictErrors ::
   forall r.
-  Member (Error SparError) r =>
+  Members
+    '[ Reporter,
+       Error SparError
+     ]
+    r =>
   Spar r VerdictHandlerResult ->
   Spar r VerdictHandlerResult
 catchVerdictErrors = liftSem . (`catch` hndlr) . runSparInSem
   where
     hndlr :: SparError -> Sem r VerdictHandlerResult
     hndlr err = do
-      -- TODO(sandy): When we remove this line, we can get rid of the @Input TinyLog.Logger@ effect
-      waiErr <- renderSparErrorWithLogging undefined err
+      waiErr <- renderSparErrorWithLogging err
       pure $ case waiErr of
         Right (werr :: Wai.Error) -> VerifyHandlerError (cs $ Wai.label werr) (cs $ Wai.message werr)
         Left (serr :: ServerError) -> VerifyHandlerError "unknown-error" (cs (errReasonPhrase serr) <> " " <> cs (errBody serr))
@@ -770,3 +779,15 @@ deleteTeam team = liftSem $ do
         issuer = idp ^. SAML.idpMetadata . SAML.edIssuer
     SAMLUserStore.deleteByIssuer issuer
     IdPEffect.deleteConfig idpid issuer team
+
+sparToServerErrorWithLogging :: Member Reporter r => SparError -> Sem r ServerError
+sparToServerErrorWithLogging err = do
+  let errServant = sparToServerError err
+  Reporter.report Nothing (servantToWaiError errServant)
+  pure errServant
+
+renderSparErrorWithLogging :: Member Reporter r => SparError -> Sem r (Either ServerError Wai.Error)
+renderSparErrorWithLogging err = do
+  let errPossiblyWai = renderSparError err
+  Reporter.report Nothing (either servantToWaiError id $ errPossiblyWai)
+  pure errPossiblyWai
diff --git a/services/spar/src/Spar/CanonicalInterpreter.hs b/services/spar/src/Spar/CanonicalInterpreter.hs
index bbb40488c8..4aee0c3a04 100644
--- a/services/spar/src/Spar/CanonicalInterpreter.hs
+++ b/services/spar/src/Spar/CanonicalInterpreter.hs
@@ -9,7 +9,7 @@ import Polysemy
 import Polysemy.Error
 import Polysemy.Input (Input, runInputConst)
 import Servant
-import Spar.App
+import Spar.App hiding (sparToServerErrorWithLogging)
 import Spar.Error
 import Spar.Orphans ()
 import Spar.Sem.AReqIDStore (AReqIDStore)
@@ -32,6 +32,8 @@ import Spar.Sem.Now (Now)
 import Spar.Sem.Now.IO (nowToIO)
 import Spar.Sem.Random (Random)
 import Spar.Sem.Random.IO (randomToIO)
+import Spar.Sem.Reporter (Reporter)
+import Spar.Sem.Reporter.Wai (reporterToWai)
 import Spar.Sem.SAML2 (SAML2)
 import Spar.Sem.SAML2.Library (saml2ToSaml2WebSso)
 import Spar.Sem.SAMLUserStore (SAMLUserStore)
@@ -64,6 +66,7 @@ type CanonicalEffs =
      GalleyAccess,
      Error TTLError,
      Error SparError,
+     Reporter,
      -- TODO(sandy): Make this a Logger Text instead
      Logger String,
      Logger (TinyLog.Msg -> TinyLog.Msg),
@@ -85,6 +88,7 @@ runSparToIO ctx (Spar action) =
     . runInputConst (sparCtxOpts ctx)
     . loggerToTinyLog (sparCtxLogger ctx)
     . stringLoggerToTinyLog
+    . reporterToWai
     . runError @SparError
     . ttlErrorToSparError
     . galleyAccessToHttp (sparCtxHttpManager ctx) (sparCtxHttpGalley ctx)
diff --git a/services/spar/src/Spar/Error.hs b/services/spar/src/Spar/Error.hs
index c8ff6dd8db..6d1e83b03d 100644
--- a/services/spar/src/Spar/Error.hs
+++ b/services/spar/src/Spar/Error.hs
@@ -29,7 +29,6 @@ module Spar.Error
     SparCustomError (..),
     throwSpar,
     sparToServerErrorWithLogging,
-    renderSparErrorWithLogging,
     rethrow,
     parseResponse,
     -- FUTUREWORK: we really shouldn't export this, but that requires that we can use our
@@ -111,9 +110,9 @@ data SparCustomError
   deriving (Eq, Show)
 
 sparToServerErrorWithLogging :: MonadIO m => Log.Logger -> SparError -> m ServerError
-sparToServerErrorWithLogging _logger err = do
+sparToServerErrorWithLogging logger err = do
   let errServant = sparToServerError err
-  -- liftIO $ Wai.logError logger (Nothing :: Maybe Wai.Request) (servantToWaiError errServant)
+  liftIO $ Wai.logError logger (Nothing :: Maybe Wai.Request) (servantToWaiError errServant)
   pure errServant
 
 servantToWaiError :: ServerError -> Wai.Error
@@ -132,12 +131,6 @@ waiToServant waierr@(Wai.Error status label _ _) =
       errHeaders = []
     }
 
-renderSparErrorWithLogging :: Applicative m => Log.Logger -> SparError -> m (Either ServerError Wai.Error)
-renderSparErrorWithLogging _logger err = do
-  let errPossiblyWai = renderSparError err
-  -- liftIO $ Wai.logError logger (Nothing :: Maybe Wai.Request) (either servantToWaiError id $ errPossiblyWai)
-  pure errPossiblyWai
-
 renderSparError :: SparError -> Either ServerError Wai.Error
 renderSparError (SAML.CustomError SparNoSuchRequest) = Right $ Wai.mkError status500 "server-error" "AuthRequest seems to have disappeared (could not find verdict format)."
 renderSparError (SAML.CustomError (SparNoRequestRefInResponse msg)) = Right $ Wai.mkError status400 "server-error-unsupported-saml" ("The IdP needs to provide an InResponseTo attribute in the assertion: " <> msg)
diff --git a/services/spar/src/Spar/Sem/Reporter.hs b/services/spar/src/Spar/Sem/Reporter.hs
new file mode 100644
index 0000000000..b038152111
--- /dev/null
+++ b/services/spar/src/Spar/Sem/Reporter.hs
@@ -0,0 +1,12 @@
+module Spar.Sem.Reporter where
+
+import Imports
+import qualified Network.Wai as Wai
+import Network.Wai.Utilities.Error (Error)
+import Polysemy
+
+data Reporter m a where
+  Report :: Maybe Wai.Request -> Error -> Reporter m ()
+
+-- TODO(sandy): Inline this definition --- no TH
+makeSem ''Reporter
diff --git a/services/spar/src/Spar/Sem/Reporter/Wai.hs b/services/spar/src/Spar/Sem/Reporter/Wai.hs
new file mode 100644
index 0000000000..4e149955be
--- /dev/null
+++ b/services/spar/src/Spar/Sem/Reporter/Wai.hs
@@ -0,0 +1,14 @@
+module Spar.Sem.Reporter.Wai where
+
+import Imports
+import qualified Network.Wai.Utilities.Server as Wai
+import Polysemy
+import Polysemy.Input
+import Spar.Sem.Reporter
+import qualified System.Logger as TinyLog
+
+reporterToWai :: Members '[Embed IO, Input TinyLog.Logger] r => Sem (Reporter ': r) a -> Sem r a
+reporterToWai = interpret $ \case
+  Report req err -> do
+    logger <- input
+    embed @IO $ Wai.logError logger req err

From e53db15f2af136fae779619aea4784557095df3d Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Sat, 2 Oct 2021 10:12:57 -0700
Subject: [PATCH 08/13] Remove the Spar newtype

---
 services/spar/src/Spar/API.hs                 |  96 +++++++--------
 services/spar/src/Spar/App.hs                 |  81 ++++++-------
 .../spar/src/Spar/CanonicalInterpreter.hs     |   2 +-
 services/spar/src/Spar/Scim/Auth.hs           |  30 ++---
 services/spar/src/Spar/Scim/User.hs           |  99 ++++++++--------
 services/spar/src/Spar/Sem/SAML2/Library.hs   |   6 +-
 .../test-integration/Test/Spar/APISpec.hs     |   7 +-
 .../test-integration/Test/Spar/AppSpec.hs     |   3 +-
 .../test-integration/Test/Spar/DataSpec.hs    | 112 +++++++++---------
 .../Test/Spar/Intra/BrigSpec.hs               |   5 +-
 .../Test/Spar/Scim/UserSpec.hs                |  61 +++++-----
 services/spar/test-integration/Util/Core.hs   |   9 +-
 services/spar/test-integration/Util/Scim.hs   |  20 ++--
 13 files changed, 256 insertions(+), 275 deletions(-)

diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs
index a5ea8360cf..507df61079 100644
--- a/services/spar/src/Spar/API.hs
+++ b/services/spar/src/Spar/API.hs
@@ -165,8 +165,8 @@ apiSSO ::
   Opts ->
   ServerT APISSO (Spar r)
 apiSSO opts =
-  (liftSem $ SAML2.meta appName (SamlProtocolSettings.spIssuer Nothing) (SamlProtocolSettings.responseURI Nothing))
-    :<|> (\tid -> liftSem $ SAML2.meta appName (SamlProtocolSettings.spIssuer (Just tid)) (SamlProtocolSettings.responseURI (Just tid)))
+  (SAML2.meta appName (SamlProtocolSettings.spIssuer Nothing) (SamlProtocolSettings.responseURI Nothing))
+    :<|> (\tid -> SAML2.meta appName (SamlProtocolSettings.spIssuer (Just tid)) (SamlProtocolSettings.responseURI (Just tid)))
     :<|> authreqPrecheck
     :<|> authreq (maxttlAuthreqDiffTime opts) DoInitiateLogin
     :<|> authresp Nothing
@@ -256,15 +256,15 @@ authreq _ DoInitiateBind Nothing _ _ _ = throwSparSem SparInitBindWithoutAuth
 authreq authreqttl _ zusr msucc merr idpid = do
   vformat <- validateAuthreqParams msucc merr
   form@(SAML.FormRedirect _ ((^. SAML.rqID) -> reqid)) <- do
-    idp :: IdP <- liftSem (IdPEffect.getConfig idpid) >>= maybe (throwSparSem (SparIdPNotFound (cs $ show idpid))) pure
+    idp :: IdP <- IdPEffect.getConfig idpid >>= maybe (throwSparSem (SparIdPNotFound (cs $ show idpid))) pure
     let mbtid :: Maybe TeamId
         mbtid = case fromMaybe defWireIdPAPIVersion (idp ^. SAML.idpExtraInfo . wiApiVersion) of
           WireIdPAPIV1 -> Nothing
           WireIdPAPIV2 -> Just $ idp ^. SAML.idpExtraInfo . wiTeam
-    liftSem $ SAML2.authReq authreqttl (SamlProtocolSettings.spIssuer mbtid) idpid
-  liftSem $ AReqIDStore.storeVerdictFormat authreqttl reqid vformat
+    SAML2.authReq authreqttl (SamlProtocolSettings.spIssuer mbtid) idpid
+  AReqIDStore.storeVerdictFormat authreqttl reqid vformat
   cky <- initializeBindCookie zusr authreqttl
-  liftSem $ Logger.log SAML.Debug $ "setting bind cookie: " <> show cky
+  Logger.log SAML.Debug $ "setting bind cookie: " <> show cky
   pure $ addHeader cky form
 
 -- | If the user is already authenticated, create bind cookie with a given life expectancy and our
@@ -283,13 +283,13 @@ initializeBindCookie ::
   NominalDiffTime ->
   Spar r SetBindCookie
 initializeBindCookie zusr authreqttl = do
-  DerivedOpts {derivedOptsBindCookiePath} <- liftSem $ inputs derivedOpts
+  DerivedOpts {derivedOptsBindCookiePath} <- inputs derivedOpts
   msecret <-
     if isJust zusr
-      then liftSem $ Just . cs . ES.encode <$> Random.bytes 32
+      then Just . cs . ES.encode <$> Random.bytes 32
       else pure Nothing
-  cky <- fmap SetBindCookie . liftSem . SAML2.toggleCookie derivedOptsBindCookiePath $ (,authreqttl) <$> msecret
-  forM_ zusr $ \userid -> liftSem $ BindCookieStore.insert cky userid authreqttl
+  cky <- fmap SetBindCookie . SAML2.toggleCookie derivedOptsBindCookiePath $ (,authreqttl) <$> msecret
+  forM_ zusr $ \userid -> BindCookieStore.insert cky userid authreqttl
   pure cky
 
 redirectURLMaxLength :: Int
@@ -334,14 +334,14 @@ authresp ::
   Maybe ST ->
   SAML.AuthnResponseBody ->
   Spar r Void
-authresp mbtid ckyraw arbody = logErrors $ liftSem $ SAML2.authResp mbtid (SamlProtocolSettings.spIssuer mbtid) (SamlProtocolSettings.responseURI mbtid) go arbody
+authresp mbtid ckyraw arbody = logErrors $ SAML2.authResp mbtid (SamlProtocolSettings.spIssuer mbtid) (SamlProtocolSettings.responseURI mbtid) go arbody
   where
     cky :: Maybe BindCookie
     cky = ckyraw >>= bindCookieFromHeader
 
     go :: SAML.AuthnResponse -> SAML.AccessVerdict -> Sem r Void
     go resp verdict = do
-      result :: SAML.ResponseVerdict <- runSparInSem $ verdictHandler cky mbtid resp verdict
+      result :: SAML.ResponseVerdict <- verdictHandler cky mbtid resp verdict
       throw @SparError $ SAML.CustomServant result
 
     logErrors :: Spar r Void -> Spar r Void
@@ -356,7 +356,7 @@ authresp mbtid ckyraw arbody = logErrors $ liftSem $ SAML2.authResp mbtid (SamlP
 
 ssoSettings :: Member DefaultSsoCode r => Spar r SsoSettings
 ssoSettings = do
-  SsoSettings <$> liftSem DefaultSsoCode.get
+  SsoSettings <$> DefaultSsoCode.get
 
 ----------------------------------------------------------------------------
 -- IdP API
@@ -376,7 +376,7 @@ idpGet ::
   Spar r IdP
 idpGet zusr idpid = withDebugLog "idpGet" (Just . show . (^. SAML.idpId)) $ do
   idp <- getIdPConfig idpid
-  _ <- liftSem $ authorizeIdP zusr idp
+  _ <- authorizeIdP zusr idp
   pure idp
 
 idpGetRaw ::
@@ -386,8 +386,8 @@ idpGetRaw ::
   Spar r RawIdPMetadata
 idpGetRaw zusr idpid = do
   idp <- getIdPConfig idpid
-  _ <- liftSem $ authorizeIdP zusr idp
-  liftSem (IdPEffect.getRawMetadata idpid) >>= \case
+  _ <- authorizeIdP zusr idp
+  IdPEffect.getRawMetadata idpid >>= \case
     Just txt -> pure $ RawIdPMetadata txt
     Nothing -> throwSparSem $ SparIdPNotFound (cs $ show idpid)
 
@@ -404,8 +404,8 @@ idpGetAll ::
   Maybe UserId ->
   Spar r IdPList
 idpGetAll zusr = withDebugLog "idpGetAll" (const Nothing) $ do
-  teamid <- liftSem $ Brig.getZUsrCheckPerm zusr ReadIdp
-  _idplProviders <- liftSem $ IdPEffect.getConfigsByTeam teamid
+  teamid <- Brig.getZUsrCheckPerm zusr ReadIdp
+  _idplProviders <- IdPEffect.getConfigsByTeam teamid
   pure IdPList {..}
 
 -- | Delete empty IdPs, or if @"purge=true"@ in the HTTP query, delete all users
@@ -435,17 +435,17 @@ idpDelete ::
   Spar r NoContent
 idpDelete zusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (const Nothing) $ do
   idp <- getIdPConfig idpid
-  _ <- liftSem $ authorizeIdP zusr idp
+  _ <- authorizeIdP zusr idp
   let issuer = idp ^. SAML.idpMetadata . SAML.edIssuer
       team = idp ^. SAML.idpExtraInfo . wiTeam
   -- if idp is not empty: fail or purge
-  idpIsEmpty <- liftSem $ isNothing <$> SAMLUserStore.getAnyByIssuer issuer
+  idpIsEmpty <- isNothing <$> SAMLUserStore.getAnyByIssuer issuer
   let doPurge :: Spar r ()
       doPurge = do
-        some <- liftSem (SAMLUserStore.getSomeByIssuer issuer)
+        some <- SAMLUserStore.getSomeByIssuer issuer
         forM_ some $ \(uref, uid) -> do
-          liftSem $ BrigAccess.delete uid
-          liftSem (SAMLUserStore.delete uid uref)
+          BrigAccess.delete uid
+          SAMLUserStore.delete uid uref
         unless (null some) doPurge
   when (not idpIsEmpty) $ do
     if purge
@@ -456,11 +456,11 @@ idpDelete zusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (cons
   -- Delete tokens associated with given IdP (we rely on the fact that
   -- each IdP has exactly one team so we can look up all tokens
   -- associated with the team and then filter them)
-  tokens <- liftSem $ ScimTokenStore.getByTeam team
+  tokens <- ScimTokenStore.getByTeam team
   for_ tokens $ \ScimTokenInfo {..} ->
-    when (stiIdP == Just idpid) $ liftSem $ ScimTokenStore.delete team stiId
+    when (stiIdP == Just idpid) $ ScimTokenStore.delete team stiId
   -- Delete IdP config
-  liftSem $ do
+  do
     IdPEffect.deleteConfig idpid issuer team
     IdPEffect.deleteRawMetadata idpid
   return NoContent
@@ -477,7 +477,7 @@ idpDelete zusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (cons
     updateReplacingIdP :: IdP -> Spar r ()
     updateReplacingIdP idp = forM_ (idp ^. SAML.idpExtraInfo . wiOldIssuers) $ \oldIssuer -> do
       getIdPIdByIssuer oldIssuer (idp ^. SAML.idpExtraInfo . wiTeam) >>= \case
-        Data.GetIdPFound iid -> liftSem $ IdPEffect.clearReplacedBy $ Data.Replaced iid
+        Data.GetIdPFound iid -> IdPEffect.clearReplacedBy $ Data.Replaced iid
         Data.GetIdPNotFound -> pure ()
         Data.GetIdPDanglingId _ -> pure ()
         Data.GetIdPNonUnique _ -> pure ()
@@ -522,13 +522,13 @@ idpCreateXML ::
   Maybe WireIdPAPIVersion ->
   Spar r IdP
 idpCreateXML zusr raw idpmeta mReplaces (fromMaybe defWireIdPAPIVersion -> apiversion) = withDebugLog "idpCreate" (Just . show . (^. SAML.idpId)) $ do
-  teamid <- liftSem $ Brig.getZUsrCheckPerm zusr CreateUpdateDeleteIdp
-  liftSem $ GalleyAccess.assertSSOEnabled teamid
+  teamid <- Brig.getZUsrCheckPerm zusr CreateUpdateDeleteIdp
+  GalleyAccess.assertSSOEnabled teamid
   assertNoScimOrNoIdP teamid
   idp <- validateNewIdP apiversion idpmeta teamid mReplaces
-  liftSem $ IdPEffect.storeRawMetadata (idp ^. SAML.idpId) raw
+  IdPEffect.storeRawMetadata (idp ^. SAML.idpId) raw
   storeIdPConfig idp
-  forM_ mReplaces $ \replaces -> liftSem $ do
+  forM_ mReplaces $ \replaces -> do
     IdPEffect.setReplacedBy (Data.Replaced replaces) (Data.Replacing (idp ^. SAML.idpId))
   pure idp
 
@@ -546,8 +546,8 @@ assertNoScimOrNoIdP ::
   TeamId ->
   Spar r ()
 assertNoScimOrNoIdP teamid = do
-  numTokens <- length <$> liftSem (ScimTokenStore.getByTeam teamid)
-  numIdps <- length <$> liftSem (IdPEffect.getConfigsByTeam teamid)
+  numTokens <- length <$> ScimTokenStore.getByTeam teamid
+  numIdps <- length <$> IdPEffect.getConfigsByTeam teamid
   when (numTokens > 0 && numIdps > 0) $ do
     throwSparSem $
       SparProvisioningMoreThanOneIdP
@@ -589,18 +589,18 @@ validateNewIdP ::
   Maybe SAML.IdPId ->
   m IdP
 validateNewIdP apiversion _idpMetadata teamId mReplaces = withDebugLog "validateNewIdP" (Just . show . (^. SAML.idpId)) $ do
-  _idpId <- SAML.IdPId <$> liftSem Random.uuid
+  _idpId <- SAML.IdPId <$> Random.uuid
   oldIssuers :: [SAML.Issuer] <- case mReplaces of
     Nothing -> pure []
     Just replaces -> do
-      idp <- liftSem (IdPEffect.getConfig replaces) >>= maybe (throwSparSem (SparIdPNotFound (cs $ show mReplaces))) pure
+      idp <- IdPEffect.getConfig replaces >>= maybe (throwSparSem (SparIdPNotFound (cs $ show mReplaces))) pure
       pure $ (idp ^. SAML.idpMetadata . SAML.edIssuer) : (idp ^. SAML.idpExtraInfo . wiOldIssuers)
   let requri = _idpMetadata ^. SAML.edRequestURI
       _idpExtraInfo = WireIdP teamId (Just apiversion) oldIssuers Nothing
   enforceHttps requri
   idp <- getIdPConfigByIssuer (_idpMetadata ^. SAML.edIssuer) teamId
-  liftSem $ Logger.log SAML.Debug $ show (apiversion, _idpMetadata, teamId, mReplaces)
-  liftSem $ Logger.log SAML.Debug $ show (_idpId, oldIssuers, idp)
+  Logger.log SAML.Debug $ show (apiversion, _idpMetadata, teamId, mReplaces)
+  Logger.log SAML.Debug $ show (_idpId, oldIssuers, idp)
 
   let handleIdPClash :: Either id idp -> m ()
       -- (HINT: using type vars above instead of the actual types constitutes a proof that
@@ -661,8 +661,8 @@ idpUpdateXML ::
   Spar r IdP
 idpUpdateXML zusr raw idpmeta idpid = withDebugLog "idpUpdate" (Just . show . (^. SAML.idpId)) $ do
   (teamid, idp) <- validateIdPUpdate zusr idpmeta idpid
-  liftSem $ GalleyAccess.assertSSOEnabled teamid
-  liftSem $ IdPEffect.storeRawMetadata (idp ^. SAML.idpId) raw
+  GalleyAccess.assertSSOEnabled teamid
+  IdPEffect.storeRawMetadata (idp ^. SAML.idpId) raw
   -- (if raw metadata is stored and then spar goes out, raw metadata won't match the
   -- structured idp config.  since this will lead to a 5xx response, the client is epected to
   -- try again, which would clean up cassandra state.)
@@ -691,12 +691,12 @@ validateIdPUpdate ::
   m (TeamId, IdP)
 validateIdPUpdate zusr _idpMetadata _idpId = withDebugLog "validateNewIdP" (Just . show . (_2 %~ (^. SAML.idpId))) $ do
   previousIdP <-
-    liftSem (IdPEffect.getConfig _idpId) >>= \case
-      Nothing -> liftSem $ throw errUnknownIdPId
+    IdPEffect.getConfig _idpId >>= \case
+      Nothing -> throw errUnknownIdPId
       Just idp -> pure idp
-  teamId <- liftSem $ authorizeIdP zusr previousIdP
+  teamId <- authorizeIdP zusr previousIdP
   unless (previousIdP ^. SAML.idpExtraInfo . wiTeam == teamId) $ do
-    liftSem $ throw errUnknownIdP
+    throw errUnknownIdP
   _idpExtraInfo <- do
     let previousIssuer = previousIdP ^. SAML.idpMetadata . SAML.edIssuer
         newIssuer = _idpMetadata ^. SAML.edIssuer
@@ -725,10 +725,10 @@ validateIdPUpdate zusr _idpMetadata _idpId = withDebugLog "validateNewIdP" (Just
 
 withDebugLog :: Member (Logger String) r => String -> (a -> Maybe String) -> Spar r a -> Spar r a
 withDebugLog msg showval action = do
-  liftSem $ Logger.log SAML.Debug $ "entering " ++ msg
+  Logger.log SAML.Debug $ "entering " ++ msg
   val <- action
   let mshowedval = showval val
-  liftSem $ Logger.log SAML.Debug $ "leaving " ++ msg ++ mconcat [": " ++ fromJust mshowedval | isJust mshowedval]
+  Logger.log SAML.Debug $ "leaving " ++ msg ++ mconcat [": " ++ fromJust mshowedval | isJust mshowedval]
   pure val
 
 authorizeIdP ::
@@ -770,15 +770,15 @@ internalPutSsoSettings ::
   SsoSettings ->
   Spar r NoContent
 internalPutSsoSettings SsoSettings {defaultSsoCode = Nothing} = do
-  liftSem $ DefaultSsoCode.delete
+  DefaultSsoCode.delete
   pure NoContent
 internalPutSsoSettings SsoSettings {defaultSsoCode = Just code} = do
-  liftSem (IdPEffect.getConfig code) >>= \case
+  IdPEffect.getConfig code >>= \case
     Nothing ->
       -- this will return a 404, which is not quite right,
       -- but it's an internal endpoint and the message clearly says
       -- "Could not find IdP".
       throwSparSem $ SparIdPNotFound mempty
     Just _ -> do
-      liftSem $ DefaultSsoCode.store code
+      DefaultSsoCode.store code
       pure NoContent
diff --git a/services/spar/src/Spar/App.hs b/services/spar/src/Spar/App.hs
index 7fcb175a3d..107c9e782d 100644
--- a/services/spar/src/Spar/App.hs
+++ b/services/spar/src/Spar/App.hs
@@ -21,9 +21,8 @@
 
 -- | The 'Spar' monad and a set of actions (e.g. 'createUser') that can be performed in it.
 module Spar.App
-  ( Spar (..),
+  ( type Spar,
     Env (..),
-    liftSem,
     throwSparSem,
     verdictHandler,
     GetUserResult (..),
@@ -39,7 +38,6 @@ module Spar.App
     getIdPConfig,
     storeIdPConfig,
     getIdPConfigByIssuerOptionalSPId,
-    runSparInSem,
     sparToServerErrorWithLogging,
     renderSparErrorWithLogging,
   )
@@ -114,14 +112,10 @@ import Wire.API.User.IdentityProvider
 import Wire.API.User.Saml
 import Wire.API.User.Scim (ValidExternalId (..))
 
-newtype Spar r a = Spar {fromSpar :: Sem r a}
-  deriving (Functor, Applicative, Monad)
-
-liftSem :: Sem r a -> Spar r a
-liftSem = Spar
+type Spar = Sem
 
 throwSparSem :: Member (Error SparError) r => SparCustomError -> Spar r a
-throwSparSem = liftSem . throw . SAML.CustomError
+throwSparSem = throw . SAML.CustomError
 
 data Env = Env
   { sparCtxOpts :: Opts,
@@ -133,9 +127,6 @@ data Env = Env
     sparCtxRequestId :: RequestId
   }
 
-runSparInSem :: Spar r a -> Sem r a
-runSparInSem (Spar action) = action
-
 getIdPConfig ::
   Members
     '[ IdPEffect.IdP,
@@ -144,10 +135,10 @@ getIdPConfig ::
     r =>
   IdPId ->
   Spar r IdP
-getIdPConfig = (>>= maybe (throwSparSem (SparIdPNotFound mempty)) pure) . liftSem . IdPEffect.getConfig
+getIdPConfig = (>>= maybe (throwSparSem (SparIdPNotFound mempty)) pure) . IdPEffect.getConfig
 
 storeIdPConfig :: Member IdPEffect.IdP r => IdP -> Spar r ()
-storeIdPConfig idp = liftSem $ IdPEffect.storeConfig idp
+storeIdPConfig idp = IdPEffect.storeConfig idp
 
 getIdPConfigByIssuerOptionalSPId :: Members '[IdPEffect.IdP, Error SparError] r => Issuer -> Maybe TeamId -> Spar r IdP
 getIdPConfigByIssuerOptionalSPId issuer mbteam = do
@@ -159,7 +150,7 @@ getIdPConfigByIssuerOptionalSPId issuer mbteam = do
     res@(Data.GetIdPWrongTeam _) -> throwSparSem $ SparIdPNotFound (cs $ show res)
 
 insertUser :: Member SAMLUserStore r => SAML.UserRef -> UserId -> Spar r ()
-insertUser uref uid = liftSem $ SAMLUserStore.insert uref uid
+insertUser uref uid = SAMLUserStore.insert uref uid
 
 -- | Look up user locally in table @spar.user@ or @spar.scim_user@ (depending on the
 -- argument), then in brig, then return the 'UserId'.  If either lookup fails, or user is not
@@ -183,12 +174,12 @@ getUserIdByUref mbteam uref = userId <$$> getUserByUref mbteam uref
 
 getUserByUref :: Members '[BrigAccess, SAMLUserStore] r => Maybe TeamId -> SAML.UserRef -> Spar r (GetUserResult User)
 getUserByUref mbteam uref = do
-  muid <- liftSem $ SAMLUserStore.get uref
+  muid <- SAMLUserStore.get uref
   case muid of
     Nothing -> pure GetUserNotFound
     Just uid -> do
       let withpending = Intra.WithPendingInvitations -- see haddocks above
-      liftSem (Intra.getBrigUser withpending uid) >>= \case
+      Intra.getBrigUser withpending uid >>= \case
         Nothing -> pure GetUserNotFound
         Just user
           | isNothing (userTeam user) -> pure GetUserNoTeam
@@ -211,12 +202,12 @@ instance Functor GetUserResult where
 -- FUTUREWORK: Remove and reinstatate getUser, in AuthID refactoring PR
 getUserIdByScimExternalId :: Members '[BrigAccess, ScimExternalIdStore] r => TeamId -> Email -> Spar r (Maybe UserId)
 getUserIdByScimExternalId tid email = do
-  muid <- liftSem $ (ScimExternalIdStore.lookup tid email)
+  muid <- (ScimExternalIdStore.lookup tid email)
   case muid of
     Nothing -> pure Nothing
     Just uid -> do
       let withpending = Intra.WithPendingInvitations -- see haddocks above
-      itis <- liftSem $ isJust <$> Intra.getBrigUserTeam withpending uid
+      itis <- isJust <$> Intra.getBrigUserTeam withpending uid
       pure $ if itis then Just uid else Nothing
 
 -- | Create a fresh 'UserId', store it on C* locally together with 'SAML.UserRef', then
@@ -248,7 +239,7 @@ createSamlUserWithId ::
   Spar r ()
 createSamlUserWithId teamid buid suid = do
   uname <- either (throwSparSem . SparBadUserName . cs) pure $ Intra.mkUserName Nothing (UrefOnly suid)
-  buid' <- liftSem $ BrigAccess.createSAML suid buid teamid uname ManagedByWire
+  buid' <- BrigAccess.createSAML suid buid teamid uname ManagedByWire
   assert (buid == buid') $ pure ()
   insertUser suid buid
 
@@ -269,7 +260,7 @@ autoprovisionSamlUser ::
   SAML.UserRef ->
   Spar r UserId
 autoprovisionSamlUser mbteam suid = do
-  buid <- liftSem $ Id <$> Random.uuid
+  buid <- Id <$> Random.uuid
   autoprovisionSamlUserWithId mbteam buid suid
   pure buid
 
@@ -306,7 +297,7 @@ autoprovisionSamlUserWithId mbteam buid suid = do
     guardScimTokens :: IdP -> Spar r ()
     guardScimTokens idp = do
       let teamid = idp ^. idpExtraInfo . wiTeam
-      scimtoks <- liftSem $ ScimTokenStore.getByTeam teamid
+      scimtoks <- ScimTokenStore.getByTeam teamid
       unless (null scimtoks) $ do
         throwSparSem SparSamlCredentialsNotFound
 
@@ -320,10 +311,10 @@ validateEmailIfExists uid = \case
     doValidate :: SAMLEmail.Email -> Spar r ()
     doValidate email = do
       enabled <- do
-        tid <- liftSem $ Intra.getBrigUserTeam Intra.NoPendingInvitations uid
-        maybe (pure False) (liftSem . GalleyAccess.isEmailValidationEnabledTeam) tid
+        tid <- Intra.getBrigUserTeam Intra.NoPendingInvitations uid
+        maybe (pure False) (GalleyAccess.isEmailValidationEnabledTeam) tid
       when enabled $ do
-        liftSem $ BrigAccess.updateEmail uid (Intra.emailFromSAML email)
+        BrigAccess.updateEmail uid (Intra.emailFromSAML email)
 
 -- | Check if 'UserId' is in the team that hosts the idp that owns the 'UserRef'.  If so,
 -- register a the user under its SAML credentials and write the 'UserRef' into the
@@ -354,20 +345,20 @@ bindUser buid userref = do
         Data.GetIdPDanglingId _ -> err -- database inconsistency
         Data.GetIdPNonUnique is -> throwSparSem $ SparUserRefInNoOrMultipleTeams (cs $ show (buid, is))
         Data.GetIdPWrongTeam _ -> err -- impossible
-    acc <- liftSem (BrigAccess.getAccount Intra.WithPendingInvitations buid) >>= maybe err pure
+    acc <- BrigAccess.getAccount Intra.WithPendingInvitations buid >>= maybe err pure
     teamid' :: TeamId <- userTeam (accountUser acc) & maybe err pure
     unless (teamid' == teamid) err
     pure (accountStatus acc)
   insertUser userref buid
   buid <$ do
-    liftSem $ BrigAccess.setVeid buid (UrefOnly userref)
+    BrigAccess.setVeid buid (UrefOnly userref)
     let err = throwSparSem . SparBindFromBadAccountStatus . cs . show
     case oldStatus of
       Active -> pure ()
       Suspended -> err oldStatus
       Deleted -> err oldStatus
       Ephemeral -> err oldStatus
-      PendingInvitation -> liftSem $ BrigAccess.setStatus buid Active
+      PendingInvitation -> BrigAccess.setStatus buid Active
 
 -- | The from of the response on the finalize-login request depends on the verdict (denied or
 -- granted), plus the choice that the client has made during the initiate-login request.  Here we
@@ -403,9 +394,9 @@ verdictHandler cky mbteam aresp verdict = do
   -- [3/4.1.4.2]
   -- <SubjectConfirmation> [...] If the containing message is in response to an <AuthnRequest>, then
   -- the InResponseTo attribute MUST match the request's ID.
-  liftSem $ Logger.log SAML.Debug $ "entering verdictHandler: " <> show (fromBindCookie <$> cky, aresp, verdict)
+  Logger.log SAML.Debug $ "entering verdictHandler: " <> show (fromBindCookie <$> cky, aresp, verdict)
   reqid <- either (throwSparSem . SparNoRequestRefInResponse . cs) pure $ SAML.rspInResponseTo aresp
-  format :: Maybe VerdictFormat <- liftSem $ AReqIDStore.getVerdictFormat reqid
+  format :: Maybe VerdictFormat <- AReqIDStore.getVerdictFormat reqid
   resp <- case format of
     Just (VerdictFormatWeb) ->
       verdictHandlerResult cky mbteam verdict >>= verdictHandlerWeb
@@ -414,7 +405,7 @@ verdictHandler cky mbteam aresp verdict = do
     Nothing ->
       -- (this shouldn't happen too often, see 'storeVerdictFormat')
       throwSparSem SparNoSuchRequest
-  liftSem $ Logger.log SAML.Debug $ "leaving verdictHandler: " <> show resp
+  Logger.log SAML.Debug $ "leaving verdictHandler: " <> show resp
   pure resp
 
 data VerdictHandlerResult
@@ -443,9 +434,9 @@ verdictHandlerResult ::
   SAML.AccessVerdict ->
   Spar r VerdictHandlerResult
 verdictHandlerResult bindCky mbteam verdict = do
-  liftSem $ Logger.log SAML.Debug $ "entering verdictHandlerResult: " <> show (fromBindCookie <$> bindCky)
+  Logger.log SAML.Debug $ "entering verdictHandlerResult: " <> show (fromBindCookie <$> bindCky)
   result <- catchVerdictErrors $ verdictHandlerResultCore bindCky mbteam verdict
-  liftSem $ Logger.log SAML.Debug $ "leaving verdictHandlerResult" <> show result
+  Logger.log SAML.Debug $ "leaving verdictHandlerResult" <> show result
   pure result
 
 catchVerdictErrors ::
@@ -457,7 +448,7 @@ catchVerdictErrors ::
     r =>
   Spar r VerdictHandlerResult ->
   Spar r VerdictHandlerResult
-catchVerdictErrors = liftSem . (`catch` hndlr) . runSparInSem
+catchVerdictErrors = (`catch` hndlr)
   where
     hndlr :: SparError -> Sem r VerdictHandlerResult
     hndlr err = do
@@ -494,9 +485,9 @@ findUserIdWithOldIssuer mbteam (SAML.UserRef issuer subject) = do
 -- the old IdP is not needed any more next time.
 moveUserToNewIssuer :: Members '[BrigAccess, SAMLUserStore] r => SAML.UserRef -> SAML.UserRef -> UserId -> Spar r ()
 moveUserToNewIssuer oldUserRef newUserRef uid = do
-  liftSem $ SAMLUserStore.insert newUserRef uid
-  liftSem $ BrigAccess.setVeid uid (UrefOnly newUserRef)
-  liftSem $ SAMLUserStore.delete uid oldUserRef
+  SAMLUserStore.insert newUserRef uid
+  BrigAccess.setVeid uid (UrefOnly newUserRef)
+  SAMLUserStore.delete uid oldUserRef
 
 verdictHandlerResultCore ::
   HasCallStack =>
@@ -521,7 +512,7 @@ verdictHandlerResultCore bindCky mbteam = \case
     pure $ VerifyHandlerDenied reasons
   SAML.AccessGranted userref -> do
     uid :: UserId <- do
-      viaBindCookie <- maybe (pure Nothing) (liftSem . BindCookieStore.lookup) bindCky
+      viaBindCookie <- maybe (pure Nothing) (BindCookieStore.lookup) bindCky
       viaSparCassandra <- getUserIdByUref mbteam userref
       -- race conditions: if the user has been created on spar, but not on brig, 'getUser'
       -- returns 'Nothing'.  this is ok assuming 'createUser', 'bindUser' (called below) are
@@ -560,8 +551,8 @@ verdictHandlerResultCore bindCky mbteam = \case
         (Just _, GetUserFound _, GetUserFound _) ->
           -- to see why, consider the condition on the call to 'findUserWithOldIssuer' above.
           error "impossible."
-    liftSem $ Logger.log SAML.Debug ("granting sso login for " <> show uid)
-    cky <- liftSem $ BrigAccess.ssoLogin uid
+    Logger.log SAML.Debug ("granting sso login for " <> show uid)
+    cky <- BrigAccess.ssoLogin uid
     pure $ VerifyHandlerGranted cky uid
 
 -- | If the client is web, it will be served with an HTML page that it can process to decide whether
@@ -714,11 +705,11 @@ getIdPIdByIssuerAllowOld ::
   Maybe TeamId ->
   Spar r (GetIdPResult SAML.IdPId)
 getIdPIdByIssuerAllowOld issuer mbteam = do
-  mbv2 <- liftSem $ maybe (pure Nothing) (IdPEffect.getIdByIssuerWithTeam issuer) mbteam
-  mbv1v2 <- liftSem $ maybe (IdPEffect.getIdByIssuerWithoutTeam issuer) (pure . GetIdPFound) mbv2
+  mbv2 <- maybe (pure Nothing) (IdPEffect.getIdByIssuerWithTeam issuer) mbteam
+  mbv1v2 <- maybe (IdPEffect.getIdByIssuerWithoutTeam issuer) (pure . GetIdPFound) mbv2
   case (mbv1v2, mbteam) of
     (GetIdPFound idpid, Just team) -> do
-      liftSem (IdPEffect.getConfig idpid) >>= \case
+      IdPEffect.getConfig idpid >>= \case
         Nothing -> do
           pure $ GetIdPDanglingId idpid
         Just idp ->
@@ -758,7 +749,7 @@ getIdPIdByIssuer issuer = getIdPIdByIssuerAllowOld issuer . Just
 -- | (There are probably category theoretical models for what we're doing here, but it's more
 -- straight-forward to just handle the one instance we need.)
 mapGetIdPResult :: (HasCallStack, Member IdPEffect.IdP r) => GetIdPResult SAML.IdPId -> Spar r (GetIdPResult IdP)
-mapGetIdPResult (GetIdPFound i) = liftSem (IdPEffect.getConfig i) <&> maybe (GetIdPDanglingId i) GetIdPFound
+mapGetIdPResult (GetIdPFound i) = IdPEffect.getConfig i <&> maybe (GetIdPDanglingId i) GetIdPFound
 mapGetIdPResult GetIdPNotFound = pure GetIdPNotFound
 mapGetIdPResult (GetIdPDanglingId i) = pure (GetIdPDanglingId i)
 mapGetIdPResult (GetIdPNonUnique is) = pure (GetIdPNonUnique is)
@@ -769,7 +760,7 @@ deleteTeam ::
   (HasCallStack, Members '[ScimTokenStore, SAMLUserStore, IdPEffect.IdP] r) =>
   TeamId ->
   Spar r ()
-deleteTeam team = liftSem $ do
+deleteTeam team = do
   ScimTokenStore.deleteByTeam team
   -- Since IdPs are not shared between teams, we can look at the set of IdPs
   -- used by the team, and remove everything related to those IdPs, too.
diff --git a/services/spar/src/Spar/CanonicalInterpreter.hs b/services/spar/src/Spar/CanonicalInterpreter.hs
index 4aee0c3a04..d8723432fa 100644
--- a/services/spar/src/Spar/CanonicalInterpreter.hs
+++ b/services/spar/src/Spar/CanonicalInterpreter.hs
@@ -79,7 +79,7 @@ type CanonicalEffs =
    ]
 
 runSparToIO :: Env -> Spar CanonicalEffs a -> IO (Either SparError a)
-runSparToIO ctx (Spar action) =
+runSparToIO ctx action =
   runFinal
     . embedToFinal @IO
     . nowToIO
diff --git a/services/spar/src/Spar/Scim/Auth.hs b/services/spar/src/Spar/Scim/Auth.hs
index bf77601d53..68b1109a78 100644
--- a/services/spar/src/Spar/Scim/Auth.hs
+++ b/services/spar/src/Spar/Scim/Auth.hs
@@ -48,7 +48,7 @@ import Polysemy.Error
 import Polysemy.Input
 import qualified SAML2.WebSSO as SAML
 import Servant (NoContent (NoContent), ServerT, (:<|>) ((:<|>)))
-import Spar.App (Spar, liftSem, throwSparSem)
+import Spar.App (Spar, throwSparSem)
 import qualified Spar.Error as E
 import qualified Spar.Intra.BrigApp as Intra.Brig
 import Spar.Sem.BrigAccess (BrigAccess)
@@ -76,7 +76,7 @@ instance Member ScimTokenStore r => Scim.Class.Auth.AuthDB SparTag (Spar r) wher
     Scim.throwScim (Scim.unauthorized "Token not provided")
   authCheck (Just token) =
     maybe (Scim.throwScim (Scim.unauthorized "Invalid token")) pure
-      =<< lift (liftSem (ScimTokenStore.lookup token))
+      =<< lift (ScimTokenStore.lookup token)
 
 ----------------------------------------------------------------------------
 -- Token API
@@ -126,19 +126,19 @@ createScimToken ::
   Spar r CreateScimTokenResponse
 createScimToken zusr CreateScimToken {..} = do
   let descr = createScimTokenDescr
-  teamid <- liftSem $ Intra.Brig.authorizeScimTokenManagement zusr
-  liftSem $ BrigAccess.ensureReAuthorised zusr createScimTokenPassword
-  tokenNumber <- fmap length $ liftSem $ ScimTokenStore.getByTeam teamid
-  maxTokens <- liftSem $ inputs maxScimTokens
+  teamid <- Intra.Brig.authorizeScimTokenManagement zusr
+  BrigAccess.ensureReAuthorised zusr createScimTokenPassword
+  tokenNumber <- fmap length $ ScimTokenStore.getByTeam teamid
+  maxTokens <- inputs maxScimTokens
   unless (tokenNumber < maxTokens) $
     throwSparSem E.SparProvisioningTokenLimitReached
-  idps <- liftSem $ IdPEffect.getConfigsByTeam teamid
+  idps <- IdPEffect.getConfigsByTeam teamid
 
   let caseOneOrNoIdP :: Maybe SAML.IdPId -> Spar r CreateScimTokenResponse
       caseOneOrNoIdP midpid = do
-        token <- liftSem $ ScimToken . cs . ES.encode <$> Random.bytes 32
-        tokenid <- liftSem $ Random.scimTokenId
-        now <- liftSem Now.get
+        token <- ScimToken . cs . ES.encode <$> Random.bytes 32
+        tokenid <- Random.scimTokenId
+        now <- Now.get
         let info =
               ScimTokenInfo
                 { stiId = tokenid,
@@ -147,7 +147,7 @@ createScimToken zusr CreateScimToken {..} = do
                   stiIdP = midpid,
                   stiDescr = descr
                 }
-        liftSem $ ScimTokenStore.insert token info
+        ScimTokenStore.insert token info
         pure $ CreateScimTokenResponse token info
 
   case idps of
@@ -171,8 +171,8 @@ deleteScimToken ::
   ScimTokenId ->
   Spar r NoContent
 deleteScimToken zusr tokenid = do
-  teamid <- liftSem $ Intra.Brig.authorizeScimTokenManagement zusr
-  liftSem $ ScimTokenStore.delete teamid tokenid
+  teamid <- Intra.Brig.authorizeScimTokenManagement zusr
+  ScimTokenStore.delete teamid tokenid
   pure NoContent
 
 -- | > docs/reference/provisioning/scim-token.md {#RefScimTokenList}
@@ -185,5 +185,5 @@ listScimTokens ::
   Maybe UserId ->
   Spar r ScimTokenList
 listScimTokens zusr = do
-  teamid <- liftSem $ Intra.Brig.authorizeScimTokenManagement zusr
-  ScimTokenList <$> liftSem (ScimTokenStore.getByTeam teamid)
+  teamid <- Intra.Brig.authorizeScimTokenManagement zusr
+  ScimTokenList <$> ScimTokenStore.getByTeam teamid
diff --git a/services/spar/src/Spar/Scim/User.hs b/services/spar/src/Spar/Scim/User.hs
index 6139ce1c56..c5843a1873 100644
--- a/services/spar/src/Spar/Scim/User.hs
+++ b/services/spar/src/Spar/Scim/User.hs
@@ -66,7 +66,7 @@ import Network.URI (URI, parseURI)
 import Polysemy
 import Polysemy.Input
 import qualified SAML2.WebSSO as SAML
-import Spar.App (GetUserResult (..), Spar, getUserIdByScimExternalId, getUserIdByUref, liftSem, validateEmailIfExists)
+import Spar.App (GetUserResult (..), Spar, getUserIdByScimExternalId, getUserIdByUref, validateEmailIfExists)
 import qualified Spar.Intra.BrigApp as Brig
 import Spar.Scim.Auth ()
 import Spar.Scim.Types (normalizeLikeStored)
@@ -141,7 +141,7 @@ instance
           . logFilter filter'
       )
       $ do
-        mIdpConfig <- maybe (pure Nothing) (lift . liftSem . IdPEffect.getConfig) stiIdP
+        mIdpConfig <- maybe (pure Nothing) (lift . IdPEffect.getConfig) stiIdP
         case filter' of
           Scim.FilterAttrCompare (Scim.AttrPath schema attrName _subAttr) Scim.OpEq (Scim.ValString val)
             | Scim.isUserSchema schema -> do
@@ -164,9 +164,9 @@ instance
           . logTokenInfo tokeninfo
       )
       $ do
-        mIdpConfig <- maybe (pure Nothing) (lift . liftSem . IdPEffect.getConfig) stiIdP
+        mIdpConfig <- maybe (pure Nothing) (lift . IdPEffect.getConfig) stiIdP
         let notfound = Scim.notFound "User" (idToText uid)
-        brigUser <- lift (liftSem $ BrigAccess.getAccount Brig.WithPendingInvitations uid) >>= maybe (throwError notfound) pure
+        brigUser <- lift (BrigAccess.getAccount Brig.WithPendingInvitations uid) >>= maybe (throwError notfound) pure
         unless (userTeam (accountUser brigUser) == Just stiTeam) (throwError notfound)
         case Brig.veidFromBrigUser (accountUser brigUser) ((^. SAML.idpMetadata . SAML.edIssuer) <$> mIdpConfig) of
           Right veid -> synthesizeStoredUser brigUser veid
@@ -210,12 +210,12 @@ validateScimUser ::
   m ST.ValidScimUser
 validateScimUser tokinfo user = do
   mIdpConfig <- tokenInfoToIdP tokinfo
-  richInfoLimit <- lift $ liftSem $ inputs richInfoLimit
+  richInfoLimit <- lift $ inputs richInfoLimit
   validateScimUser' mIdpConfig richInfoLimit user
 
 tokenInfoToIdP :: Member IdPEffect.IdP r => ScimTokenInfo -> Scim.ScimHandler (Spar r) (Maybe IdP)
 tokenInfoToIdP ScimTokenInfo {stiIdP} = do
-  maybe (pure Nothing) (lift . liftSem . IdPEffect.getConfig) stiIdP
+  maybe (pure Nothing) (lift . IdPEffect.getConfig) stiIdP
 
 -- | Validate a handle (@userName@).
 validateHandle :: MonadError Scim.ScimError m => Text -> m Handle
@@ -351,10 +351,10 @@ logScim context action =
               case Scim.detail e of
                 Just d -> d
                 Nothing -> cs (Aeson.encode e)
-        liftSem $ Logger.warn $ context . Log.msg errorMsg
+        Logger.warn $ context . Log.msg errorMsg
         pure (Left e)
       Right x -> do
-        liftSem $ Logger.info $ context . Log.msg @Text "call without exception"
+        Logger.info $ context . Log.msg @Text "call without exception"
         pure (Right x)
 
 logEmail :: Email -> (Msg -> Msg)
@@ -431,23 +431,23 @@ createValidScimUser tokeninfo@ScimTokenInfo {stiTeam} vsu@(ST.ValidScimUser veid
           buid <-
             ST.runValidExternalId
               ( \uref ->
-                  liftSem $ do
+                  do
                     uid <- Id <$> Random.uuid
                     BrigAccess.createSAML uref uid stiTeam name ManagedByScim
               )
               ( \email -> do
-                  liftSem $ BrigAccess.createNoSAML email stiTeam name
+                  BrigAccess.createNoSAML email stiTeam name
               )
               veid
 
-          liftSem $ Logger.debug ("createValidScimUser: brig says " <> show buid)
+          Logger.debug ("createValidScimUser: brig says " <> show buid)
 
           -- {If we crash now, we have an active user that cannot login. And can not
           -- be bound this will be a zombie user that needs to be manually cleaned
           -- up.  We should consider making setUserHandle part of createUser and
           -- making it transactional.  If the user redoes the POST A new standalone
           -- user will be created.}
-          liftSem $ do
+          do
             BrigAccess.setHandle buid handl
             BrigAccess.setRichInfo buid richInfo
           pure buid
@@ -462,13 +462,13 @@ createValidScimUser tokeninfo@ScimTokenInfo {stiTeam} vsu@(ST.ValidScimUser veid
       -- to reload the Account from brig.
       storedUser <- do
         acc <-
-          lift (liftSem $ BrigAccess.getAccount Brig.WithPendingInvitations buid)
+          lift (BrigAccess.getAccount Brig.WithPendingInvitations buid)
             >>= maybe (throwError $ Scim.serverError "Server error: user vanished") pure
         synthesizeStoredUser acc veid
-      lift $ liftSem $ Logger.debug ("createValidScimUser: spar says " <> show storedUser)
+      lift $ Logger.debug ("createValidScimUser: spar says " <> show storedUser)
 
       -- {(arianvp): these two actions we probably want to make transactional.}
-      lift . liftSem $ do
+      lift $ do
         -- Store scim timestamps, saml credentials, scim externalId locally in spar.
         ScimUserTimesStore.write storedUser
         ST.runValidExternalId
@@ -481,10 +481,10 @@ createValidScimUser tokeninfo@ScimTokenInfo {stiTeam} vsu@(ST.ValidScimUser veid
 
       -- {suspension via scim: if we don't reach the following line, the user will be active.}
       lift $ do
-        old <- liftSem $ BrigAccess.getStatus buid
+        old <- BrigAccess.getStatus buid
         let new = ST.scimActiveFlagToAccountStatus old (Scim.unScimBool <$> active)
             active = Scim.active . Scim.value . Scim.thing $ storedUser
-        when (new /= old) $ liftSem $ BrigAccess.setStatus buid new
+        when (new /= old) $ BrigAccess.setStatus buid new
       pure storedUser
 
 -- TODO(arianvp): how do we get this safe w.r.t. race conditions / crashes?
@@ -540,22 +540,21 @@ updateValidScimUser tokinfo@ScimTokenInfo {stiTeam} uid newValidScimUser =
             _ -> pure ()
 
           when (newValidScimUser ^. ST.vsuName /= oldValidScimUser ^. ST.vsuName) $ do
-            liftSem $ BrigAccess.setName uid (newValidScimUser ^. ST.vsuName)
+            BrigAccess.setName uid (newValidScimUser ^. ST.vsuName)
 
           when (oldValidScimUser ^. ST.vsuHandle /= newValidScimUser ^. ST.vsuHandle) $ do
-            liftSem $ BrigAccess.setHandle uid (newValidScimUser ^. ST.vsuHandle)
+            BrigAccess.setHandle uid (newValidScimUser ^. ST.vsuHandle)
 
           when (oldValidScimUser ^. ST.vsuRichInfo /= newValidScimUser ^. ST.vsuRichInfo) $ do
-            liftSem $ BrigAccess.setRichInfo uid (newValidScimUser ^. ST.vsuRichInfo)
+            BrigAccess.setRichInfo uid (newValidScimUser ^. ST.vsuRichInfo)
 
-          liftSem $
-            BrigAccess.getStatusMaybe uid >>= \case
-              Nothing -> pure ()
-              Just old -> do
-                let new = ST.scimActiveFlagToAccountStatus old (Just $ newValidScimUser ^. ST.vsuActive)
-                when (new /= old) $ BrigAccess.setStatus uid new
+          BrigAccess.getStatusMaybe uid >>= \case
+            Nothing -> pure ()
+            Just old -> do
+              let new = ST.scimActiveFlagToAccountStatus old (Just $ newValidScimUser ^. ST.vsuActive)
+              when (new /= old) $ BrigAccess.setStatus uid new
 
-          liftSem $ ScimUserTimesStore.write newScimStoredUser
+          ScimUserTimesStore.write newScimStoredUser
           pure newScimStoredUser
 
 updateVsuUref ::
@@ -577,11 +576,11 @@ updateVsuUref team uid old new = do
     (mo, mn@(Just newuref)) | mo /= mn -> validateEmailIfExists uid newuref
     _ -> pure ()
 
-  liftSem $ do
+  do
     old & ST.runValidExternalId (SAMLUserStore.delete uid) (ScimExternalIdStore.delete team)
     new & ST.runValidExternalId (`SAMLUserStore.insert` uid) (\email -> ScimExternalIdStore.insert team email uid)
 
-  liftSem $ BrigAccess.setVeid uid new
+  BrigAccess.setVeid uid new
 
 toScimStoredUser' ::
   HasCallStack =>
@@ -620,7 +619,7 @@ updScimStoredUser ::
   Scim.StoredUser ST.SparTag ->
   Spar r (Scim.StoredUser ST.SparTag)
 updScimStoredUser usr storedusr = do
-  SAML.Time (toUTCTimeMillis -> now) <- liftSem Now.get
+  SAML.Time (toUTCTimeMillis -> now) <- Now.get
   pure $ updScimStoredUser' now usr storedusr
 
 updScimStoredUser' ::
@@ -657,7 +656,7 @@ deleteScimUser tokeninfo@ScimTokenInfo {stiTeam, stiIdP} uid =
         . logUser uid
     )
     $ do
-      mbBrigUser <- lift (liftSem $ Brig.getBrigUser Brig.WithPendingInvitations uid)
+      mbBrigUser <- lift (Brig.getBrigUser Brig.WithPendingInvitations uid)
       case mbBrigUser of
         Nothing -> do
           -- double-deletion gets you a 404.
@@ -671,19 +670,19 @@ deleteScimUser tokeninfo@ScimTokenInfo {stiTeam, stiIdP} uid =
             throwError $
               Scim.notFound "user" (idToText uid)
 
-          mIdpConfig <- maybe (pure Nothing) (lift . liftSem . IdPEffect.getConfig) stiIdP
+          mIdpConfig <- maybe (pure Nothing) (lift . IdPEffect.getConfig) stiIdP
 
           case Brig.veidFromBrigUser brigUser ((^. SAML.idpMetadata . SAML.edIssuer) <$> mIdpConfig) of
             Left _ -> pure ()
             Right veid ->
-              lift . liftSem $
+              lift $
                 ST.runValidExternalId
                   (SAMLUserStore.delete uid)
                   (ScimExternalIdStore.delete stiTeam)
                   veid
 
-          lift . liftSem $ ScimUserTimesStore.delete uid
-          lift . liftSem $ BrigAccess.delete uid
+          lift $ ScimUserTimesStore.delete uid
+          lift $ BrigAccess.delete uid
           return ()
 
 ----------------------------------------------------------------------------
@@ -757,13 +756,13 @@ assertHandleUnused = assertHandleUnused' "userName is already taken"
 
 assertHandleUnused' :: Member BrigAccess r => Text -> Handle -> Scim.ScimHandler (Spar r) ()
 assertHandleUnused' msg hndl =
-  lift (liftSem $ BrigAccess.checkHandleAvailable hndl) >>= \case
+  lift (BrigAccess.checkHandleAvailable hndl) >>= \case
     True -> pure ()
     False -> throwError Scim.conflict {Scim.detail = Just msg}
 
 assertHandleNotUsedElsewhere :: Member BrigAccess r => UserId -> Handle -> Scim.ScimHandler (Spar r) ()
 assertHandleNotUsedElsewhere uid hndl = do
-  musr <- lift $ liftSem $ Brig.getBrigUser Brig.WithPendingInvitations uid
+  musr <- lift $ Brig.getBrigUser Brig.WithPendingInvitations uid
   unless ((userHandle =<< musr) == Just hndl) $
     assertHandleUnused' "userName already in use by another wire user" hndl
 
@@ -797,26 +796,26 @@ synthesizeStoredUser usr veid =
 
       let readState :: Spar r (RI.RichInfo, Maybe (UTCTimeMillis, UTCTimeMillis), URIBS.URI)
           readState = do
-            richInfo <- liftSem $ BrigAccess.getRichInfo uid
-            accessTimes <- liftSem (ScimUserTimesStore.read uid)
-            baseuri <- liftSem $ inputs $ derivedOptsScimBaseURI . derivedOpts
+            richInfo <- BrigAccess.getRichInfo uid
+            accessTimes <- ScimUserTimesStore.read uid
+            baseuri <- inputs $ derivedOptsScimBaseURI . derivedOpts
             pure (richInfo, accessTimes, baseuri)
 
       let writeState :: Maybe (UTCTimeMillis, UTCTimeMillis) -> ManagedBy -> RI.RichInfo -> Scim.StoredUser ST.SparTag -> Spar r ()
           writeState oldAccessTimes oldManagedBy oldRichInfo storedUser = do
             when (isNothing oldAccessTimes) $ do
-              liftSem $ ScimUserTimesStore.write storedUser
+              ScimUserTimesStore.write storedUser
             when (oldManagedBy /= ManagedByScim) $ do
-              liftSem $ BrigAccess.setManagedBy uid ManagedByScim
+              BrigAccess.setManagedBy uid ManagedByScim
             let newRichInfo = view ST.sueRichInfo . Scim.extra . Scim.value . Scim.thing $ storedUser
             when (oldRichInfo /= newRichInfo) $ do
-              liftSem $ BrigAccess.setRichInfo uid newRichInfo
+              BrigAccess.setRichInfo uid newRichInfo
 
       (richInfo, accessTimes, baseuri) <- lift readState
-      SAML.Time (toUTCTimeMillis -> now) <- lift $ liftSem Now.get
+      SAML.Time (toUTCTimeMillis -> now) <- lift Now.get
       let (createdAt, lastUpdatedAt) = fromMaybe (now, now) accessTimes
 
-      handle <- lift $ liftSem $ Brig.giveDefaultHandle (accountUser usr)
+      handle <- lift $ Brig.giveDefaultHandle (accountUser usr)
 
       storedUser <-
         synthesizeStoredUser'
@@ -883,7 +882,7 @@ scimFindUserByHandle ::
   MaybeT (Scim.ScimHandler (Spar r)) (Scim.StoredUser ST.SparTag)
 scimFindUserByHandle mIdpConfig stiTeam hndl = do
   handle <- MaybeT . pure . parseHandle . Text.toLower $ hndl
-  brigUser <- MaybeT . lift . liftSem . BrigAccess.getByHandle $ handle
+  brigUser <- MaybeT . lift . BrigAccess.getByHandle $ handle
   guard $ userTeam (accountUser brigUser) == Just stiTeam
   case Brig.veidFromBrigUser (accountUser brigUser) ((^. SAML.idpMetadata . SAML.edIssuer) <$> mIdpConfig) of
     Right veid -> lift $ synthesizeStoredUser brigUser veid
@@ -920,13 +919,13 @@ scimFindUserByEmail mIdpConfig stiTeam email = do
   -- a UUID, or any other text that is valid according to SCIM.
   veid <- MaybeT (either (const Nothing) Just <$> runExceptT (mkValidExternalId mIdpConfig (pure email)))
   uid <- MaybeT . lift $ ST.runValidExternalId withUref withEmailOnly veid
-  brigUser <- MaybeT . lift . liftSem . BrigAccess.getAccount Brig.WithPendingInvitations $ uid
+  brigUser <- MaybeT . lift . BrigAccess.getAccount Brig.WithPendingInvitations $ uid
   guard $ userTeam (accountUser brigUser) == Just stiTeam
   lift $ synthesizeStoredUser brigUser veid
   where
     withUref :: SAML.UserRef -> Spar r (Maybe UserId)
     withUref uref = do
-      liftSem (SAMLUserStore.get uref) >>= \case
+      SAMLUserStore.get uref >>= \case
         Nothing -> maybe (pure Nothing) withEmailOnly $ Brig.urefToEmail uref
         Just uid -> pure (Just uid)
 
@@ -936,8 +935,8 @@ scimFindUserByEmail mIdpConfig stiTeam email = do
         -- FUTUREWORK: we could also always lookup brig, that's simpler and possibly faster,
         -- and it never should be visible in spar, but not in brig.
         inspar, inbrig :: Spar r (Maybe UserId)
-        inspar = liftSem $ ScimExternalIdStore.lookup stiTeam eml
-        inbrig = liftSem $ userId . accountUser <$$> BrigAccess.getByEmail eml
+        inspar = ScimExternalIdStore.lookup stiTeam eml
+        inbrig = userId . accountUser <$$> BrigAccess.getByEmail eml
 
 logFilter :: Filter -> (Msg -> Msg)
 logFilter (FilterAttrCompare attr op val) =
diff --git a/services/spar/src/Spar/Sem/SAML2/Library.hs b/services/spar/src/Spar/Sem/SAML2/Library.hs
index d3ebe1d26c..9c8be48238 100644
--- a/services/spar/src/Spar/Sem/SAML2/Library.hs
+++ b/services/spar/src/Spar/Sem/SAML2/Library.hs
@@ -75,9 +75,9 @@ instance Members '[Error SparError, IdPEffect.IdP, Final IO] r => SPStoreIdP Spa
   type IdPConfigExtra (SPImpl r) = WireIdP
   type IdPConfigSPId (SPImpl r) = TeamId
 
-  storeIdPConfig = SPImpl . App.runSparInSem . App.storeIdPConfig
-  getIdPConfig = SPImpl . App.runSparInSem . App.getIdPConfig
-  getIdPConfigByIssuerOptionalSPId a = SPImpl . App.runSparInSem . App.getIdPConfigByIssuerOptionalSPId a
+  storeIdPConfig = SPImpl . App.storeIdPConfig
+  getIdPConfig = SPImpl . App.getIdPConfig
+  getIdPConfigByIssuerOptionalSPId a = SPImpl . App.getIdPConfigByIssuerOptionalSPId a
 
 instance Member (Error SparError) r => MonadError SparError (SPImpl r) where
   throwError = SPImpl . throw
diff --git a/services/spar/test-integration/Test/Spar/APISpec.hs b/services/spar/test-integration/Test/Spar/APISpec.hs
index 57afed49fd..7685df8517 100644
--- a/services/spar/test-integration/Test/Spar/APISpec.hs
+++ b/services/spar/test-integration/Test/Spar/APISpec.hs
@@ -70,7 +70,6 @@ import qualified SAML2.WebSSO as SAML
 import SAML2.WebSSO.Test.Lenses
 import SAML2.WebSSO.Test.MockResponse
 import SAML2.WebSSO.Test.Util
-import Spar.App (liftSem)
 import qualified Spar.Intra.BrigApp as Intra
 import qualified Spar.Sem.BrigAccess as BrigAccess
 import qualified Spar.Sem.IdP as IdPEffect
@@ -870,7 +869,7 @@ specCRUDIdentityProvider = do
           pure $ idpmeta1 & edIssuer .~ (idpmeta3 ^. edIssuer)
 
         do
-          midp <- runSpar $ liftSem $ IdPEffect.getConfig idpid1
+          midp <- runSpar $ IdPEffect.getConfig idpid1
           liftIO $ do
             (midp ^? _Just . idpMetadata . edIssuer) `shouldBe` Just (idpmeta1 ^. edIssuer)
             (midp ^? _Just . idpExtraInfo . wiOldIssuers) `shouldBe` Just []
@@ -883,7 +882,7 @@ specCRUDIdentityProvider = do
               resp <- call $ callIdpUpdate' (env ^. teSpar) (Just owner1) idpid1 (IdPMetadataValue (cs $ SAML.encode new) undefined)
               liftIO $ statusCode resp `shouldBe` 200
 
-              midp <- runSpar $ liftSem $ IdPEffect.getConfig idpid1
+              midp <- runSpar $ IdPEffect.getConfig idpid1
               liftIO $ do
                 (midp ^? _Just . idpMetadata . edIssuer) `shouldBe` Just (new ^. edIssuer)
                 sort <$> (midp ^? _Just . idpExtraInfo . wiOldIssuers) `shouldBe` Just (sort $ olds <&> (^. edIssuer))
@@ -1298,7 +1297,7 @@ specDeleteCornerCases = describe "delete corner cases" $ do
       brig <- view teBrig
       resp <- call . delete $ brig . paths ["i", "users", toByteString' uid]
       liftIO $ responseStatus resp `shouldBe` status202
-      void $ aFewTimes (runSpar $ liftSem $ BrigAccess.getStatus uid) (== Deleted)
+      void $ aFewTimes (runSpar $ BrigAccess.getStatus uid) (== Deleted)
 
 specScimAndSAML :: SpecWith TestEnv
 specScimAndSAML = do
diff --git a/services/spar/test-integration/Test/Spar/AppSpec.hs b/services/spar/test-integration/Test/Spar/AppSpec.hs
index 0ee8760f00..5f38b3830a 100644
--- a/services/spar/test-integration/Test/Spar/AppSpec.hs
+++ b/services/spar/test-integration/Test/Spar/AppSpec.hs
@@ -33,7 +33,6 @@ import Imports
 import SAML2.WebSSO as SAML
 import qualified SAML2.WebSSO.Test.MockResponse as SAML
 import qualified Servant
-import Spar.App (liftSem)
 import qualified Spar.App as Spar
 import Spar.Orphans ()
 import qualified Spar.Sem.SAMLUserStore as SAMLUserStore
@@ -181,5 +180,5 @@ requestAccessVerdict idp isGranted mkAuthnReq = do
           $ outcome
       qry :: [(SBS, SBS)]
       qry = queryPairs $ uriQuery loc
-  muid <- runSpar $ liftSem $ SAMLUserStore.get uref
+  muid <- runSpar $ SAMLUserStore.get uref
   pure (muid, outcome, loc, qry)
diff --git a/services/spar/test-integration/Test/Spar/DataSpec.hs b/services/spar/test-integration/Test/Spar/DataSpec.hs
index a294653fe3..2c66752773 100644
--- a/services/spar/test-integration/Test/Spar/DataSpec.hs
+++ b/services/spar/test-integration/Test/Spar/DataSpec.hs
@@ -72,7 +72,7 @@ spec = do
       (_, _, (^. SAML.idpId) -> idpid) <- registerTestIdP
       (_, req) <- call $ callAuthnReq (env ^. teSpar) idpid
       let probe :: (MonadIO m, MonadReader TestEnv m) => m Bool
-          probe = runSpar $ liftSem $ AReqIDStore.isAlive (req ^. SAML.rqID)
+          probe = runSpar $ AReqIDStore.isAlive (req ^. SAML.rqID)
           maxttl :: Int -- musec
           maxttl = (fromIntegral . fromTTL $ env ^. teOpts . to maxttlAuthreq) * 1000 * 1000
       liftIO $ maxttl `shouldSatisfy` (< 60 * 1000 * 1000) -- otherwise the test will be really slow.
@@ -93,8 +93,8 @@ spec = do
       context "insert and get are \"inverses\"" $ do
         let check vf = it (show vf) $ do
               vid <- nextSAMLID
-              () <- runSpar $ liftSem $ AReqIDStore.storeVerdictFormat 1 vid vf
-              mvf <- runSpar $ liftSem $ AReqIDStore.getVerdictFormat vid
+              () <- runSpar $ AReqIDStore.storeVerdictFormat 1 vid vf
+              mvf <- runSpar $ AReqIDStore.getVerdictFormat vid
               liftIO $ mvf `shouldBe` Just vf
         check
           `mapM_` [ VerdictFormatWeb,
@@ -103,47 +103,47 @@ spec = do
       context "has timed out" $ do
         it "AReqIDStore.getVerdictFormat returns Nothing" $ do
           vid <- nextSAMLID
-          () <- runSpar $ liftSem $ AReqIDStore.storeVerdictFormat 1 vid VerdictFormatWeb
+          () <- runSpar $ AReqIDStore.storeVerdictFormat 1 vid VerdictFormatWeb
           liftIO $ threadDelay 2000000
-          mvf <- runSpar $ liftSem $ AReqIDStore.getVerdictFormat vid
+          mvf <- runSpar $ AReqIDStore.getVerdictFormat vid
           liftIO $ mvf `shouldBe` Nothing
       context "does not exist" $ do
         it "AReqIDStore.getVerdictFormat returns Nothing" $ do
           vid <- nextSAMLID
-          mvf <- runSpar $ liftSem $ AReqIDStore.getVerdictFormat vid
+          mvf <- runSpar $ AReqIDStore.getVerdictFormat vid
           liftIO $ mvf `shouldBe` Nothing
     describe "User" $ do
       context "user is new" $ do
         it "getUser returns Nothing" $ do
           uref <- nextUserRef
-          muid <- runSpar $ liftSem $ SAMLUserStore.get uref
+          muid <- runSpar $ SAMLUserStore.get uref
           liftIO $ muid `shouldBe` Nothing
         it "inserts new user and responds with 201 / returns new user" $ do
           uref <- nextUserRef
           uid <- nextWireId
-          () <- runSpar $ liftSem $ SAMLUserStore.insert uref uid
-          muid <- runSpar $ liftSem $ SAMLUserStore.get uref
+          () <- runSpar $ SAMLUserStore.insert uref uid
+          muid <- runSpar $ SAMLUserStore.get uref
           liftIO $ muid `shouldBe` Just uid
       context "user already exists (idempotency)" $ do
         it "inserts new user and responds with 201 / returns new user" $ do
           uref <- nextUserRef
           uid <- nextWireId
           uid' <- nextWireId
-          () <- runSpar $ liftSem $ SAMLUserStore.insert uref uid
-          () <- runSpar $ liftSem $ SAMLUserStore.insert uref uid'
-          muid <- runSpar $ liftSem $ SAMLUserStore.get uref
+          () <- runSpar $ SAMLUserStore.insert uref uid
+          () <- runSpar $ SAMLUserStore.insert uref uid'
+          muid <- runSpar $ SAMLUserStore.get uref
           liftIO $ muid `shouldBe` Just uid'
       describe "DELETE" $ do
         it "works" $ do
           uref <- nextUserRef
           uid <- nextWireId
           do
-            () <- runSpar $ liftSem $ SAMLUserStore.insert uref uid
-            muid <- runSpar $ liftSem (SAMLUserStore.get uref)
+            () <- runSpar $ SAMLUserStore.insert uref uid
+            muid <- runSpar $ SAMLUserStore.get uref
             liftIO $ muid `shouldBe` Just uid
           do
-            () <- runSpar $ liftSem $ SAMLUserStore.delete uid uref
-            muid <- runSpar (liftSem $ SAMLUserStore.get uref) `aFewTimes` isNothing
+            () <- runSpar $ SAMLUserStore.delete uid uref
+            muid <- runSpar (SAMLUserStore.get uref) `aFewTimes` isNothing
             liftIO $ muid `shouldBe` Nothing
     describe "BindCookie" $ do
       let mkcky :: TestSpar SetBindCookie
@@ -151,58 +151,58 @@ spec = do
       it "insert and get are \"inverses\"" $ do
         uid <- nextWireId
         cky <- mkcky
-        () <- runSpar $ liftSem $ BindCookieStore.insert cky uid 1
-        muid <- runSpar $ liftSem $ BindCookieStore.lookup (setBindCookieValue cky)
+        () <- runSpar $ BindCookieStore.insert cky uid 1
+        muid <- runSpar $ BindCookieStore.lookup (setBindCookieValue cky)
         liftIO $ muid `shouldBe` Just uid
       context "has timed out" $ do
         it "BindCookieStore.lookup returns Nothing" $ do
           uid <- nextWireId
           cky <- mkcky
-          () <- runSpar $ liftSem $ BindCookieStore.insert cky uid 1
+          () <- runSpar $ BindCookieStore.insert cky uid 1
           liftIO $ threadDelay 2000000
-          muid <- runSpar $ liftSem $ BindCookieStore.lookup (setBindCookieValue cky)
+          muid <- runSpar $ BindCookieStore.lookup (setBindCookieValue cky)
           liftIO $ muid `shouldBe` Nothing
       context "does not exist" $ do
         it "BindCookieStore.lookup returns Nothing" $ do
           cky <- mkcky
-          muid <- runSpar $ liftSem $ BindCookieStore.lookup (setBindCookieValue cky)
+          muid <- runSpar $ BindCookieStore.lookup (setBindCookieValue cky)
           liftIO $ muid `shouldBe` Nothing
     describe "Team" $ do
       testDeleteTeam
     describe "IdPConfig" $ do
       it "storeIdPConfig, getIdPConfig are \"inverses\"" $ do
         idp <- makeTestIdP
-        () <- runSpar $ liftSem $ IdPEffect.storeConfig idp
-        midp <- runSpar $ liftSem $ IdPEffect.getConfig (idp ^. idpId)
+        () <- runSpar $ IdPEffect.storeConfig idp
+        midp <- runSpar $ IdPEffect.getConfig (idp ^. idpId)
         liftIO $ midp `shouldBe` Just idp
       it "getIdPConfigByIssuer works" $ do
         idp <- makeTestIdP
-        () <- runSpar $ liftSem $ IdPEffect.storeConfig idp
+        () <- runSpar $ IdPEffect.storeConfig idp
         midp <- runSpar $ App.getIdPConfigByIssuer (idp ^. idpMetadata . edIssuer) (idp ^. SAML.idpExtraInfo . wiTeam)
         liftIO $ midp `shouldBe` GetIdPFound idp
       it "getIdPIdByIssuer works" $ do
         idp <- makeTestIdP
-        () <- runSpar $ liftSem $ IdPEffect.storeConfig idp
+        () <- runSpar $ IdPEffect.storeConfig idp
         midp <- runSpar $ App.getIdPIdByIssuer (idp ^. idpMetadata . edIssuer) (idp ^. SAML.idpExtraInfo . wiTeam)
         liftIO $ midp `shouldBe` GetIdPFound (idp ^. idpId)
       it "getIdPConfigsByTeam works" $ do
         skipIdPAPIVersions [WireIdPAPIV1]
         teamid <- nextWireId
         idp <- makeTestIdP <&> idpExtraInfo .~ (WireIdP teamid Nothing [] Nothing)
-        () <- runSpar $ liftSem $ IdPEffect.storeConfig idp
-        idps <- runSpar $ liftSem $ IdPEffect.getConfigsByTeam teamid
+        () <- runSpar $ IdPEffect.storeConfig idp
+        idps <- runSpar $ IdPEffect.getConfigsByTeam teamid
         liftIO $ idps `shouldBe` [idp]
       it "deleteIdPConfig works" $ do
         teamid <- nextWireId
         idpApiVersion <- asks (^. teWireIdPAPIVersion)
         idp <- makeTestIdP <&> idpExtraInfo .~ (WireIdP teamid (Just idpApiVersion) [] Nothing)
-        () <- runSpar $ liftSem $ IdPEffect.storeConfig idp
+        () <- runSpar $ IdPEffect.storeConfig idp
         do
-          midp <- runSpar $ liftSem $ IdPEffect.getConfig (idp ^. idpId)
+          midp <- runSpar $ IdPEffect.getConfig (idp ^. idpId)
           liftIO $ midp `shouldBe` Just idp
-        () <- runSpar $ liftSem $ IdPEffect.deleteConfig (idp ^. idpId) (idp ^. idpMetadata . edIssuer) teamid
+        () <- runSpar $ IdPEffect.deleteConfig (idp ^. idpId) (idp ^. idpMetadata . edIssuer) teamid
         do
-          midp <- runSpar $ liftSem $ IdPEffect.getConfig (idp ^. idpId)
+          midp <- runSpar $ IdPEffect.getConfig (idp ^. idpId)
           liftIO $ midp `shouldBe` Nothing
         do
           midp <- runSpar $ App.getIdPConfigByIssuer (idp ^. idpMetadata . edIssuer) (idp ^. SAML.idpExtraInfo . wiTeam)
@@ -211,18 +211,18 @@ spec = do
           midp <- runSpar $ App.getIdPIdByIssuer (idp ^. idpMetadata . edIssuer) (idp ^. SAML.idpExtraInfo . wiTeam)
           liftIO $ midp `shouldBe` GetIdPNotFound
         do
-          idps <- runSpar $ liftSem $ IdPEffect.getConfigsByTeam teamid
+          idps <- runSpar $ IdPEffect.getConfigsByTeam teamid
           liftIO $ idps `shouldBe` []
       describe "{set,clear}ReplacedBy" $ do
         it "handle non-existent idps gradefully" $ do
           pendingWith "this requires a cql{,-io} upgrade.  https://gitlab.com/twittner/cql-io/-/issues/7"
           idp1 <- makeTestIdP
           idp2 <- makeTestIdP
-          runSpar $ liftSem $ IdPEffect.setReplacedBy (Data.Replaced (idp1 ^. idpId)) (Data.Replacing (idp2 ^. idpId))
-          idp1' <- runSpar $ liftSem (IdPEffect.getConfig (idp1 ^. idpId))
+          runSpar $ IdPEffect.setReplacedBy (Data.Replaced (idp1 ^. idpId)) (Data.Replacing (idp2 ^. idpId))
+          idp1' <- runSpar $ IdPEffect.getConfig (idp1 ^. idpId)
           liftIO $ idp1' `shouldBe` Nothing
-          runSpar $ liftSem $ IdPEffect.clearReplacedBy (Data.Replaced (idp1 ^. idpId))
-          idp2' <- runSpar $ liftSem (IdPEffect.getConfig (idp1 ^. idpId))
+          runSpar $ IdPEffect.clearReplacedBy (Data.Replaced (idp1 ^. idpId))
+          idp2' <- runSpar $ IdPEffect.getConfig (idp1 ^. idpId)
           liftIO $ idp2' `shouldBe` Nothing
 
 -- TODO(sandy): This function should be more polymorphic over it's polysemy
@@ -240,24 +240,24 @@ testSPStoreID store unstore isalive = do
       it "isAliveID is True" $ do
         xid :: SAML.ID a <- nextSAMLID
         eol :: Time <- addTime 5 <$> runSimpleSP getNow
-        () <- runSpar $ liftSem $ store xid eol
-        isit <- runSpar $ liftSem $ isalive xid
+        () <- runSpar $ store xid eol
+        isit <- runSpar $ isalive xid
         liftIO $ isit `shouldBe` True
     context "after TTL" $ do
       it "isAliveID returns False" $ do
         xid :: SAML.ID a <- nextSAMLID
         eol :: Time <- addTime 2 <$> runSimpleSP getNow
-        () <- runSpar $ liftSem $ store xid eol
+        () <- runSpar $ store xid eol
         liftIO $ threadDelay 3000000
-        isit <- runSpar $ liftSem $ isalive xid
+        isit <- runSpar $ isalive xid
         liftIO $ isit `shouldBe` False
     context "after call to unstore" $ do
       it "isAliveID returns False" $ do
         xid :: SAML.ID a <- nextSAMLID
         eol :: Time <- addTime 5 <$> runSimpleSP getNow
-        () <- runSpar $ liftSem $ store xid eol
-        () <- runSpar $ liftSem $ unstore xid
-        isit <- runSpar $ liftSem $ isalive xid
+        () <- runSpar $ store xid eol
+        () <- runSpar $ unstore xid
+        isit <- runSpar $ isalive xid
         liftIO $ isit `shouldBe` False
 
 -- | Test that when a team is deleted, all relevant data is pruned from the
@@ -280,38 +280,36 @@ testDeleteTeam = it "cleans up all the right tables after deletion" $ do
   --
   -- The token from 'team_provisioning_by_token':
   do
-    tokenInfo <- runSpar $ liftSem $ ScimTokenStore.lookup tok
+    tokenInfo <- runSpar $ ScimTokenStore.lookup tok
     liftIO $ tokenInfo `shouldBe` Nothing
   -- The team from 'team_provisioning_by_team':
   do
-    tokens <- runSpar $ liftSem $ ScimTokenStore.getByTeam tid
+    tokens <- runSpar $ ScimTokenStore.getByTeam tid
     liftIO $ tokens `shouldBe` []
   -- The users from 'user':
   do
     mbUser1 <- case veidFromUserSSOId ssoid1 of
       Right veid ->
         runSpar $
-          liftSem $
-            runValidExternalId
-              SAMLUserStore.get
-              undefined -- could be @Data.lookupScimExternalId@, but we don't hit that path.
-              veid
+          runValidExternalId
+            SAMLUserStore.get
+            undefined -- could be @Data.lookupScimExternalId@, but we don't hit that path.
+            veid
       Left _email -> undefined -- runSparCass . Data.lookupScimExternalId . fromEmail $ _email
     liftIO $ mbUser1 `shouldBe` Nothing
   do
     mbUser2 <- case veidFromUserSSOId ssoid2 of
       Right veid ->
         runSpar $
-          liftSem $
-            runValidExternalId
-              SAMLUserStore.get
-              undefined
-              veid
+          runValidExternalId
+            SAMLUserStore.get
+            undefined
+            veid
       Left _email -> undefined
     liftIO $ mbUser2 `shouldBe` Nothing
   -- The config from 'idp':
   do
-    mbIdp <- runSpar $ liftSem $ IdPEffect.getConfig (idp ^. SAML.idpId)
+    mbIdp <- runSpar $ IdPEffect.getConfig (idp ^. SAML.idpId)
     liftIO $ mbIdp `shouldBe` Nothing
   -- The config from 'issuer_idp':
   do
@@ -320,5 +318,5 @@ testDeleteTeam = it "cleans up all the right tables after deletion" $ do
     liftIO $ mbIdp `shouldBe` GetIdPNotFound
   -- The config from 'team_idp':
   do
-    idps <- runSpar $ liftSem $ IdPEffect.getConfigsByTeam tid
+    idps <- runSpar $ IdPEffect.getConfigsByTeam tid
     liftIO $ idps `shouldBe` []
diff --git a/services/spar/test-integration/Test/Spar/Intra/BrigSpec.hs b/services/spar/test-integration/Test/Spar/Intra/BrigSpec.hs
index 84114d8027..e2e3ef3ce1 100644
--- a/services/spar/test-integration/Test/Spar/Intra/BrigSpec.hs
+++ b/services/spar/test-integration/Test/Spar/Intra/BrigSpec.hs
@@ -25,7 +25,6 @@ import Control.Lens ((^.))
 import Data.Id (Id (Id))
 import qualified Data.UUID as UUID
 import Imports hiding (head)
-import Spar.App (liftSem)
 import qualified Spar.Intra.BrigApp as Intra
 import Util
 import qualified Web.Scim.Schema.User as Scim.User
@@ -40,7 +39,7 @@ spec = do
 
   describe "getBrigUser" $ do
     it "return Nothing if n/a" $ do
-      musr <- runSpar $ liftSem $ Intra.getBrigUser Intra.WithPendingInvitations (Id . fromJust $ UUID.fromText "29546d9e-ed5b-11ea-8228-c324b1ea1030")
+      musr <- runSpar $ Intra.getBrigUser Intra.WithPendingInvitations (Id . fromJust $ UUID.fromText "29546d9e-ed5b-11ea-8228-c324b1ea1030")
       liftIO $ musr `shouldSatisfy` isNothing
 
     it "return Just if /a" $ do
@@ -53,5 +52,5 @@ spec = do
             scimUserId <$> createUser tok scimUser
 
       uid <- setup
-      musr <- runSpar $ liftSem $ Intra.getBrigUser Intra.WithPendingInvitations uid
+      musr <- runSpar $ Intra.getBrigUser Intra.WithPendingInvitations uid
       liftIO $ musr `shouldSatisfy` isJust
diff --git a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs
index 831c2951b4..24a339cc80 100644
--- a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs
+++ b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs
@@ -59,7 +59,6 @@ import Imports
 import qualified Network.Wai.Utilities.Error as Wai
 import qualified SAML2.WebSSO as SAML
 import qualified SAML2.WebSSO.Test.MockResponse as SAML
-import Spar.App (liftSem)
 import qualified Spar.Intra.BrigApp as Intra
 import Spar.Scim
 import Spar.Scim.Types (normalizeLikeStored)
@@ -118,9 +117,9 @@ specSuspend = do
           -- NOTE: once SCIM is enabled, SSO Auto-provisioning is disabled
           tok <- registerScimToken teamid (Just (idp ^. SAML.idpId))
           handle'@(Handle handle) <- nextHandle
-          runSpar $ liftSem $ BrigAccess.setHandle member handle'
+          runSpar $ BrigAccess.setHandle member handle'
           unless isActive $ do
-            runSpar $ liftSem $ BrigAccess.setStatus member Suspended
+            runSpar $ BrigAccess.setStatus member Suspended
           [user] <- listUsers tok (Just (filterBy "userName" handle))
           lift $ (fmap Scim.unScimBool . Scim.User.active . Scim.value . Scim.thing $ user) `shouldBe` Just isActive
     it "pre-existing suspended users are inactive" $ do
@@ -139,19 +138,19 @@ specSuspend = do
             -- Once we get rid of the `scim` table and make scim serve brig records directly, this is
             -- not an issue anymore.
             lift $ (fmap Scim.unScimBool . Scim.User.active . Scim.value . Scim.thing $ scimStoredUserBlah) `shouldBe` Just True
-            void $ aFewTimes (runSpar $ liftSem $ BrigAccess.getStatus uid) (== Active)
+            void $ aFewTimes (runSpar $ BrigAccess.getStatus uid) (== Active)
           do
             scimStoredUser <- putOrPatch tok uid user True
             lift $ (fmap Scim.unScimBool . Scim.User.active . Scim.value . Scim.thing $ scimStoredUser) `shouldBe` Just True
-            void $ aFewTimes (runSpar $ liftSem $ BrigAccess.getStatus uid) (== Active)
+            void $ aFewTimes (runSpar $ BrigAccess.getStatus uid) (== Active)
           do
             scimStoredUser <- putOrPatch tok uid user False
             lift $ (fmap Scim.unScimBool . Scim.User.active . Scim.value . Scim.thing $ scimStoredUser) `shouldBe` Just False
-            void $ aFewTimes (runSpar $ liftSem $ BrigAccess.getStatus uid) (== Suspended)
+            void $ aFewTimes (runSpar $ BrigAccess.getStatus uid) (== Suspended)
           do
             scimStoredUser <- putOrPatch tok uid user True
             lift $ (fmap Scim.unScimBool . Scim.User.active . Scim.value . Scim.thing $ scimStoredUser) `shouldBe` Just True
-            void $ aFewTimes (runSpar $ liftSem $ BrigAccess.getStatus uid) (== Active)
+            void $ aFewTimes (runSpar $ BrigAccess.getStatus uid) (== Active)
 
     it "PUT will change state from active to inactive and back" $ do
       void . activeInactiveAndBack $ \tok uid user active ->
@@ -190,10 +189,10 @@ specSuspend = do
       (tok, _) <- registerIdPAndScimToken
       scimStoredUserBlah <- createUser tok user
       let uid = Scim.id . Scim.thing $ scimStoredUserBlah
-      runSpar $ liftSem $ BrigAccess.setStatus uid Suspended
-      void $ aFewTimes (runSpar $ liftSem $ BrigAccess.getStatus uid) (== Suspended)
+      runSpar $ BrigAccess.setStatus uid Suspended
+      void $ aFewTimes (runSpar $ BrigAccess.getStatus uid) (== Suspended)
       void $ patchUser tok uid $ PatchOp.PatchOp [deleteAttrib "active"]
-      void $ aFewTimes (runSpar $ liftSem $ BrigAccess.getStatus uid) (== Active)
+      void $ aFewTimes (runSpar $ BrigAccess.getStatus uid) (== Active)
 
 ----------------------------------------------------------------------------
 -- User creation
@@ -304,10 +303,10 @@ testCreateUserNoIdP = do
 
   -- get account from brig, status should be PendingInvitation
   do
-    aFewTimes (runSpar $ liftSem $ BrigAccess.getAccount Intra.NoPendingInvitations userid) isJust
+    aFewTimes (runSpar $ BrigAccess.getAccount Intra.NoPendingInvitations userid) isJust
       >>= maybe (pure ()) (error "pending user in brig is visible, even though it should not be")
     brigUserAccount <-
-      aFewTimes (runSpar $ liftSem $ BrigAccess.getAccount Intra.WithPendingInvitations userid) isJust
+      aFewTimes (runSpar $ BrigAccess.getAccount Intra.WithPendingInvitations userid) isJust
         >>= maybe (error "could not find user in brig") pure
     let brigUser = accountUser brigUserAccount
     brigUser `userShouldMatch` WrappedScimStoredUser scimStoredUser
@@ -347,7 +346,7 @@ testCreateUserNoIdP = do
   -- user should now be active
   do
     brigUser <-
-      aFewTimes (runSpar $ liftSem $ BrigAccess.getAccount Intra.NoPendingInvitations userid) isJust
+      aFewTimes (runSpar $ BrigAccess.getAccount Intra.NoPendingInvitations userid) isJust
         >>= maybe (error "could not find user in brig") pure
     liftIO $ accountStatus brigUser `shouldBe` Active
     liftIO $ userManagedBy (accountUser brigUser) `shouldBe` ManagedByScim
@@ -431,7 +430,7 @@ testCreateUserWithSamlIdP = do
           . expect2xx
       )
   brigUser `userShouldMatch` WrappedScimStoredUser scimStoredUser
-  accStatus <- aFewTimes (runSpar $ liftSem $ BrigAccess.getStatus (userId brigUser)) (== Active)
+  accStatus <- aFewTimes (runSpar $ BrigAccess.getStatus (userId brigUser)) (== Active)
   liftIO $ accStatus `shouldBe` Active
   liftIO $ userManagedBy brigUser `shouldBe` ManagedByScim
 
@@ -823,9 +822,9 @@ testFindSamlAutoProvisionedUserMigratedWithEmailInTeamWithSSO = do
   -- auto-provision user via saml
   memberWithSSO <- do
     uid <- loginSsoUserFirstTime idp privCreds
-    Just usr <- runSpar $ liftSem $ Intra.getBrigUser Intra.NoPendingInvitations uid
+    Just usr <- runSpar $ Intra.getBrigUser Intra.NoPendingInvitations uid
     handle <- nextHandle
-    runSpar $ liftSem $ BrigAccess.setHandle uid handle
+    runSpar $ BrigAccess.setHandle uid handle
     pure usr
   let memberIdWithSSO = userId memberWithSSO
       externalId = either error id $ veidToText =<< Intra.veidFromBrigUser memberWithSSO Nothing
@@ -836,7 +835,7 @@ testFindSamlAutoProvisionedUserMigratedWithEmailInTeamWithSSO = do
   liftIO $ userManagedBy memberWithSSO `shouldBe` ManagedByWire
   users <- listUsers tok (Just (filterBy "externalId" externalId))
   liftIO $ (scimUserId <$> users) `shouldContain` [memberIdWithSSO]
-  Just brigUser' <- runSpar $ liftSem $ Intra.getBrigUser Intra.NoPendingInvitations memberIdWithSSO
+  Just brigUser' <- runSpar $ Intra.getBrigUser Intra.NoPendingInvitations memberIdWithSSO
   liftIO $ userManagedBy brigUser' `shouldBe` ManagedByScim
   where
     veidToText :: MonadError String m => ValidExternalId -> m Text
@@ -857,7 +856,7 @@ testFindTeamSettingsInvitedUserMigratedWithEmailInTeamWithSSO = do
 
   users' <- listUsers tok (Just (filterBy "externalId" emailInvited))
   liftIO $ (scimUserId <$> users') `shouldContain` [memberIdInvited]
-  Just brigUserInvited' <- runSpar $ liftSem $ Intra.getBrigUser Intra.NoPendingInvitations memberIdInvited
+  Just brigUserInvited' <- runSpar $ Intra.getBrigUser Intra.NoPendingInvitations memberIdInvited
   liftIO $ userManagedBy brigUserInvited' `shouldBe` ManagedByScim
 
 testFindTeamSettingsInvitedUserMigratedWithEmailInTeamWithSSOViaUserId :: TestSpar ()
@@ -869,7 +868,7 @@ testFindTeamSettingsInvitedUserMigratedWithEmailInTeamWithSSOViaUserId = do
   let memberIdInvited = userId memberInvited
 
   _ <- getUser tok memberIdInvited
-  Just brigUserInvited' <- runSpar $ liftSem $ Intra.getBrigUser Intra.NoPendingInvitations (memberIdInvited)
+  Just brigUserInvited' <- runSpar $ Intra.getBrigUser Intra.NoPendingInvitations (memberIdInvited)
   liftIO $ userManagedBy brigUserInvited' `shouldBe` ManagedByScim
 
 testFindProvisionedUserNoIdP :: TestSpar ()
@@ -888,8 +887,8 @@ testFindNonProvisionedUserNoIdP findBy = do
 
   uid <- userId <$> call (inviteAndRegisterUser (env ^. teBrig) owner teamid)
   handle <- nextHandle
-  runSpar $ liftSem $ BrigAccess.setHandle uid handle
-  Just brigUser <- runSpar $ liftSem $ Intra.getBrigUser Intra.NoPendingInvitations uid
+  runSpar $ BrigAccess.setHandle uid handle
+  Just brigUser <- runSpar $ Intra.getBrigUser Intra.NoPendingInvitations uid
   let Just email = userEmail brigUser
 
   do
@@ -904,7 +903,7 @@ testFindNonProvisionedUserNoIdP findBy = do
 
   do
     liftIO $ users `shouldBe` [uid]
-    Just brigUser' <- runSpar $ liftSem $ Intra.getBrigUser Intra.NoPendingInvitations uid
+    Just brigUser' <- runSpar $ Intra.getBrigUser Intra.NoPendingInvitations uid
     liftIO $ userManagedBy brigUser' `shouldBe` ManagedByScim
     liftIO $ brigUser' `shouldBe` brigUser {userManagedBy = ManagedByScim}
 
@@ -989,7 +988,7 @@ testGetUser = do
 
 shouldBeManagedBy :: HasCallStack => UserId -> ManagedBy -> TestSpar ()
 shouldBeManagedBy uid flag = do
-  managedBy <- maybe (error "user not found") userManagedBy <$> runSpar (liftSem $ Intra.getBrigUser Intra.WithPendingInvitations uid)
+  managedBy <- maybe (error "user not found") userManagedBy <$> runSpar (Intra.getBrigUser Intra.WithPendingInvitations uid)
   liftIO $ managedBy `shouldBe` flag
 
 -- | This is (roughly) the behavior on develop as well as on the branch where this test was
@@ -1042,12 +1041,12 @@ testGetUserWithNoHandle = do
   uid <- loginSsoUserFirstTime idp privcreds
   tok <- registerScimToken tid (Just (idp ^. SAML.idpId))
 
-  mhandle :: Maybe Handle <- maybe (error "user not found") userHandle <$> runSpar (liftSem $ Intra.getBrigUser Intra.WithPendingInvitations uid)
+  mhandle :: Maybe Handle <- maybe (error "user not found") userHandle <$> runSpar (Intra.getBrigUser Intra.WithPendingInvitations uid)
   liftIO $ mhandle `shouldSatisfy` isNothing
 
   storedUser <- getUser tok uid
   liftIO $ (Scim.User.displayName . Scim.value . Scim.thing) storedUser `shouldSatisfy` isJust
-  mhandle' :: Maybe Handle <- aFewTimes (maybe (error "user not found") userHandle <$> runSpar (liftSem $ Intra.getBrigUser Intra.WithPendingInvitations uid)) isJust
+  mhandle' :: Maybe Handle <- aFewTimes (maybe (error "user not found") userHandle <$> runSpar (Intra.getBrigUser Intra.WithPendingInvitations uid)) isJust
   liftIO $ mhandle' `shouldSatisfy` isJust
   liftIO $ (fromHandle <$> mhandle') `shouldBe` (Just . Scim.User.userName . Scim.value . Scim.thing $ storedUser)
 
@@ -1321,7 +1320,7 @@ testUpdateExternalId withidp = do
       lookupByValidExternalId :: ValidExternalId -> TestSpar (Maybe UserId)
       lookupByValidExternalId =
         runValidExternalId
-          (runSpar . liftSem . SAMLUserStore.get)
+          (runSpar . SAMLUserStore.get)
           ( \email -> do
               let action = SU.scimFindUserByEmail midp tid $ fromEmail email
               result <- runSpar . runExceptT . runMaybeT $ action
@@ -1345,7 +1344,7 @@ testBrigSideIsUpdated = do
   validScimUser <-
     either (error . show) pure $
       validateScimUser' (Just idp) 999999 user'
-  brigUser <- maybe (error "no brig user") pure =<< runSpar (liftSem $ Intra.getBrigUser Intra.WithPendingInvitations userid)
+  brigUser <- maybe (error "no brig user") pure =<< runSpar (Intra.getBrigUser Intra.WithPendingInvitations userid)
   brigUser `userShouldMatch` validScimUser
 
 ----------------------------------------------------------------------------
@@ -1527,7 +1526,7 @@ specDeleteUser = do
       storedUser <- createUser tok user
       let uid :: UserId = scimUserId storedUser
       uref :: SAML.UserRef <- do
-        usr <- runSpar $ liftSem $ Intra.getBrigUser Intra.WithPendingInvitations uid
+        usr <- runSpar $ Intra.getBrigUser Intra.WithPendingInvitations uid
         let err = error . ("brig user without UserRef: " <>) . show
         case (`Intra.veidFromBrigUser` Nothing) <$> usr of
           bad@(Just (Right veid)) -> runValidExternalId pure (const $ err bad) veid
@@ -1536,11 +1535,11 @@ specDeleteUser = do
       deleteUser_ (Just tok) (Just uid) spar
         !!! const 204 === statusCode
       brigUser :: Maybe User <-
-        aFewTimes (runSpar $ liftSem $ Intra.getBrigUser Intra.WithPendingInvitations uid) isNothing
+        aFewTimes (runSpar $ Intra.getBrigUser Intra.WithPendingInvitations uid) isNothing
       samlUser :: Maybe UserId <-
         aFewTimes (getUserIdViaRef' uref) isNothing
       scimUser <-
-        aFewTimes (runSpar $ liftSem $ ScimUserTimesStore.read uid) isNothing
+        aFewTimes (runSpar $ ScimUserTimesStore.read uid) isNothing
       liftIO $
         (brigUser, samlUser, scimUser)
           `shouldBe` (Nothing, Nothing, Nothing)
@@ -1744,7 +1743,7 @@ testDeletedUsersFreeExternalIdNoIdp = do
 
   void $
     aFewTimes
-      (runSpar $ liftSem $ ScimExternalIdStore.lookup tid email)
+      (runSpar $ ScimExternalIdStore.lookup tid email)
       (== Nothing)
 
 specSCIMManaged :: SpecWith TestEnv
diff --git a/services/spar/test-integration/Util/Core.hs b/services/spar/test-integration/Util/Core.hs
index c66bbdd5be..a27e301b08 100644
--- a/services/spar/test-integration/Util/Core.hs
+++ b/services/spar/test-integration/Util/Core.hs
@@ -173,7 +173,6 @@ import qualified SAML2.WebSSO.API.Example as SAML
 import SAML2.WebSSO.Test.Lenses (userRefL)
 import SAML2.WebSSO.Test.MockResponse
 import SAML2.WebSSO.Test.Util (SampleIdP (..), makeSampleIdPMetadata)
-import Spar.App (liftSem)
 import qualified Spar.App as Spar
 import Spar.CanonicalInterpreter
 import qualified Spar.Intra.BrigApp as Intra
@@ -1207,8 +1206,8 @@ ssoToUidSpar tid ssoid = do
   veid <- either (error . ("could not parse brig sso_id: " <>)) pure $ Intra.veidFromUserSSOId ssoid
   runSpar $
     runValidExternalId
-      (liftSem . SAMLUserStore.get)
-      (liftSem . ScimExternalIdStore.lookup tid)
+      (SAMLUserStore.get)
+      (ScimExternalIdStore.lookup tid)
       veid
 
 runSimpleSP :: (MonadReader TestEnv m, MonadIO m) => SAML.SimpleSP a -> m a
@@ -1234,7 +1233,7 @@ getSsoidViaSelf uid = maybe (error "not found") pure =<< getSsoidViaSelf' uid
 
 getSsoidViaSelf' :: HasCallStack => UserId -> TestSpar (Maybe UserSSOId)
 getSsoidViaSelf' uid = do
-  musr <- aFewTimes (runSpar $ liftSem $ Intra.getBrigUser Intra.NoPendingInvitations uid) isJust
+  musr <- aFewTimes (runSpar $ Intra.getBrigUser Intra.NoPendingInvitations uid) isJust
   pure $ case userIdentity =<< musr of
     Just (SSOIdentity ssoid _ _) -> Just ssoid
     Just (FullIdentity _ _) -> Nothing
@@ -1247,7 +1246,7 @@ getUserIdViaRef uref = maybe (error "not found") pure =<< getUserIdViaRef' uref
 
 getUserIdViaRef' :: HasCallStack => UserRef -> TestSpar (Maybe UserId)
 getUserIdViaRef' uref = do
-  aFewTimes (runSpar $ liftSem $ SAMLUserStore.get uref) isJust
+  aFewTimes (runSpar $ SAMLUserStore.get uref) isJust
 
 checkErr :: HasCallStack => Int -> Maybe TestErrorLabel -> Assertions ()
 checkErr status mlabel = do
diff --git a/services/spar/test-integration/Util/Scim.hs b/services/spar/test-integration/Util/Scim.hs
index 854ba7dd4f..71a698d0e1 100644
--- a/services/spar/test-integration/Util/Scim.hs
+++ b/services/spar/test-integration/Util/Scim.hs
@@ -34,7 +34,6 @@ import Data.UUID.V4 as UUID
 import Imports
 import qualified SAML2.WebSSO as SAML
 import SAML2.WebSSO.Types (IdPId, idpId)
-import Spar.App (liftSem)
 import qualified Spar.Intra.BrigApp as Intra
 import Spar.Scim.User (synthesizeScimUser, validateScimUser')
 import qualified Spar.Sem.ScimTokenStore as ScimTokenStore
@@ -82,16 +81,15 @@ registerScimToken teamid midpid = do
   scimTokenId <- randomId
   now <- liftIO getCurrentTime
   runSpar $
-    liftSem $
-      ScimTokenStore.insert
-        tok
-        ScimTokenInfo
-          { stiTeam = teamid,
-            stiId = scimTokenId,
-            stiCreatedAt = now,
-            stiIdP = midpid,
-            stiDescr = "test token"
-          }
+    ScimTokenStore.insert
+      tok
+      ScimTokenInfo
+        { stiTeam = teamid,
+          stiId = scimTokenId,
+          stiCreatedAt = now,
+          stiIdP = midpid,
+          stiDescr = "test token"
+        }
   pure tok
 
 -- | Generate a SCIM user with a random name and handle.  At the very least, everything considered

From 41707eb390dd08ca08c4104f0701a80b694972de Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Sat, 2 Oct 2021 10:24:22 -0700
Subject: [PATCH 09/13] Remove Spar type

---
 services/spar/src/Spar/API.hs                 | 64 ++++++++---------
 services/spar/src/Spar/App.hs                 | 71 +++++++++----------
 .../spar/src/Spar/CanonicalInterpreter.hs     |  4 +-
 services/spar/src/Spar/Scim/Auth.hs           | 16 ++---
 services/spar/src/Spar/Scim/User.hs           | 58 +++++++--------
 services/spar/test-integration/Util/Core.hs   |  3 +-
 6 files changed, 107 insertions(+), 109 deletions(-)

diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs
index 507df61079..dddd5b8c65 100644
--- a/services/spar/src/Spar/API.hs
+++ b/services/spar/src/Spar/API.hs
@@ -133,7 +133,7 @@ api ::
      ]
     r =>
   Opts ->
-  ServerT API (Spar r)
+  ServerT API (Sem r)
 api opts =
   apiSSO opts
     :<|> authreqPrecheck
@@ -163,7 +163,7 @@ apiSSO ::
      ]
     r =>
   Opts ->
-  ServerT APISSO (Spar r)
+  ServerT APISSO (Sem r)
 apiSSO opts =
   (SAML2.meta appName (SamlProtocolSettings.spIssuer Nothing) (SamlProtocolSettings.responseURI Nothing))
     :<|> (\tid -> SAML2.meta appName (SamlProtocolSettings.spIssuer (Just tid)) (SamlProtocolSettings.responseURI (Just tid)))
@@ -185,7 +185,7 @@ apiIDP ::
        Error SparError
      ]
     r =>
-  ServerT APIIDP (Spar r)
+  ServerT APIIDP (Sem r)
 apiIDP =
   idpGet
     :<|> idpGetRaw
@@ -203,7 +203,7 @@ apiINTERNAL ::
        SAMLUserStore
      ]
     r =>
-  ServerT APIINTERNAL (Spar r)
+  ServerT APIINTERNAL (Sem r)
 apiINTERNAL =
   internalStatus
     :<|> internalDeleteTeam
@@ -224,7 +224,7 @@ authreqPrecheck ::
   Maybe URI.URI ->
   Maybe URI.URI ->
   SAML.IdPId ->
-  Spar r NoContent
+  Sem r NoContent
 authreqPrecheck msucc merr idpid =
   validateAuthreqParams msucc merr
     *> getIdPConfig idpid
@@ -250,7 +250,7 @@ authreq ::
   Maybe URI.URI ->
   Maybe URI.URI ->
   SAML.IdPId ->
-  Spar r (WithSetBindCookie (SAML.FormRedirect SAML.AuthnRequest))
+  Sem r (WithSetBindCookie (SAML.FormRedirect SAML.AuthnRequest))
 authreq _ DoInitiateLogin (Just _) _ _ _ = throwSparSem SparInitLoginWithAuth
 authreq _ DoInitiateBind Nothing _ _ _ = throwSparSem SparInitBindWithoutAuth
 authreq authreqttl _ zusr msucc merr idpid = do
@@ -281,7 +281,7 @@ initializeBindCookie ::
     r =>
   Maybe UserId ->
   NominalDiffTime ->
-  Spar r SetBindCookie
+  Sem r SetBindCookie
 initializeBindCookie zusr authreqttl = do
   DerivedOpts {derivedOptsBindCookiePath} <- inputs derivedOpts
   msecret <-
@@ -295,7 +295,7 @@ initializeBindCookie zusr authreqttl = do
 redirectURLMaxLength :: Int
 redirectURLMaxLength = 140
 
-validateAuthreqParams :: Member (Error SparError) r => Maybe URI.URI -> Maybe URI.URI -> Spar r VerdictFormat
+validateAuthreqParams :: Member (Error SparError) r => Maybe URI.URI -> Maybe URI.URI -> Sem r VerdictFormat
 validateAuthreqParams msucc merr = case (msucc, merr) of
   (Nothing, Nothing) -> pure VerdictFormatWeb
   (Just ok, Just err) -> do
@@ -303,7 +303,7 @@ validateAuthreqParams msucc merr = case (msucc, merr) of
     pure $ VerdictFormatMobile ok err
   _ -> throwSparSem $ SparBadInitiateLoginQueryParams "need-both-redirect-urls"
 
-validateRedirectURL :: Member (Error SparError) r => URI.URI -> Spar r ()
+validateRedirectURL :: Member (Error SparError) r => URI.URI -> Sem r ()
 validateRedirectURL uri = do
   unless ((SBS.take 4 . URI.schemeBS . URI.uriScheme $ uri) == "wire") $ do
     throwSparSem $ SparBadInitiateLoginQueryParams "invalid-schema"
@@ -333,7 +333,7 @@ authresp ::
   Maybe TeamId ->
   Maybe ST ->
   SAML.AuthnResponseBody ->
-  Spar r Void
+  Sem r Void
 authresp mbtid ckyraw arbody = logErrors $ SAML2.authResp mbtid (SamlProtocolSettings.spIssuer mbtid) (SamlProtocolSettings.responseURI mbtid) go arbody
   where
     cky :: Maybe BindCookie
@@ -344,8 +344,8 @@ authresp mbtid ckyraw arbody = logErrors $ SAML2.authResp mbtid (SamlProtocolSet
       result :: SAML.ResponseVerdict <- verdictHandler cky mbtid resp verdict
       throw @SparError $ SAML.CustomServant result
 
-    logErrors :: Spar r Void -> Spar r Void
-    logErrors action = liftSem . catch @SparError (runSparInSem action) $ \case
+    logErrors :: Sem r Void -> Sem r Void
+    logErrors action = catch @SparError action $ \case
       e@(SAML.CustomServant _) -> throw e
       e -> do
         throw @SparError . SAML.CustomServant $
@@ -354,7 +354,7 @@ authresp mbtid ckyraw arbody = logErrors $ SAML2.authResp mbtid (SamlProtocolSet
             (Multipart.inputs (SAML.authnResponseBodyRaw arbody))
             ckyraw
 
-ssoSettings :: Member DefaultSsoCode r => Spar r SsoSettings
+ssoSettings :: Member DefaultSsoCode r => Sem r SsoSettings
 ssoSettings = do
   SsoSettings <$> DefaultSsoCode.get
 
@@ -373,7 +373,7 @@ idpGet ::
     r =>
   Maybe UserId ->
   SAML.IdPId ->
-  Spar r IdP
+  Sem r IdP
 idpGet zusr idpid = withDebugLog "idpGet" (Just . show . (^. SAML.idpId)) $ do
   idp <- getIdPConfig idpid
   _ <- authorizeIdP zusr idp
@@ -383,7 +383,7 @@ idpGetRaw ::
   Members '[GalleyAccess, BrigAccess, IdPEffect.IdP, Error SparError] r =>
   Maybe UserId ->
   SAML.IdPId ->
-  Spar r RawIdPMetadata
+  Sem r RawIdPMetadata
 idpGetRaw zusr idpid = do
   idp <- getIdPConfig idpid
   _ <- authorizeIdP zusr idp
@@ -402,7 +402,7 @@ idpGetAll ::
      ]
     r =>
   Maybe UserId ->
-  Spar r IdPList
+  Sem r IdPList
 idpGetAll zusr = withDebugLog "idpGetAll" (const Nothing) $ do
   teamid <- Brig.getZUsrCheckPerm zusr ReadIdp
   _idplProviders <- IdPEffect.getConfigsByTeam teamid
@@ -432,7 +432,7 @@ idpDelete ::
   Maybe UserId ->
   SAML.IdPId ->
   Maybe Bool ->
-  Spar r NoContent
+  Sem r NoContent
 idpDelete zusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (const Nothing) $ do
   idp <- getIdPConfig idpid
   _ <- authorizeIdP zusr idp
@@ -440,7 +440,7 @@ idpDelete zusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (cons
       team = idp ^. SAML.idpExtraInfo . wiTeam
   -- if idp is not empty: fail or purge
   idpIsEmpty <- isNothing <$> SAMLUserStore.getAnyByIssuer issuer
-  let doPurge :: Spar r ()
+  let doPurge :: Sem r ()
       doPurge = do
         some <- SAMLUserStore.getSomeByIssuer issuer
         forM_ some $ \(uref, uid) -> do
@@ -465,7 +465,7 @@ idpDelete zusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (cons
     IdPEffect.deleteRawMetadata idpid
   return NoContent
   where
-    updateOldIssuers :: IdP -> Spar r ()
+    updateOldIssuers :: IdP -> Sem r ()
     updateOldIssuers _ = pure ()
     -- we *could* update @idp ^. SAML.idpExtraInfo . wiReplacedBy@ to not keep the idp about
     -- to be deleted in its old issuers list, but it's tricky to avoid race conditions, and
@@ -474,7 +474,7 @@ idpDelete zusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (cons
     -- won't find any users to migrate.  still, doesn't hurt mucht to look either.  so we
     -- leave old issuers dangling for now.
 
-    updateReplacingIdP :: IdP -> Spar r ()
+    updateReplacingIdP :: IdP -> Sem r ()
     updateReplacingIdP idp = forM_ (idp ^. SAML.idpExtraInfo . wiOldIssuers) $ \oldIssuer -> do
       getIdPIdByIssuer oldIssuer (idp ^. SAML.idpExtraInfo . wiTeam) >>= \case
         Data.GetIdPFound iid -> IdPEffect.clearReplacedBy $ Data.Replaced iid
@@ -500,7 +500,7 @@ idpCreate ::
   IdPMetadataInfo ->
   Maybe SAML.IdPId ->
   Maybe WireIdPAPIVersion ->
-  Spar r IdP
+  Sem r IdP
 idpCreate zusr (IdPMetadataValue raw xml) midpid apiversion = idpCreateXML zusr raw xml midpid apiversion
 
 -- | We generate a new UUID for each IdP used as IdPConfig's path, thereby ensuring uniqueness.
@@ -520,7 +520,7 @@ idpCreateXML ::
   SAML.IdPMetadata ->
   Maybe SAML.IdPId ->
   Maybe WireIdPAPIVersion ->
-  Spar r IdP
+  Sem r IdP
 idpCreateXML zusr raw idpmeta mReplaces (fromMaybe defWireIdPAPIVersion -> apiversion) = withDebugLog "idpCreate" (Just . show . (^. SAML.idpId)) $ do
   teamid <- Brig.getZUsrCheckPerm zusr CreateUpdateDeleteIdp
   GalleyAccess.assertSSOEnabled teamid
@@ -544,7 +544,7 @@ assertNoScimOrNoIdP ::
      ]
     r =>
   TeamId ->
-  Spar r ()
+  Sem r ()
 assertNoScimOrNoIdP teamid = do
   numTokens <- length <$> ScimTokenStore.getByTeam teamid
   numIdps <- length <$> IdPEffect.getConfigsByTeam teamid
@@ -575,7 +575,7 @@ assertNoScimOrNoIdP teamid = do
 -- update, delete of idps.)
 validateNewIdP ::
   forall m r.
-  (HasCallStack, m ~ Spar r) =>
+  (HasCallStack, m ~ Sem r) =>
   Members
     '[ Random,
        Logger String,
@@ -641,7 +641,7 @@ idpUpdate ::
   Maybe UserId ->
   IdPMetadataInfo ->
   SAML.IdPId ->
-  Spar r IdP
+  Sem r IdP
 idpUpdate zusr (IdPMetadataValue raw xml) idpid = idpUpdateXML zusr raw xml idpid
 
 idpUpdateXML ::
@@ -658,7 +658,7 @@ idpUpdateXML ::
   Text ->
   SAML.IdPMetadata ->
   SAML.IdPId ->
-  Spar r IdP
+  Sem r IdP
 idpUpdateXML zusr raw idpmeta idpid = withDebugLog "idpUpdate" (Just . show . (^. SAML.idpId)) $ do
   (teamid, idp) <- validateIdPUpdate zusr idpmeta idpid
   GalleyAccess.assertSSOEnabled teamid
@@ -675,7 +675,7 @@ idpUpdateXML zusr raw idpmeta idpid = withDebugLog "idpUpdate" (Just . show . (^
 -- info if issuer has changed.
 validateIdPUpdate ::
   forall m r.
-  (HasCallStack, m ~ Spar r) =>
+  (HasCallStack, m ~ Sem r) =>
   Members
     '[ Random,
        Logger String,
@@ -723,7 +723,7 @@ validateIdPUpdate zusr _idpMetadata _idpId = withDebugLog "validateNewIdP" (Just
         uri = _idpMetadata ^. SAML.edIssuer . SAML.fromIssuer
     errUnknownIdPId = SAML.UnknownIdP . cs . SAML.idPIdToST $ _idpId
 
-withDebugLog :: Member (Logger String) r => String -> (a -> Maybe String) -> Spar r a -> Spar r a
+withDebugLog :: Member (Logger String) r => String -> (a -> Maybe String) -> Sem r a -> Sem r a
 withDebugLog msg showval action = do
   Logger.log SAML.Debug $ "entering " ++ msg
   val <- action
@@ -742,7 +742,7 @@ authorizeIdP (Just zusr) idp = do
   GalleyAccess.assertHasPermission teamid CreateUpdateDeleteIdp zusr
   pure teamid
 
-enforceHttps :: Member (Error SparError) r => URI.URI -> Spar r ()
+enforceHttps :: Member (Error SparError) r => URI.URI -> Sem r ()
 enforceHttps uri = do
   unless ((uri ^. URI.uriSchemeL . URI.schemeBSL) == "https") $ do
     throwSparSem . SparNewIdPWantHttps . cs . SAML.renderURI $ uri
@@ -750,12 +750,12 @@ enforceHttps uri = do
 ----------------------------------------------------------------------------
 -- Internal API
 
-internalStatus :: Spar r NoContent
+internalStatus :: Sem r NoContent
 internalStatus = pure NoContent
 
 -- | Cleanup handler that is called by Galley whenever a team is about to
 -- get deleted.
-internalDeleteTeam :: Members '[ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => TeamId -> Spar r NoContent
+internalDeleteTeam :: Members '[ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => TeamId -> Sem r NoContent
 internalDeleteTeam team = do
   deleteTeam team
   pure NoContent
@@ -768,7 +768,7 @@ internalPutSsoSettings ::
      ]
     r =>
   SsoSettings ->
-  Spar r NoContent
+  Sem r NoContent
 internalPutSsoSettings SsoSettings {defaultSsoCode = Nothing} = do
   DefaultSsoCode.delete
   pure NoContent
diff --git a/services/spar/src/Spar/App.hs b/services/spar/src/Spar/App.hs
index 107c9e782d..87daf33352 100644
--- a/services/spar/src/Spar/App.hs
+++ b/services/spar/src/Spar/App.hs
@@ -21,8 +21,7 @@
 
 -- | The 'Spar' monad and a set of actions (e.g. 'createUser') that can be performed in it.
 module Spar.App
-  ( type Spar,
-    Env (..),
+  ( Env (..),
     throwSparSem,
     verdictHandler,
     GetUserResult (..),
@@ -112,9 +111,7 @@ import Wire.API.User.IdentityProvider
 import Wire.API.User.Saml
 import Wire.API.User.Scim (ValidExternalId (..))
 
-type Spar = Sem
-
-throwSparSem :: Member (Error SparError) r => SparCustomError -> Spar r a
+throwSparSem :: Member (Error SparError) r => SparCustomError -> Sem r a
 throwSparSem = throw . SAML.CustomError
 
 data Env = Env
@@ -134,13 +131,13 @@ getIdPConfig ::
      ]
     r =>
   IdPId ->
-  Spar r IdP
+  Sem r IdP
 getIdPConfig = (>>= maybe (throwSparSem (SparIdPNotFound mempty)) pure) . IdPEffect.getConfig
 
-storeIdPConfig :: Member IdPEffect.IdP r => IdP -> Spar r ()
+storeIdPConfig :: Member IdPEffect.IdP r => IdP -> Sem r ()
 storeIdPConfig idp = IdPEffect.storeConfig idp
 
-getIdPConfigByIssuerOptionalSPId :: Members '[IdPEffect.IdP, Error SparError] r => Issuer -> Maybe TeamId -> Spar r IdP
+getIdPConfigByIssuerOptionalSPId :: Members '[IdPEffect.IdP, Error SparError] r => Issuer -> Maybe TeamId -> Sem r IdP
 getIdPConfigByIssuerOptionalSPId issuer mbteam = do
   getIdPConfigByIssuerAllowOld issuer mbteam >>= \case
     Data.GetIdPFound idp -> pure idp
@@ -149,7 +146,7 @@ getIdPConfigByIssuerOptionalSPId issuer mbteam = do
     res@(Data.GetIdPNonUnique _) -> throwSparSem $ SparIdPNotFound (cs $ show res)
     res@(Data.GetIdPWrongTeam _) -> throwSparSem $ SparIdPNotFound (cs $ show res)
 
-insertUser :: Member SAMLUserStore r => SAML.UserRef -> UserId -> Spar r ()
+insertUser :: Member SAMLUserStore r => SAML.UserRef -> UserId -> Sem r ()
 insertUser uref uid = SAMLUserStore.insert uref uid
 
 -- | Look up user locally in table @spar.user@ or @spar.scim_user@ (depending on the
@@ -169,10 +166,10 @@ insertUser uref uid = SAMLUserStore.insert uref uid
 -- the team with valid SAML credentials.
 --
 -- FUTUREWORK: Remove and reinstatate getUser, in AuthID refactoring PR.  (in https://github.com/wireapp/wire-server/pull/1410, undo https://github.com/wireapp/wire-server/pull/1418)
-getUserIdByUref :: Members '[BrigAccess, SAMLUserStore] r => Maybe TeamId -> SAML.UserRef -> Spar r (GetUserResult UserId)
+getUserIdByUref :: Members '[BrigAccess, SAMLUserStore] r => Maybe TeamId -> SAML.UserRef -> Sem r (GetUserResult UserId)
 getUserIdByUref mbteam uref = userId <$$> getUserByUref mbteam uref
 
-getUserByUref :: Members '[BrigAccess, SAMLUserStore] r => Maybe TeamId -> SAML.UserRef -> Spar r (GetUserResult User)
+getUserByUref :: Members '[BrigAccess, SAMLUserStore] r => Maybe TeamId -> SAML.UserRef -> Sem r (GetUserResult User)
 getUserByUref mbteam uref = do
   muid <- SAMLUserStore.get uref
   case muid of
@@ -200,7 +197,7 @@ instance Functor GetUserResult where
   fmap _ GetUserWrongTeam = GetUserWrongTeam
 
 -- FUTUREWORK: Remove and reinstatate getUser, in AuthID refactoring PR
-getUserIdByScimExternalId :: Members '[BrigAccess, ScimExternalIdStore] r => TeamId -> Email -> Spar r (Maybe UserId)
+getUserIdByScimExternalId :: Members '[BrigAccess, ScimExternalIdStore] r => TeamId -> Email -> Sem r (Maybe UserId)
 getUserIdByScimExternalId tid email = do
   muid <- (ScimExternalIdStore.lookup tid email)
   case muid of
@@ -236,7 +233,7 @@ createSamlUserWithId ::
   TeamId ->
   UserId ->
   SAML.UserRef ->
-  Spar r ()
+  Sem r ()
 createSamlUserWithId teamid buid suid = do
   uname <- either (throwSparSem . SparBadUserName . cs) pure $ Intra.mkUserName Nothing (UrefOnly suid)
   buid' <- BrigAccess.createSAML suid buid teamid uname ManagedByWire
@@ -258,7 +255,7 @@ autoprovisionSamlUser ::
     r =>
   Maybe TeamId ->
   SAML.UserRef ->
-  Spar r UserId
+  Sem r UserId
 autoprovisionSamlUser mbteam suid = do
   buid <- Id <$> Random.uuid
   autoprovisionSamlUserWithId mbteam buid suid
@@ -279,7 +276,7 @@ autoprovisionSamlUserWithId ::
   Maybe TeamId ->
   UserId ->
   SAML.UserRef ->
-  Spar r ()
+  Sem r ()
 autoprovisionSamlUserWithId mbteam buid suid = do
   idp <- getIdPConfigByIssuerOptionalSPId (suid ^. uidTenant) mbteam
   guardReplacedIdP idp
@@ -288,13 +285,13 @@ autoprovisionSamlUserWithId mbteam buid suid = do
   validateEmailIfExists buid suid
   where
     -- Replaced IdPs are not allowed to create new wire accounts.
-    guardReplacedIdP :: IdP -> Spar r ()
+    guardReplacedIdP :: IdP -> Sem r ()
     guardReplacedIdP idp = do
       unless (isNothing $ idp ^. idpExtraInfo . wiReplacedBy) $ do
         throwSparSem $ SparCannotCreateUsersOnReplacedIdP (cs . SAML.idPIdToST $ idp ^. idpId)
 
     -- IdPs in teams with scim tokens are not allowed to auto-provision.
-    guardScimTokens :: IdP -> Spar r ()
+    guardScimTokens :: IdP -> Sem r ()
     guardScimTokens idp = do
       let teamid = idp ^. idpExtraInfo . wiTeam
       scimtoks <- ScimTokenStore.getByTeam teamid
@@ -303,12 +300,12 @@ autoprovisionSamlUserWithId mbteam buid suid = do
 
 -- | If user's 'NameID' is an email address and the team has email validation for SSO enabled,
 -- make brig initiate the email validate procedure.
-validateEmailIfExists :: forall r. Members '[GalleyAccess, BrigAccess] r => UserId -> SAML.UserRef -> Spar r ()
+validateEmailIfExists :: forall r. Members '[GalleyAccess, BrigAccess] r => UserId -> SAML.UserRef -> Sem r ()
 validateEmailIfExists uid = \case
   (SAML.UserRef _ (view SAML.nameID -> UNameIDEmail email)) -> doValidate (CI.original email)
   _ -> pure ()
   where
-    doValidate :: SAMLEmail.Email -> Spar r ()
+    doValidate :: SAMLEmail.Email -> Sem r ()
     doValidate email = do
       enabled <- do
         tid <- Intra.getBrigUserTeam Intra.NoPendingInvitations uid
@@ -333,10 +330,10 @@ bindUser ::
     r =>
   UserId ->
   SAML.UserRef ->
-  Spar r UserId
+  Sem r UserId
 bindUser buid userref = do
   oldStatus <- do
-    let err :: Spar r a
+    let err :: Sem r a
         err = throwSparSem . SparBindFromWrongOrNoTeam . cs . show $ buid
     teamid :: TeamId <-
       getIdPConfigByIssuerAllowOld (userref ^. uidTenant) Nothing >>= \case
@@ -389,7 +386,7 @@ verdictHandler ::
   Maybe TeamId ->
   SAML.AuthnResponse ->
   SAML.AccessVerdict ->
-  Spar r SAML.ResponseVerdict
+  Sem r SAML.ResponseVerdict
 verdictHandler cky mbteam aresp verdict = do
   -- [3/4.1.4.2]
   -- <SubjectConfirmation> [...] If the containing message is in response to an <AuthnRequest>, then
@@ -432,7 +429,7 @@ verdictHandlerResult ::
   Maybe BindCookie ->
   Maybe TeamId ->
   SAML.AccessVerdict ->
-  Spar r VerdictHandlerResult
+  Sem r VerdictHandlerResult
 verdictHandlerResult bindCky mbteam verdict = do
   Logger.log SAML.Debug $ "entering verdictHandlerResult: " <> show (fromBindCookie <$> bindCky)
   result <- catchVerdictErrors $ verdictHandlerResultCore bindCky mbteam verdict
@@ -446,8 +443,8 @@ catchVerdictErrors ::
        Error SparError
      ]
     r =>
-  Spar r VerdictHandlerResult ->
-  Spar r VerdictHandlerResult
+  Sem r VerdictHandlerResult ->
+  Sem r VerdictHandlerResult
 catchVerdictErrors = (`catch` hndlr)
   where
     hndlr :: SparError -> Sem r VerdictHandlerResult
@@ -471,10 +468,10 @@ findUserIdWithOldIssuer ::
     r =>
   Maybe TeamId ->
   SAML.UserRef ->
-  Spar r (GetUserResult (SAML.UserRef, UserId))
+  Sem r (GetUserResult (SAML.UserRef, UserId))
 findUserIdWithOldIssuer mbteam (SAML.UserRef issuer subject) = do
   idp <- getIdPConfigByIssuerOptionalSPId issuer mbteam
-  let tryFind :: GetUserResult (SAML.UserRef, UserId) -> Issuer -> Spar r (GetUserResult (SAML.UserRef, UserId))
+  let tryFind :: GetUserResult (SAML.UserRef, UserId) -> Issuer -> Sem r (GetUserResult (SAML.UserRef, UserId))
       tryFind found@(GetUserFound _) _ = pure found
       tryFind _ oldIssuer = (uref,) <$$> getUserIdByUref mbteam uref
         where
@@ -483,7 +480,7 @@ findUserIdWithOldIssuer mbteam (SAML.UserRef issuer subject) = do
 
 -- | After a user has been found using 'findUserWithOldIssuer', update it everywhere so that
 -- the old IdP is not needed any more next time.
-moveUserToNewIssuer :: Members '[BrigAccess, SAMLUserStore] r => SAML.UserRef -> SAML.UserRef -> UserId -> Spar r ()
+moveUserToNewIssuer :: Members '[BrigAccess, SAMLUserStore] r => SAML.UserRef -> SAML.UserRef -> UserId -> Sem r ()
 moveUserToNewIssuer oldUserRef newUserRef uid = do
   SAMLUserStore.insert newUserRef uid
   BrigAccess.setVeid uid (UrefOnly newUserRef)
@@ -506,7 +503,7 @@ verdictHandlerResultCore ::
   Maybe BindCookie ->
   Maybe TeamId ->
   SAML.AccessVerdict ->
-  Spar r VerdictHandlerResult
+  Sem r VerdictHandlerResult
 verdictHandlerResultCore bindCky mbteam = \case
   SAML.AccessDenied reasons -> do
     pure $ VerifyHandlerDenied reasons
@@ -562,7 +559,7 @@ verdictHandlerResultCore bindCky mbteam = \case
 -- - A title element with contents @wire:sso:<outcome>@.  This is chosen to be easily parseable and
 --   not be the title of any page sent by the IdP while it negotiates with the user.
 -- - The page broadcasts a message to '*', to be picked up by the app.
-verdictHandlerWeb :: HasCallStack => VerdictHandlerResult -> Spar r SAML.ResponseVerdict
+verdictHandlerWeb :: HasCallStack => VerdictHandlerResult -> Sem r SAML.ResponseVerdict
 verdictHandlerWeb =
   pure . \case
     VerifyHandlerGranted cky _uid -> successPage cky
@@ -633,7 +630,7 @@ easyHtml doc =
 -- | If the client is mobile, it has picked error and success redirect urls (see
 -- 'mkVerdictGrantedFormatMobile', 'mkVerdictDeniedFormatMobile'); variables in these URLs are here
 -- substituted and the client is redirected accordingly.
-verdictHandlerMobile :: (HasCallStack, Member (Error SparError) r) => URI.URI -> URI.URI -> VerdictHandlerResult -> Spar r SAML.ResponseVerdict
+verdictHandlerMobile :: (HasCallStack, Member (Error SparError) r) => URI.URI -> URI.URI -> VerdictHandlerResult -> Sem r SAML.ResponseVerdict
 verdictHandlerMobile granted denied = \case
   VerifyHandlerGranted cky uid ->
     mkVerdictGrantedFormatMobile granted cky uid
@@ -703,7 +700,7 @@ getIdPIdByIssuerAllowOld ::
   Member IdPEffect.IdP r =>
   SAML.Issuer ->
   Maybe TeamId ->
-  Spar r (GetIdPResult SAML.IdPId)
+  Sem r (GetIdPResult SAML.IdPId)
 getIdPIdByIssuerAllowOld issuer mbteam = do
   mbv2 <- maybe (pure Nothing) (IdPEffect.getIdByIssuerWithTeam issuer) mbteam
   mbv1v2 <- maybe (IdPEffect.getIdByIssuerWithoutTeam issuer) (pure . GetIdPFound) mbv2
@@ -724,7 +721,7 @@ getIdPConfigByIssuer ::
   (HasCallStack, Member IdPEffect.IdP r) =>
   SAML.Issuer ->
   TeamId ->
-  Spar r (GetIdPResult IdP)
+  Sem r (GetIdPResult IdP)
 getIdPConfigByIssuer issuer =
   getIdPIdByIssuer issuer >=> mapGetIdPResult
 
@@ -733,7 +730,7 @@ getIdPConfigByIssuerAllowOld ::
   (HasCallStack, Member IdPEffect.IdP r) =>
   SAML.Issuer ->
   Maybe TeamId ->
-  Spar r (GetIdPResult IdP)
+  Sem r (GetIdPResult IdP)
 getIdPConfigByIssuerAllowOld issuer = do
   getIdPIdByIssuerAllowOld issuer >=> mapGetIdPResult
 
@@ -743,12 +740,12 @@ getIdPIdByIssuer ::
   (HasCallStack, Member IdPEffect.IdP r) =>
   SAML.Issuer ->
   TeamId ->
-  Spar r (GetIdPResult SAML.IdPId)
+  Sem r (GetIdPResult SAML.IdPId)
 getIdPIdByIssuer issuer = getIdPIdByIssuerAllowOld issuer . Just
 
 -- | (There are probably category theoretical models for what we're doing here, but it's more
 -- straight-forward to just handle the one instance we need.)
-mapGetIdPResult :: (HasCallStack, Member IdPEffect.IdP r) => GetIdPResult SAML.IdPId -> Spar r (GetIdPResult IdP)
+mapGetIdPResult :: (HasCallStack, Member IdPEffect.IdP r) => GetIdPResult SAML.IdPId -> Sem r (GetIdPResult IdP)
 mapGetIdPResult (GetIdPFound i) = IdPEffect.getConfig i <&> maybe (GetIdPDanglingId i) GetIdPFound
 mapGetIdPResult GetIdPNotFound = pure GetIdPNotFound
 mapGetIdPResult (GetIdPDanglingId i) = pure (GetIdPDanglingId i)
@@ -759,7 +756,7 @@ mapGetIdPResult (GetIdPWrongTeam i) = pure (GetIdPWrongTeam i)
 deleteTeam ::
   (HasCallStack, Members '[ScimTokenStore, SAMLUserStore, IdPEffect.IdP] r) =>
   TeamId ->
-  Spar r ()
+  Sem r ()
 deleteTeam team = do
   ScimTokenStore.deleteByTeam team
   -- Since IdPs are not shared between teams, we can look at the set of IdPs
diff --git a/services/spar/src/Spar/CanonicalInterpreter.hs b/services/spar/src/Spar/CanonicalInterpreter.hs
index d8723432fa..19d0f788b3 100644
--- a/services/spar/src/Spar/CanonicalInterpreter.hs
+++ b/services/spar/src/Spar/CanonicalInterpreter.hs
@@ -78,7 +78,7 @@ type CanonicalEffs =
      Final IO
    ]
 
-runSparToIO :: Env -> Spar CanonicalEffs a -> IO (Either SparError a)
+runSparToIO :: Env -> Sem CanonicalEffs a -> IO (Either SparError a)
 runSparToIO ctx action =
   runFinal
     . embedToFinal @IO
@@ -106,7 +106,7 @@ runSparToIO ctx action =
     . sparRouteToServant (saml $ sparCtxOpts ctx)
     $ saml2ToSaml2WebSso action
 
-runSparToHandler :: Env -> Spar CanonicalEffs a -> Handler a
+runSparToHandler :: Env -> Sem CanonicalEffs a -> Handler a
 runSparToHandler ctx spar = do
   err <- liftIO $ runSparToIO ctx spar
   throwErrorAsHandlerException err
diff --git a/services/spar/src/Spar/Scim/Auth.hs b/services/spar/src/Spar/Scim/Auth.hs
index 68b1109a78..202e0410bb 100644
--- a/services/spar/src/Spar/Scim/Auth.hs
+++ b/services/spar/src/Spar/Scim/Auth.hs
@@ -48,7 +48,7 @@ import Polysemy.Error
 import Polysemy.Input
 import qualified SAML2.WebSSO as SAML
 import Servant (NoContent (NoContent), ServerT, (:<|>) ((:<|>)))
-import Spar.App (Spar, throwSparSem)
+import Spar.App (throwSparSem)
 import qualified Spar.Error as E
 import qualified Spar.Intra.BrigApp as Intra.Brig
 import Spar.Sem.BrigAccess (BrigAccess)
@@ -69,9 +69,9 @@ import Wire.API.User.Saml (Opts, maxScimTokens)
 import Wire.API.User.Scim
 
 -- | An instance that tells @hscim@ how authentication should be done for SCIM routes.
-instance Member ScimTokenStore r => Scim.Class.Auth.AuthDB SparTag (Spar r) where
+instance Member ScimTokenStore r => Scim.Class.Auth.AuthDB SparTag (Sem r) where
   -- Validate and resolve a given token
-  authCheck :: Maybe ScimToken -> Scim.ScimHandler (Spar r) ScimTokenInfo
+  authCheck :: Maybe ScimToken -> Scim.ScimHandler (Sem r) ScimTokenInfo
   authCheck Nothing =
     Scim.throwScim (Scim.unauthorized "Token not provided")
   authCheck (Just token) =
@@ -97,7 +97,7 @@ apiScimToken ::
        Error E.SparError
      ]
     r =>
-  ServerT APIScimToken (Spar r)
+  ServerT APIScimToken (Sem r)
 apiScimToken =
   createScimToken
     :<|> deleteScimToken
@@ -123,7 +123,7 @@ createScimToken ::
   Maybe UserId ->
   -- | Request body
   CreateScimToken ->
-  Spar r CreateScimTokenResponse
+  Sem r CreateScimTokenResponse
 createScimToken zusr CreateScimToken {..} = do
   let descr = createScimTokenDescr
   teamid <- Intra.Brig.authorizeScimTokenManagement zusr
@@ -134,7 +134,7 @@ createScimToken zusr CreateScimToken {..} = do
     throwSparSem E.SparProvisioningTokenLimitReached
   idps <- IdPEffect.getConfigsByTeam teamid
 
-  let caseOneOrNoIdP :: Maybe SAML.IdPId -> Spar r CreateScimTokenResponse
+  let caseOneOrNoIdP :: Maybe SAML.IdPId -> Sem r CreateScimTokenResponse
       caseOneOrNoIdP midpid = do
         token <- ScimToken . cs . ES.encode <$> Random.bytes 32
         tokenid <- Random.scimTokenId
@@ -169,7 +169,7 @@ deleteScimToken ::
   -- | Who is trying to delete a token
   Maybe UserId ->
   ScimTokenId ->
-  Spar r NoContent
+  Sem r NoContent
 deleteScimToken zusr tokenid = do
   teamid <- Intra.Brig.authorizeScimTokenManagement zusr
   ScimTokenStore.delete teamid tokenid
@@ -183,7 +183,7 @@ listScimTokens ::
   Members '[GalleyAccess, BrigAccess, ScimTokenStore, Error E.SparError] r =>
   -- | Who is trying to list tokens
   Maybe UserId ->
-  Spar r ScimTokenList
+  Sem r ScimTokenList
 listScimTokens zusr = do
   teamid <- Intra.Brig.authorizeScimTokenManagement zusr
   ScimTokenList <$> ScimTokenStore.getByTeam teamid
diff --git a/services/spar/src/Spar/Scim/User.hs b/services/spar/src/Spar/Scim/User.hs
index c5843a1873..ab152603c0 100644
--- a/services/spar/src/Spar/Scim/User.hs
+++ b/services/spar/src/Spar/Scim/User.hs
@@ -66,7 +66,7 @@ import Network.URI (URI, parseURI)
 import Polysemy
 import Polysemy.Input
 import qualified SAML2.WebSSO as SAML
-import Spar.App (GetUserResult (..), Spar, getUserIdByScimExternalId, getUserIdByUref, validateEmailIfExists)
+import Spar.App (GetUserResult (..), getUserIdByScimExternalId, getUserIdByUref, validateEmailIfExists)
 import qualified Spar.Intra.BrigApp as Brig
 import Spar.Scim.Auth ()
 import Spar.Scim.Types (normalizeLikeStored)
@@ -126,12 +126,12 @@ instance
        SAMLUserStore
      ]
     r =>
-  Scim.UserDB ST.SparTag (Spar r)
+  Scim.UserDB ST.SparTag (Sem r)
   where
   getUsers ::
     ScimTokenInfo ->
     Maybe Scim.Filter ->
-    Scim.ScimHandler (Spar r) (Scim.ListResponse (Scim.StoredUser ST.SparTag))
+    Scim.ScimHandler (Sem r) (Scim.ListResponse (Scim.StoredUser ST.SparTag))
   getUsers _ Nothing = do
     throwError $ Scim.badRequest Scim.TooMany (Just "Please specify a filter when getting users.")
   getUsers tokeninfo@ScimTokenInfo {stiTeam, stiIdP} (Just filter') =
@@ -156,7 +156,7 @@ instance
   getUser ::
     ScimTokenInfo ->
     UserId ->
-    Scim.ScimHandler (Spar r) (Scim.StoredUser ST.SparTag)
+    Scim.ScimHandler (Sem r) (Scim.StoredUser ST.SparTag)
   getUser tokeninfo@ScimTokenInfo {stiTeam, stiIdP} uid =
     logScim
       ( logFunction "Spar.Scim.User.getUser"
@@ -175,18 +175,18 @@ instance
   postUser ::
     ScimTokenInfo ->
     Scim.User ST.SparTag ->
-    Scim.ScimHandler (Spar r) (Scim.StoredUser ST.SparTag)
+    Scim.ScimHandler (Sem r) (Scim.StoredUser ST.SparTag)
   postUser tokinfo user = createValidScimUser tokinfo =<< validateScimUser tokinfo user
 
   putUser ::
     ScimTokenInfo ->
     UserId ->
     Scim.User ST.SparTag ->
-    Scim.ScimHandler (Spar r) (Scim.StoredUser ST.SparTag)
+    Scim.ScimHandler (Sem r) (Scim.StoredUser ST.SparTag)
   putUser tokinfo uid newScimUser =
     updateValidScimUser tokinfo uid =<< validateScimUser tokinfo newScimUser
 
-  deleteUser :: ScimTokenInfo -> UserId -> Scim.ScimHandler (Spar r) ()
+  deleteUser :: ScimTokenInfo -> UserId -> Scim.ScimHandler (Sem r) ()
   deleteUser tokeninfo uid =
     logScim
       ( logFunction "Spar.Scim.User.deleteUser"
@@ -202,7 +202,7 @@ instance
 -- 'ValidScimUser''.
 validateScimUser ::
   forall m r.
-  (m ~ Scim.ScimHandler (Spar r)) =>
+  (m ~ Scim.ScimHandler (Sem r)) =>
   Members '[Input Opts, IdPEffect.IdP] r =>
   -- | Used to decide what IdP to assign the user to
   ScimTokenInfo ->
@@ -213,7 +213,7 @@ validateScimUser tokinfo user = do
   richInfoLimit <- lift $ inputs richInfoLimit
   validateScimUser' mIdpConfig richInfoLimit user
 
-tokenInfoToIdP :: Member IdPEffect.IdP r => ScimTokenInfo -> Scim.ScimHandler (Spar r) (Maybe IdP)
+tokenInfoToIdP :: Member IdPEffect.IdP r => ScimTokenInfo -> Scim.ScimHandler (Sem r) (Maybe IdP)
 tokenInfoToIdP ScimTokenInfo {stiIdP} = do
   maybe (pure Nothing) (lift . IdPEffect.getConfig) stiIdP
 
@@ -341,7 +341,7 @@ mkValidExternalId (Just idp) (Just extid) = do
               Scim.InvalidValue
               (Just $ "Can't construct a subject ID from externalId: " <> Text.pack err)
 
-logScim :: forall r a. (Member (Logger (Msg -> Msg)) r) => (Msg -> Msg) -> Scim.ScimHandler (Spar r) a -> Scim.ScimHandler (Spar r) a
+logScim :: forall r a. (Member (Logger (Msg -> Msg)) r) => (Msg -> Msg) -> Scim.ScimHandler (Sem r) a -> Scim.ScimHandler (Sem r) a
 logScim context action =
   flip mapExceptT action $ \action' -> do
     eith <- action'
@@ -394,7 +394,7 @@ veidEmail (ST.EmailOnly email) = Just email
 -- This is the pain and the price you pay for the horribleness called MTL
 createValidScimUser ::
   forall m r.
-  (m ~ Scim.ScimHandler (Spar r)) =>
+  (m ~ Scim.ScimHandler (Sem r)) =>
   Members
     '[ Random,
        Now,
@@ -504,7 +504,7 @@ updateValidScimUser ::
        SAMLUserStore
      ]
     r =>
-  (m ~ Scim.ScimHandler (Spar r)) =>
+  (m ~ Scim.ScimHandler (Sem r)) =>
   ScimTokenInfo ->
   UserId ->
   ST.ValidScimUser ->
@@ -569,7 +569,7 @@ updateVsuUref ::
   UserId ->
   ST.ValidExternalId ->
   ST.ValidExternalId ->
-  Spar r ()
+  Sem r ()
 updateVsuUref team uid old new = do
   let geturef = ST.runValidExternalId Just (const Nothing)
   case (geturef old, geturef new) of
@@ -617,7 +617,7 @@ updScimStoredUser ::
   Member Now r =>
   Scim.User ST.SparTag ->
   Scim.StoredUser ST.SparTag ->
-  Spar r (Scim.StoredUser ST.SparTag)
+  Sem r (Scim.StoredUser ST.SparTag)
 updScimStoredUser usr storedusr = do
   SAML.Time (toUTCTimeMillis -> now) <- Now.get
   pure $ updScimStoredUser' now usr storedusr
@@ -648,7 +648,7 @@ deleteScimUser ::
     r =>
   ScimTokenInfo ->
   UserId ->
-  Scim.ScimHandler (Spar r) ()
+  Scim.ScimHandler (Sem r) ()
 deleteScimUser tokeninfo@ScimTokenInfo {stiTeam, stiIdP} uid =
   logScim
     ( logFunction "Spar.Scim.User.deleteScimUser"
@@ -712,7 +712,7 @@ calculateVersion uid usr = Scim.Weak (Text.pack (show h))
 --
 -- ASSUMPTION: every scim user has a 'SAML.UserRef', and the `SAML.NameID` in it corresponds
 -- to a single `externalId`.
-assertExternalIdUnused :: Members '[BrigAccess, ScimExternalIdStore, SAMLUserStore] r => TeamId -> ST.ValidExternalId -> Scim.ScimHandler (Spar r) ()
+assertExternalIdUnused :: Members '[BrigAccess, ScimExternalIdStore, SAMLUserStore] r => TeamId -> ST.ValidExternalId -> Scim.ScimHandler (Sem r) ()
 assertExternalIdUnused tid veid = do
   assertExternalIdInAllowedValues
     [Nothing]
@@ -726,7 +726,7 @@ assertExternalIdUnused tid veid = do
 --
 -- ASSUMPTION: every scim user has a 'SAML.UserRef', and the `SAML.NameID` in it corresponds
 -- to a single `externalId`.
-assertExternalIdNotUsedElsewhere :: Members '[BrigAccess, ScimExternalIdStore, SAMLUserStore] r => TeamId -> ST.ValidExternalId -> UserId -> Scim.ScimHandler (Spar r) ()
+assertExternalIdNotUsedElsewhere :: Members '[BrigAccess, ScimExternalIdStore, SAMLUserStore] r => TeamId -> ST.ValidExternalId -> UserId -> Scim.ScimHandler (Sem r) ()
 assertExternalIdNotUsedElsewhere tid veid wireUserId = do
   assertExternalIdInAllowedValues
     [Nothing, Just wireUserId]
@@ -734,7 +734,7 @@ assertExternalIdNotUsedElsewhere tid veid wireUserId = do
     tid
     veid
 
-assertExternalIdInAllowedValues :: Members '[BrigAccess, ScimExternalIdStore, SAMLUserStore] r => [Maybe UserId] -> Text -> TeamId -> ST.ValidExternalId -> Scim.ScimHandler (Spar r) ()
+assertExternalIdInAllowedValues :: Members '[BrigAccess, ScimExternalIdStore, SAMLUserStore] r => [Maybe UserId] -> Text -> TeamId -> ST.ValidExternalId -> Scim.ScimHandler (Sem r) ()
 assertExternalIdInAllowedValues allowedValues errmsg tid veid = do
   isGood <-
     lift $
@@ -751,16 +751,16 @@ assertExternalIdInAllowedValues allowedValues errmsg tid veid = do
   unless isGood $
     throwError Scim.conflict {Scim.detail = Just errmsg}
 
-assertHandleUnused :: Member BrigAccess r => Handle -> Scim.ScimHandler (Spar r) ()
+assertHandleUnused :: Member BrigAccess r => Handle -> Scim.ScimHandler (Sem r) ()
 assertHandleUnused = assertHandleUnused' "userName is already taken"
 
-assertHandleUnused' :: Member BrigAccess r => Text -> Handle -> Scim.ScimHandler (Spar r) ()
+assertHandleUnused' :: Member BrigAccess r => Text -> Handle -> Scim.ScimHandler (Sem r) ()
 assertHandleUnused' msg hndl =
   lift (BrigAccess.checkHandleAvailable hndl) >>= \case
     True -> pure ()
     False -> throwError Scim.conflict {Scim.detail = Just msg}
 
-assertHandleNotUsedElsewhere :: Member BrigAccess r => UserId -> Handle -> Scim.ScimHandler (Spar r) ()
+assertHandleNotUsedElsewhere :: Member BrigAccess r => UserId -> Handle -> Scim.ScimHandler (Sem r) ()
 assertHandleNotUsedElsewhere uid hndl = do
   musr <- lift $ Brig.getBrigUser Brig.WithPendingInvitations uid
   unless ((userHandle =<< musr) == Just hndl) $
@@ -781,7 +781,7 @@ synthesizeStoredUser ::
     r =>
   UserAccount ->
   ST.ValidExternalId ->
-  Scim.ScimHandler (Spar r) (Scim.StoredUser ST.SparTag)
+  Scim.ScimHandler (Sem r) (Scim.StoredUser ST.SparTag)
 synthesizeStoredUser usr veid =
   logScim
     ( logFunction "Spar.Scim.User.synthesizeStoredUser"
@@ -794,14 +794,14 @@ synthesizeStoredUser usr veid =
       let uid = userId (accountUser usr)
           accStatus = accountStatus usr
 
-      let readState :: Spar r (RI.RichInfo, Maybe (UTCTimeMillis, UTCTimeMillis), URIBS.URI)
+      let readState :: Sem r (RI.RichInfo, Maybe (UTCTimeMillis, UTCTimeMillis), URIBS.URI)
           readState = do
             richInfo <- BrigAccess.getRichInfo uid
             accessTimes <- ScimUserTimesStore.read uid
             baseuri <- inputs $ derivedOptsScimBaseURI . derivedOpts
             pure (richInfo, accessTimes, baseuri)
 
-      let writeState :: Maybe (UTCTimeMillis, UTCTimeMillis) -> ManagedBy -> RI.RichInfo -> Scim.StoredUser ST.SparTag -> Spar r ()
+      let writeState :: Maybe (UTCTimeMillis, UTCTimeMillis) -> ManagedBy -> RI.RichInfo -> Scim.StoredUser ST.SparTag -> Sem r ()
           writeState oldAccessTimes oldManagedBy oldRichInfo storedUser = do
             when (isNothing oldAccessTimes) $ do
               ScimUserTimesStore.write storedUser
@@ -879,7 +879,7 @@ scimFindUserByHandle ::
   Maybe IdP ->
   TeamId ->
   Text ->
-  MaybeT (Scim.ScimHandler (Spar r)) (Scim.StoredUser ST.SparTag)
+  MaybeT (Scim.ScimHandler (Sem r)) (Scim.StoredUser ST.SparTag)
 scimFindUserByHandle mIdpConfig stiTeam hndl = do
   handle <- MaybeT . pure . parseHandle . Text.toLower $ hndl
   brigUser <- MaybeT . lift . BrigAccess.getByHandle $ handle
@@ -909,7 +909,7 @@ scimFindUserByEmail ::
   Maybe IdP ->
   TeamId ->
   Text ->
-  MaybeT (Scim.ScimHandler (Spar r)) (Scim.StoredUser ST.SparTag)
+  MaybeT (Scim.ScimHandler (Sem r)) (Scim.StoredUser ST.SparTag)
 scimFindUserByEmail mIdpConfig stiTeam email = do
   -- Azure has been observed to search for externalIds that are not emails, even if the
   -- mapping is set up like it should be.  This is a problem: if there is no SAML IdP, 'mkValidExternalId'
@@ -923,18 +923,18 @@ scimFindUserByEmail mIdpConfig stiTeam email = do
   guard $ userTeam (accountUser brigUser) == Just stiTeam
   lift $ synthesizeStoredUser brigUser veid
   where
-    withUref :: SAML.UserRef -> Spar r (Maybe UserId)
+    withUref :: SAML.UserRef -> Sem r (Maybe UserId)
     withUref uref = do
       SAMLUserStore.get uref >>= \case
         Nothing -> maybe (pure Nothing) withEmailOnly $ Brig.urefToEmail uref
         Just uid -> pure (Just uid)
 
-    withEmailOnly :: BT.Email -> Spar r (Maybe UserId)
+    withEmailOnly :: BT.Email -> Sem r (Maybe UserId)
     withEmailOnly eml = maybe inbrig (pure . Just) =<< inspar
       where
         -- FUTUREWORK: we could also always lookup brig, that's simpler and possibly faster,
         -- and it never should be visible in spar, but not in brig.
-        inspar, inbrig :: Spar r (Maybe UserId)
+        inspar, inbrig :: Sem r (Maybe UserId)
         inspar = ScimExternalIdStore.lookup stiTeam eml
         inbrig = userId . accountUser <$$> BrigAccess.getByEmail eml
 
diff --git a/services/spar/test-integration/Util/Core.hs b/services/spar/test-integration/Util/Core.hs
index a27e301b08..bc20e47856 100644
--- a/services/spar/test-integration/Util/Core.hs
+++ b/services/spar/test-integration/Util/Core.hs
@@ -168,6 +168,7 @@ import Network.HTTP.Client.MultipartFormData
 import qualified Network.Wai.Handler.Warp as Warp
 import qualified Network.Wai.Handler.Warp.Internal as Warp
 import qualified Options.Applicative as OPA
+import Polysemy (Sem)
 import SAML2.WebSSO as SAML
 import qualified SAML2.WebSSO.API.Example as SAML
 import SAML2.WebSSO.Test.Lenses (userRefL)
@@ -1220,7 +1221,7 @@ runSimpleSP action = do
 
 runSpar ::
   (MonadReader TestEnv m, MonadIO m) =>
-  Spar.Spar CanonicalEffs a ->
+  Sem CanonicalEffs a ->
   m a
 runSpar action = do
   ctx <- (^. teSparEnv) <$> ask

From dfd99d870329f8efb2d712fe22ddbca22f4d5f90 Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Sat, 2 Oct 2021 10:59:47 -0700
Subject: [PATCH 10/13] Stylistic cleanup

---
 services/spar/src/Spar/Scim/User.hs | 10 ++++------
 1 file changed, 4 insertions(+), 6 deletions(-)

diff --git a/services/spar/src/Spar/Scim/User.hs b/services/spar/src/Spar/Scim/User.hs
index ab152603c0..549a23c89d 100644
--- a/services/spar/src/Spar/Scim/User.hs
+++ b/services/spar/src/Spar/Scim/User.hs
@@ -447,9 +447,8 @@ createValidScimUser tokeninfo@ScimTokenInfo {stiTeam} vsu@(ST.ValidScimUser veid
           -- up.  We should consider making setUserHandle part of createUser and
           -- making it transactional.  If the user redoes the POST A new standalone
           -- user will be created.}
-          do
-            BrigAccess.setHandle buid handl
-            BrigAccess.setRichInfo buid richInfo
+          BrigAccess.setHandle buid handl
+          BrigAccess.setRichInfo buid richInfo
           pure buid
 
       -- {If we crash now,  a POST retry will fail with 409 user already exists.
@@ -576,9 +575,8 @@ updateVsuUref team uid old new = do
     (mo, mn@(Just newuref)) | mo /= mn -> validateEmailIfExists uid newuref
     _ -> pure ()
 
-  do
-    old & ST.runValidExternalId (SAMLUserStore.delete uid) (ScimExternalIdStore.delete team)
-    new & ST.runValidExternalId (`SAMLUserStore.insert` uid) (\email -> ScimExternalIdStore.insert team email uid)
+  old & ST.runValidExternalId (SAMLUserStore.delete uid) (ScimExternalIdStore.delete team)
+  new & ST.runValidExternalId (`SAMLUserStore.insert` uid) (\email -> ScimExternalIdStore.insert team email uid)
 
   BrigAccess.setVeid uid new
 

From fde7d6e8947d12d9d6efdbe2ac2c4e784f81d7f3 Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Mon, 4 Oct 2021 10:53:16 -0700
Subject: [PATCH 11/13] Changelog

---
 changelog.d/5-internal/spar-no-io-2 | 1 +
 1 file changed, 1 insertion(+)
 create mode 100644 changelog.d/5-internal/spar-no-io-2

diff --git a/changelog.d/5-internal/spar-no-io-2 b/changelog.d/5-internal/spar-no-io-2
new file mode 100644
index 0000000000..b682ca5002
--- /dev/null
+++ b/changelog.d/5-internal/spar-no-io-2
@@ -0,0 +1 @@
+Replace the `Spar` newtype, instead using `Sem` directly.

From d36a79e3dcc672b11733bce3a60c61b62455b011 Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Mon, 4 Oct 2021 12:55:38 -0700
Subject: [PATCH 12/13] Weird rebase problem

---
 services/spar/src/Spar/Scim.hs | 15 ++++++++-------
 1 file changed, 8 insertions(+), 7 deletions(-)

diff --git a/services/spar/src/Spar/Scim.hs b/services/spar/src/Spar/Scim.hs
index 142bbfb56e..95ae0d4db5 100644
--- a/services/spar/src/Spar/Scim.hs
+++ b/services/spar/src/Spar/Scim.hs
@@ -73,11 +73,10 @@ import qualified SAML2.WebSSO as SAML
 import Servant
 import Servant.API.Generic
 import Servant.Server.Generic (AsServerT)
-import Spar.App (Spar (..), runSparInSem, throwSparSem)
+import Spar.App (sparToServerErrorWithLogging, throwSparSem)
 import Spar.Error
   ( SparCustomError (SparScimError),
     SparError,
-    sparToServerErrorWithLogging,
   )
 import Spar.Scim.Auth
 import Spar.Scim.User
@@ -87,6 +86,7 @@ import qualified Spar.Sem.IdP as IdPEffect
 import Spar.Sem.Logger (Logger)
 import Spar.Sem.Now (Now)
 import Spar.Sem.Random (Random)
+import Spar.Sem.Reporter (Reporter)
 import Spar.Sem.SAMLUserStore (SAMLUserStore)
 import Spar.Sem.ScimExternalIdStore (ScimExternalIdStore)
 import Spar.Sem.ScimTokenStore (ScimTokenStore)
@@ -124,13 +124,14 @@ apiScim ::
        ScimExternalIdStore,
        ScimUserTimesStore,
        ScimTokenStore,
+       Reporter,
        IdPEffect.IdP,
        -- TODO(sandy): Only necessary for 'fromExceptionSem'. But can these errors even happen?
        Final IO,
        SAMLUserStore
      ]
     r =>
-  ServerT APIScim (Spar r)
+  ServerT APIScim (Sem r)
 apiScim =
   hoistScim (toServant (server configuration))
     :<|> apiScimToken
@@ -146,10 +147,10 @@ apiScim =
     -- Let's hope that SCIM clients can handle non-SCIM-formatted errors
     -- properly. See <https://github.com/haskell-servant/servant/issues/1022>
     -- for why it's hard to catch impure exceptions.
-    wrapScimErrors :: Spar r a -> Spar r a
-    wrapScimErrors act = Spar $ do
+    wrapScimErrors :: Sem r a -> Sem r a
+    wrapScimErrors act = do
       result :: Either SomeException (Either SparError a) <-
-        runError $ fromExceptionSem @SomeException $ raise $ try @SparError $ runSparInSem act
+        runError $ fromExceptionSem @SomeException $ raise $ try @SparError act
       case result of
         Left someException -> do
           -- We caught an exception that's not a Spar exception at all. It is wrapped into
@@ -162,7 +163,7 @@ apiScim =
         Right (Left sparError) -> do
           -- We caught some other Spar exception. It is rendered and wrapped into a scim error
           -- with the same status and message, and no scim error type.
-          err :: ServerError <- undefined -- embedFinal @IO $ sparToServerErrorWithLogging undefined sparError
+          err :: ServerError <- sparToServerErrorWithLogging sparError
           throw . SAML.CustomError . SparScimError $
             Scim.ScimError
               { schemas = [Scim.Schema.Error20],

From 5a469da6b2a1e8f0439f84c08ff185b911c18dba Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Mon, 4 Oct 2021 21:48:54 -0700
Subject: [PATCH 13/13] Review comments

---
 services/spar/src/Spar/CanonicalInterpreter.hs | 4 ++--
 services/spar/src/Spar/Scim/Auth.hs            | 4 ++++
 services/spar/src/Spar/Sem/Reporter/Wai.hs     | 4 ++--
 3 files changed, 8 insertions(+), 4 deletions(-)

diff --git a/services/spar/src/Spar/CanonicalInterpreter.hs b/services/spar/src/Spar/CanonicalInterpreter.hs
index 19d0f788b3..12e9616376 100644
--- a/services/spar/src/Spar/CanonicalInterpreter.hs
+++ b/services/spar/src/Spar/CanonicalInterpreter.hs
@@ -33,7 +33,7 @@ import Spar.Sem.Now.IO (nowToIO)
 import Spar.Sem.Random (Random)
 import Spar.Sem.Random.IO (randomToIO)
 import Spar.Sem.Reporter (Reporter)
-import Spar.Sem.Reporter.Wai (reporterToWai)
+import Spar.Sem.Reporter.Wai (reporterToTinyLogWai)
 import Spar.Sem.SAML2 (SAML2)
 import Spar.Sem.SAML2.Library (saml2ToSaml2WebSso)
 import Spar.Sem.SAMLUserStore (SAMLUserStore)
@@ -88,7 +88,7 @@ runSparToIO ctx action =
     . runInputConst (sparCtxOpts ctx)
     . loggerToTinyLog (sparCtxLogger ctx)
     . stringLoggerToTinyLog
-    . reporterToWai
+    . reporterToTinyLogWai
     . runError @SparError
     . ttlErrorToSparError
     . galleyAccessToHttp (sparCtxHttpManager ctx) (sparCtxHttpGalley ctx)
diff --git a/services/spar/src/Spar/Scim/Auth.hs b/services/spar/src/Spar/Scim/Auth.hs
index 202e0410bb..f3ae450783 100644
--- a/services/spar/src/Spar/Scim/Auth.hs
+++ b/services/spar/src/Spar/Scim/Auth.hs
@@ -138,6 +138,10 @@ createScimToken zusr CreateScimToken {..} = do
       caseOneOrNoIdP midpid = do
         token <- ScimToken . cs . ES.encode <$> Random.bytes 32
         tokenid <- Random.scimTokenId
+        -- FUTUREWORK(fisx): the fact that we're using @Now.get@
+        -- here means that the 'Now' effect should not contain
+        -- types from saml2-web-sso. We can just use 'UTCTime'
+        -- there, right?
         now <- Now.get
         let info =
               ScimTokenInfo
diff --git a/services/spar/src/Spar/Sem/Reporter/Wai.hs b/services/spar/src/Spar/Sem/Reporter/Wai.hs
index 4e149955be..548be65b32 100644
--- a/services/spar/src/Spar/Sem/Reporter/Wai.hs
+++ b/services/spar/src/Spar/Sem/Reporter/Wai.hs
@@ -7,8 +7,8 @@ import Polysemy.Input
 import Spar.Sem.Reporter
 import qualified System.Logger as TinyLog
 
-reporterToWai :: Members '[Embed IO, Input TinyLog.Logger] r => Sem (Reporter ': r) a -> Sem r a
-reporterToWai = interpret $ \case
+reporterToTinyLogWai :: Members '[Embed IO, Input TinyLog.Logger] r => Sem (Reporter ': r) a -> Sem r a
+reporterToTinyLogWai = interpret $ \case
   Report req err -> do
     logger <- input
     embed @IO $ Wai.logError logger req err