Spar tests cleanup

services/spar/test-integration/Test/Spar/APISpec.hs

@@ -40,9 +40,9 @@ import qualified Galley.Types.Teams as Galley
 import Imports hiding (head)
 import Network.HTTP.Types (status200, status202)
 import SAML2.WebSSO as SAML
-import SAML2.WebSSO.Test.Credentials (sampleIdPCert2, sampleIdPPrivkey, sampleIdPPrivkey2)
 import SAML2.WebSSO.Test.Lenses
 import SAML2.WebSSO.Test.MockResponse
+import SAML2.WebSSO.Test.Util
 import Spar.API.Types
 import qualified Spar.Intra.Brig as Intra
 import Spar.Types
@@ -416,7 +416,7 @@ specBindingUsers = describe "binding existing users to sso identities" $ do
         reBindDifferent :: HasCallStack => UserId -> TestSpar (SignedAuthnResponse, ResponseLBS)
         reBindDifferent uid = do
           env <- ask
-          (metadata, privcreds) <- makeTestIdPMetadata
+          (SampleIdP metadata privcreds _ _) <- makeSampleIdPMetadata
           idp <- call $ callIdpCreate (env ^. teSpar) (Just uid) metadata
           (_, authnResp, sparAuthnResp) <- initialBind uid idp privcreds
           pure (authnResp, sparAuthnResp)
@@ -548,15 +548,13 @@ specCRUDIdentityProvider = do
       it "responds with 2xx and IdP" $ do
         env <- ask
         (owner, _, (^. idpId) -> idpid) <- registerTestIdP
-        _ <- call $ callIdpGet (env ^. teSpar) (Just owner) idpid
-        passes
+        void . call $ callIdpGet (env ^. teSpar) (Just owner) idpid
     context "known IdP, client is team owner (authenticated via sso, user without email)" $ do
       it "responds with 2xx and IdP" $ do
         env <- ask
         (firstOwner, tid, idp, (_, privcreds)) <- registerTestIdPWithMeta
         ssoOwner <- mkSsoOwner firstOwner tid idp privcreds
-        _ <- call $ callIdpGet (env ^. teSpar) (Just ssoOwner) (idp ^. idpId)
-        passes
+        void . call $ callIdpGet (env ^. teSpar) (Just ssoOwner) (idp ^. idpId)
   describe "GET /identity-providers" $ do
     context "client is not team owner" $ do
       it "rejects" $ do
@@ -580,14 +578,14 @@ specCRUDIdentityProvider = do
       context "client is team owner with email" $ do
         it "returns a non-empty empty list" $ do
           env <- ask
-          (metadata, _) <- makeTestIdPMetadata
+          (SampleIdP metadata _ _ _) <- makeSampleIdPMetadata
           (owner, _, _) <- registerTestIdPFrom metadata (env ^. teMgr) (env ^. teBrig) (env ^. teGalley) (env ^. teSpar)
           callIdpGetAll (env ^. teSpar) (Just owner)
             `shouldRespondWith` (not . null . _idplProviders)
       context "client is team owner without email" $ do
         it "returns a non-empty empty list" $ do
           env <- ask
-          (metadata, privcreds) <- makeTestIdPMetadata
+          (SampleIdP metadata privcreds _ _) <- makeSampleIdPMetadata
           (firstOwner, tid, idp) <- registerTestIdPFrom metadata (env ^. teMgr) (env ^. teBrig) (env ^. teGalley) (env ^. teSpar)
           ssoOwner <- mkSsoOwner firstOwner tid idp privcreds
           callIdpGetAll (env ^. teSpar) (Just ssoOwner)
@@ -665,7 +663,7 @@ specCRUDIdentityProvider = do
       it "rejects" $ do
         env <- ask
         (owner1, _, (^. idpId) -> idpid1, (IdPMetadataValue _ idpmeta1, _)) <- registerTestIdPWithMeta
