Pull Spar.Data apart (#2064)

* Split up Spar.Data

* make format

* Fix test

* changelog

Author: isovector

changelog.d/5-internal/diversify-data

@@ -0,0 +1 @@
+Separate Spar.Data module into smaller Cassandra interpreters

services/spar/src/Spar/API.hs

@@ -61,7 +61,6 @@ import Servant
 import qualified Servant.Multipart as Multipart
 import Spar.App
 import Spar.CanonicalInterpreter
-import qualified Spar.Data as Data (GetIdPResult (..), Replaced (..), Replacing (..))
 import Spar.Error
 import qualified Spar.Intra.BrigApp as Brig
 import Spar.Orphans ()
@@ -76,6 +75,7 @@ import Spar.Sem.DefaultSsoCode (DefaultSsoCode)
 import qualified Spar.Sem.DefaultSsoCode as DefaultSsoCode
 import Spar.Sem.GalleyAccess (GalleyAccess)
 import qualified Spar.Sem.GalleyAccess as GalleyAccess
+import Spar.Sem.IdP (GetIdPResult (..), Replaced (..), Replacing (..))
 import qualified Spar.Sem.IdP as IdPEffect
 import Spar.Sem.IdPRawMetadataStore (IdPRawMetadataStore)
 import qualified Spar.Sem.IdPRawMetadataStore as IdPRawMetadataStore
@@ -494,11 +494,11 @@ idpDelete zusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (cons
     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
-        Data.GetIdPNotFound -> pure ()
-        Data.GetIdPDanglingId _ -> pure ()
-        Data.GetIdPNonUnique _ -> pure ()
-        Data.GetIdPWrongTeam _ -> pure ()
+        GetIdPFound iid -> IdPEffect.clearReplacedBy $ Replaced iid
+        GetIdPNotFound -> pure ()
+        GetIdPDanglingId _ -> pure ()
+        GetIdPNonUnique _ -> pure ()
+        GetIdPWrongTeam _ -> pure ()
 
 -- | This handler only does the json parsing, and leaves all authorization checks and
 -- application logic to 'idpCreateXML'.
@@ -548,7 +548,7 @@ idpCreateXML zusr raw idpmeta mReplaces (fromMaybe defWireIdPAPIVersion -> apive
   IdPRawMetadataStore.store (idp ^. SAML.idpId) raw
   storeIdPConfig idp
   forM_ mReplaces $ \replaces -> do
-    IdPEffect.setReplacedBy (Data.Replaced replaces) (Data.Replacing (idp ^. SAML.idpId))
+    IdPEffect.setReplacedBy (Replaced replaces) (Replacing (idp ^. SAML.idpId))
   pure idp
 
 -- | In teams with a scim access token, only one IdP is allowed.  The reason is that scim user
@@ -636,11 +636,11 @@ validateNewIdP apiversion _idpMetadata teamId mReplaces = withDebugLog "validate
             pure ()
 
   case idp of
-    Data.GetIdPFound idp' {- same team -} -> handleIdPClash (Right idp')
-    Data.GetIdPNotFound -> pure ()
-    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')
+    GetIdPFound idp' {- same team -} -> handleIdPClash (Right idp')
+    GetIdPNotFound -> pure ()
+    res@(GetIdPDanglingId _) -> throwSparSem . SparIdPNotFound . ("validateNewIdP: " <>) . cs . show $ res -- database inconsistency
+    GetIdPNonUnique ids' {- same team didn't yield anything, but there are at least two other teams with this issuer already -} -> handleIdPClash (Left ids')
+    GetIdPWrongTeam id' {- different team -} -> handleIdPClash (Left id')
 
   pure SAML.IdPConfig {..}
 
@@ -726,11 +726,11 @@ validateIdPUpdate zusr _idpMetadata _idpId = withDebugLog "validateNewIdP" (Just
       else do
         foundConfig <- getIdPConfigByIssuerAllowOld newIssuer (Just teamId)
         notInUseByOthers <- case foundConfig of
-          Data.GetIdPFound c -> pure $ c ^. SAML.idpId == _idpId
-          Data.GetIdPNotFound -> pure True
-          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
+          GetIdPFound c -> pure $ c ^. SAML.idpId == _idpId
+          GetIdPNotFound -> pure True
+          res@(GetIdPDanglingId _) -> throwSparSem . SparIdPNotFound . ("validateIdPUpdate: " <>) . cs . show $ res -- impossible
+          res@(GetIdPNonUnique _) -> throwSparSem . SparIdPNotFound . ("validateIdPUpdate: " <>) . cs . show $ res -- impossible (because team id was used in lookup)
+          GetIdPWrongTeam _ -> pure False
         if notInUseByOthers
           then pure $ (previousIdP ^. SAML.idpExtraInfo) & wiOldIssuers %~ nub . (previousIssuer :)
           else throwSparSem SparIdPIssuerInUse

services/spar/src/Spar/App.hs

@@ -76,7 +76,6 @@ import qualified SAML2.WebSSO as SAML
 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 hiding (sparToServerErrorWithLogging)
 import qualified Spar.Intra.BrigApp as Intra
 import Spar.Orphans ()
@@ -141,11 +140,11 @@ storeIdPConfig idp = IdPEffect.storeConfig 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
-    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)
+    GetIdPFound idp -> pure idp
+    GetIdPNotFound -> throwSparSem $ SparIdPNotFound mempty
+    res@(GetIdPDanglingId _) -> throwSparSem $ SparIdPNotFound (cs $ show res)
+    res@(GetIdPNonUnique _) -> throwSparSem $ SparIdPNotFound (cs $ show res)
+    res@(GetIdPWrongTeam _) -> throwSparSem $ SparIdPNotFound (cs $ show res)
 
 insertUser :: Member SAMLUserStore r => SAML.UserRef -> UserId -> Sem r ()
 insertUser uref uid = SAMLUserStore.insert uref uid
@@ -338,11 +337,11 @@ bindUser buid userref = do
         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 -> throwSparSem $ SparUserRefInNoOrMultipleTeams (cs $ show (buid, is))
-        Data.GetIdPWrongTeam _ -> err -- impossible
+        GetIdPFound idp -> pure $ idp ^. idpExtraInfo . wiTeam
+        GetIdPNotFound -> err
+        GetIdPDanglingId _ -> err -- database inconsistency
+        GetIdPNonUnique is -> throwSparSem $ SparUserRefInNoOrMultipleTeams (cs $ show (buid, is))
+        GetIdPWrongTeam _ -> err -- impossible
     acc <- BrigAccess.getAccount Intra.WithPendingInvitations buid >>= maybe err pure
     teamid' :: TeamId <- userTeam (accountUser acc) & maybe err pure
     unless (teamid' == teamid) err