-        (idpmeta2, _) <- makeTestIdPMetadata
+        (SampleIdP idpmeta2 _ _ _) <- makeSampleIdPMetadata
         _ <- call $ callIdpCreate (env ^. teSpar) (Just owner1) idpmeta2
         let idpmeta3 = idpmeta1 & edIssuer .~ (idpmeta2 ^. edIssuer)
         callIdpUpdate' (env ^. teSpar) (Just owner1) idpid1 (IdPMetadataValue (cs $ SAML.encode idpmeta3) undefined)
@@ -739,22 +737,24 @@ specCRUDIdentityProvider = do
         liftIO $ requri `shouldBe` idpmeta' ^. edRequestURI
     describe "new certs" $ do
       let -- Create a team, idp, and update idp with 'sampleIdPCert2'.
-          initidp :: HasCallStack => TestSpar IdP
+          initidp :: HasCallStack => TestSpar (IdP, SignPrivCreds, SignPrivCreds)
           initidp = do
             env <- ask
-            (owner, _, idp, (IdPMetadataValue _ idpmeta, _)) <- registerTestIdPWithMeta
+            (owner, _, idp, (IdPMetadataValue _ idpmeta, oldPrivKey)) <- registerTestIdPWithMeta
+            (SampleIdP _ newPrivKey _ sampleIdPCert2) <- makeSampleIdPMetadata
             let idpmeta' = idpmeta & edCertAuthnResponse .~ (sampleIdPCert2 :| [])
             callIdpUpdate' (env ^. teSpar) (Just owner) (idp ^. idpId) (IdPMetadataValue (cs $ SAML.encode idpmeta') undefined)
               `shouldRespondWith` ((== 200) . statusCode)
-            pure idp
+            pure (idp, oldPrivKey, newPrivKey)
           -- Sign authn response with a given private key (which may be the one matching
           -- 'sampleIdPCert2' or not), and check the status of spars response.
-          check :: HasCallStack => SignPrivCreds -> Int -> String -> Either String () -> TestSpar ()
-          check privkey expectedStatus expectedHtmlTitle expectedCookie = do
-            idp <- initidp
+          check :: HasCallStack => Bool -> Int -> String -> Either String () -> TestSpar ()
+          check useNewPrivKey expectedStatus expectedHtmlTitle expectedCookie = do
+            (idp, oldPrivKey, newPrivKey) <- initidp
             env <- ask
             (_, authnreq) <- call $ callAuthnReq (env ^. teSpar) (idp ^. idpId)
             spmeta <- getTestSPMetadata
+            let privkey = if useNewPrivKey then newPrivKey else oldPrivKey
             idpresp <- runSimpleSP $ mkAuthnResponse privkey idp spmeta authnreq True
             sparresp <- submitAuthnResponse idpresp
             liftIO $ do
@@ -764,13 +764,13 @@ specCRUDIdentityProvider = do
               hasPersistentCookieHeader sparresp `shouldBe` expectedCookie
       it "uses those certs on next auth handshake" $ do
         check
-          sampleIdPPrivkey2
+          True
           200
           "<title>wire:sso:success</title>"
           (Right ())
       it "removes all old certs (even if there were more before)" $ do
         check
-          sampleIdPPrivkey
+          False
           400
           "<title>wire:sso:error:bad-response-signature</title>"
           (Left "no set-cookie header")
@@ -779,7 +779,7 @@ specCRUDIdentityProvider = do
       it "responds with 403 forbidden" $ do
         env <- ask
         (uid, _tid) <- call $ createUserWithTeamDisableSSO (env ^. teBrig) (env ^. teGalley)
-        (metadata, _) <- makeTestIdPMetadata
+        (SampleIdP metadata _ _ _) <- makeSampleIdPMetadata
         callIdpCreate' (env ^. teSpar) (Just uid) metadata
           `shouldRespondWith` checkErr (== 403) "sso-disabled"
     context "bad xml" $ do
@@ -790,14 +790,14 @@ specCRUDIdentityProvider = do
     context "no zuser" $ do
       it "responds with 'client error'" $ do
         env <- ask
-        (idpmeta, _) <- makeTestIdPMetadata
+        (SampleIdP idpmeta _ _ _) <- makeSampleIdPMetadata
         callIdpCreate' (env ^. teSpar) Nothing idpmeta
           `shouldRespondWith` checkErr (== 400) "client-error"
     context "zuser has no team" $ do
       it "responds with 'no team member'" $ do
         env <- ask
         (uid, _) <- call $ createRandomPhoneUser (env ^. teBrig)
-        (idpmeta, _) <- makeTestIdPMetadata
+        (SampleIdP idpmeta _ _ _) <- makeSampleIdPMetadata
         callIdpCreate' (env ^. teSpar) (Just uid) idpmeta
           `shouldRespondWith` checkErr (== 403) "no-team-member"
     context "zuser is a team member, but not a team owner" $ do
@@ -812,7 +812,7 @@ specCRUDIdentityProvider = do
     context "idp (identified by issuer) is in use by other team" $ do
       it "rejects" $ do
         env <- ask
-        (newMetadata, _) <- makeTestIdPMetadata
+        (SampleIdP newMetadata _ _ _) <- makeSampleIdPMetadata
         (uid1, _) <- call $ createUserWithTeam (env ^. teBrig) (env ^. teGalley)
         (uid2, _) <- call $ createUserWithTeam (env ^. teBrig) (env ^. teGalley)
         resp1 <- call $ callIdpCreate' (env ^. teSpar) (Just uid1) newMetadata
@@ -828,7 +828,7 @@ specCRUDIdentityProvider = do
       it "responds with 2xx; makes IdP available for GET /identity-providers/" $ do
         env <- ask
         (owner, _) <- call $ createUserWithTeam (env ^. teBrig) (env ^. teGalley)
-        (metadata, _) <- makeTestIdPMetadata
+        (SampleIdP metadata _ _ _) <- makeSampleIdPMetadata
         idp <- call $ callIdpCreate (env ^. teSpar) (Just owner) metadata
         idp' <- call $ callIdpGet (env ^. teSpar) (Just owner) (idp ^. idpId)
         rawmeta <- call $ callIdpGetRaw (env ^. teSpar) (Just owner) (idp ^. idpId)
@@ -849,7 +849,7 @@ specCRUDIdentityProvider = do
         it "responds with 2xx; makes IdP available for GET /identity-providers/" $ do
           env <- ask
           (owner, _) <- call $ createUserWithTeam (env ^. teBrig) (env ^. teGalley)
-          metadata <- Aeson.encode . (IdPMetadataValue mempty) . fst <$> makeTestIdPMetadata
+          metadata <- Aeson.encode . IdPMetadataValue mempty . sampleIdPMetadata <$> makeSampleIdPMetadata
           idp <- call $ callIdpCreateRaw (env ^. teSpar) (Just owner) "application/json" metadata
           idp' <- call $ callIdpGet (env ^. teSpar) (Just owner) (idp ^. idpId)
           rawmeta <- call $ callIdpGetRaw (env ^. teSpar) (Just owner) (idp ^. idpId)

services/spar/test-integration/Test/Spar/AppSpec.hs

@@ -31,14 +31,14 @@ import Data.String.Conversions
 import Imports
 import SAML2.Util ((-/))
 import SAML2.WebSSO as SAML
-import qualified SAML2.WebSSO.Test.Credentials as SAML
 import qualified SAML2.WebSSO.Test.MockResponse as SAML
 import qualified Servant
 import qualified Spar.App as Spar
 import qualified Spar.Data as Data
 import Spar.Orphans ()
 import Spar.Types (IdP)
 import qualified Text.XML as XML
+import qualified Text.XML.DSig as DSig
 import URI.ByteString as URI
 import URI.ByteString.QQ (uri)
 import Util
@@ -153,12 +153,13 @@ requestAccessVerdict idp isGranted mkAuthnReq = do
     bdy <- maybe (error "authreq") pure $ responseBody raw
     either (error . show) pure $ Servant.mimeUnrender (Servant.Proxy @SAML.HTML) bdy
   spmeta <- getTestSPMetadata
+  (privKey, _, _) <- DSig.mkSignCredsWithCert Nothing 96
   authnresp :: SAML.AuthnResponse <- do
     case authnreq of
       (SAML.FormRedirect _ req) -> do
         SAML.SignedAuthnResponse (XML.Document _ el _) <-
           runSimpleSP $
-            SAML.mkAuthnResponseWithSubj subject SAML.sampleIdPPrivkey idp spmeta req True
+            SAML.mkAuthnResponseWithSubj subject privKey idp spmeta req True
         either (error . show) pure $ SAML.parse [XML.NodeElement el]
   let verdict =
         if isGranted

services/spar/test-integration/Util/Core.hs

@@ -31,7 +31,6 @@ module Util.Core
     destroyEnv,
 
     -- * Test helpers
-    passes,
     it,
     pending,
     pendingWith,
@@ -68,9 +67,7 @@ module Util.Core
     createRandomPhoneUser,
     zUser,
     ping,
-    makeIssuer,
     makeTestIdP,
-    makeTestIdPMetadata,
     getTestSPMetadata,
     registerTestIdP,
     registerTestIdPWithMeta,
@@ -144,7 +141,6 @@ import qualified Data.ByteString.Base64.Lazy as EL
 import Data.ByteString.Conversion
 import Data.Handle (Handle (Handle))
 import Data.Id
-import Data.List.NonEmpty (NonEmpty ((:|)))
 import Data.Misc (PlainTextPassword (..))
 import Data.Proxy
 import Data.Range
@@ -166,6 +162,7 @@ import SAML2.WebSSO as SAML
 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.API.Types
 import Spar.App (toLevel)
 import qualified Spar.App as Spar
@@ -184,7 +181,6 @@ import qualified Text.XML.Cursor as XML
 import Text.XML.DSig (SignPrivCreds)
 import qualified Text.XML.DSig as SAML
 import URI.ByteString
-import URI.ByteString.QQ (uri)
 import Util.Options
 import Util.Types
 import qualified Web.Cookie as Web
@@ -251,9 +247,6 @@ mkEnv _teTstOpts _teOpts = do
 destroyEnv :: HasCallStack => TestEnv -> IO ()
 destroyEnv _ = pure ()
 
-passes :: MonadIO m => m ()
-passes = liftIO $ True `shouldBe` True
-
 it ::
   HasCallStack =>
   -- or, more generally:
@@ -639,28 +632,13 @@ call req = ask >>= \env -> liftIO $ runHttpT (env ^. teMgr) req
 ping :: (Request -> Request) -> Http ()
 ping req = void . get $ req . path "/i/status" . expect2xx
 
-makeIssuer :: MonadIO m => m Issuer
-makeIssuer = do
-  uuid <- liftIO UUID.nextRandom
-  either
-    (liftIO . throwIO . ErrorCall . show)
-    (pure . Issuer)
-    (SAML.parseURI' ("https://issuer.net/_" <> UUID.toText uuid))
-
 makeTestIdP :: (HasCallStack, MonadRandom m, MonadIO m) => m (IdPConfig WireIdP)
-makeTestIdP = IdPConfig <$> (IdPId <$> liftIO UUID.nextRandom) <*> (fst <$> makeTestIdPMetadata) <*> nextWireIdP
-
--- | Create a cloned new 'IdPMetadata' value from the sample value already registered, but with a
--- fresh random 'Issuer'.  This is the simplest way to get such a value for registration of a new
--- 'IdP' (registering the same 'Issuer' twice is an error).
-makeTestIdPMetadata :: (HasCallStack, MonadRandom m, MonadIO m) => m (IdPMetadata, SAML.SignPrivCreds)
-makeTestIdPMetadata = do
-  issuer <- makeIssuer
-  requri <- do
-    uuid :: ByteString <- UUID.toASCIIBytes <$> liftIO UUID.nextRandom
-    pure $ [uri|https://requri.net/|] & pathL .~ ("/" <> uuid)
-  (privkey, _, cert) <- SAML.mkSignCredsWithCert Nothing 96
-  pure (IdPMetadata issuer requri (cert :| []), privkey)
+makeTestIdP = do
+  SampleIdP md _ _ _ <- makeSampleIdPMetadata
+  IdPConfig
+    <$> (IdPId <$> liftIO UUID.nextRandom)
+    <*> (pure md)
+    <*> nextWireIdP
 
 getTestSPMetadata :: (HasCallStack, MonadReader TestEnv m, MonadIO m) => m SPMetadata
 getTestSPMetadata = do
@@ -685,7 +663,7 @@ registerTestIdPWithMeta ::
   (HasCallStack, MonadRandom m, MonadIO m, MonadReader TestEnv m) =>
   m (UserId, TeamId, IdP, (IdPMetadataInfo, SAML.SignPrivCreds))
 registerTestIdPWithMeta = do
-  (idpmeta, privkey) <- makeTestIdPMetadata
+  (SampleIdP idpmeta privkey _ _) <- makeSampleIdPMetadata
   env <- ask
   (uid, tid, idp) <- registerTestIdPFrom idpmeta (env ^. teMgr) (env ^. teBrig) (env ^. teGalley) (env ^. teSpar)
   pure (uid, tid, idp, (IdPMetadataValue (cs $ SAML.encode idpmeta) idpmeta, privkey))

stack.yaml

@@ -61,7 +61,7 @@ extra-deps:
   # a version > 1.0.0 of wai-middleware-prometheus is available
   # (required: https://github.com/fimad/prometheus-haskell/pull/45)
 - git: https://github.com/wireapp/saml2-web-sso
-  commit: 80ecd2e7e01d5c1c17303e81f75fd37e41ee3da4  # master (Apr 16, 2020)
+  commit: 687d9ac8ac2994aff8436189c6ecce29faad8500  # master (May 18, 2020)
 - git: https://github.com/wireapp/hscim
   commit: 2909c81a0aa4bd4c2c21acafa64b2f744f787df6  # master (Mar 27, 2020)
 

stack.yaml.lock

@@ -29,18 +29,18 @@ packages:
     commit: 2e3282e5fb27ba8d989c271a0a989823fad7ec43
 - completed:
     cabal-file:
-      size: 8428
-      sha256: fe2cb8e7ce1a52a945af37523411732004952ceedddaeb10927722c46c96aa9e
+      size: 8392
+      sha256: 2c5d7f46633fb414eeb43facfe1018378f001b8b67dd77a45d110db84e46034c
     name: saml2-web-sso
     version: '0.18'
     git: https://github.com/wireapp/saml2-web-sso
     pantry-tree:
-      size: 4678
-      sha256: 4762eec362681b6bb26651d14d070d6c4da7d3dea1e9d2f166ae082d514d108d
-    commit: 80ecd2e7e01d5c1c17303e81f75fd37e41ee3da4
+      size: 4601
+      sha256: 384b8c469846b709e48e403b3600cde3287bd4b0e712a423e75eb93da68c918a
+    commit: 75df340ad8a237f947270e6cdc617ceb70f27a05
   original:
     git: https://github.com/wireapp/saml2-web-sso
-    commit: 80ecd2e7e01d5c1c17303e81f75fd37e41ee3da4
+    commit: 75df340ad8a237f947270e6cdc617ceb70f27a05
 - completed:
     cabal-file:
       size: 9076