From 2051af9296519995a7338da2b5a84baef48bbc5b Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Mon, 26 Jul 2021 08:13:35 +0200 Subject: [PATCH 01/12] Require client certificates in demo nginz --- deploy/services-demo/conf/nginz/nginx.conf | 2 ++ 1 file changed, 2 insertions(+) diff --git a/deploy/services-demo/conf/nginz/nginx.conf b/deploy/services-demo/conf/nginz/nginx.conf index f4249995d7b..2f837d52f63 100644 --- a/deploy/services-demo/conf/nginz/nginx.conf +++ b/deploy/services-demo/conf/nginz/nginx.conf @@ -130,6 +130,8 @@ http { ssl_certificate integration-leaf.pem; ssl_certificate_key integration-leaf-key.pem; + ssl_verify_client on; + ssl_client_certificate integration-ca.pem; ######## TLS/SSL block end ############## zauth_keystore resources/zauth/pubkeys.txt; From 12e3befeff3563d0eb5838528db6aee510138d35 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Mon, 26 Jul 2021 08:14:26 +0200 Subject: [PATCH 02/12] Wrap CA store in a TLSSettings structure --- services/federator/src/Federator/Env.hs | 6 +++++- services/federator/src/Federator/InternalServer.hs | 4 ++-- services/federator/src/Federator/Run.hs | 1 + 3 files changed, 8 insertions(+), 3 deletions(-) diff --git a/services/federator/src/Federator/Env.hs b/services/federator/src/Federator/Env.hs index e9d24574994..17f3f293935 100644 --- a/services/federator/src/Federator/Env.hs +++ b/services/federator/src/Federator/Env.hs @@ -31,6 +31,9 @@ import qualified Network.HTTP.Client as HTTP import qualified System.Logger.Class as LC import Wire.API.Federation.GRPC.Types +data TLSSettings = TLSSettings + {_caStore :: CertificateStore} + data Env = Env { _metrics :: Metrics, _applog :: LC.Logger, @@ -39,7 +42,8 @@ data Env = Env _runSettings :: RunSettings, _service :: Component -> RPC.Request, _httpManager :: HTTP.Manager, - _caStore :: CertificateStore + _tls :: TLSSettings } +makeLenses ''TLSSettings makeLenses ''Env diff --git a/services/federator/src/Federator/InternalServer.hs b/services/federator/src/Federator/InternalServer.hs index 1a95a1d3f16..5cf69f436c6 100644 --- a/services/federator/src/Federator/InternalServer.hs +++ b/services/federator/src/Federator/InternalServer.hs @@ -28,7 +28,7 @@ import qualified Data.Text.Encoding as Text import Data.X509.CertificateStore import Federator.App (Federator, runAppT) import Federator.Discovery (DiscoverFederator, LookupError (LookupErrorDNSError, LookupErrorSrvNotAvailable), runFederatorDiscovery) -import Federator.Env (Env, applog, caStore, dnsResolver, runSettings) +import Federator.Env (Env, applog, caStore, dnsResolver, runSettings, tls) import Federator.Options (RunSettings) import Federator.Remote (Remote, RemoteError (..), discoverAndCall, interpretRemote) import Federator.Utils.PolysemyServerError (absorbServerError) @@ -112,7 +112,7 @@ serveOutward env port = do transformer action = runAppT env . runM -- Embed Federator - . Polysemy.runReader (view caStore env) -- Reader CertificateStore + . Polysemy.runReader (view (tls . caStore) env) -- Reader CertificateStore . Polysemy.runReader (view runSettings env) -- Reader RunSettings . embedToMonadIO @Federator -- Embed IO . absorbServerError diff --git a/services/federator/src/Federator/Run.hs b/services/federator/src/Federator/Run.hs index 6faa0be985b..2fd14d92792 100644 --- a/services/federator/src/Federator/Run.hs +++ b/services/federator/src/Federator/Run.hs @@ -98,6 +98,7 @@ newEnv o _dnsResolver = do _service Galley = mkEndpoint (Opt.galley o) _httpManager <- initHttpManager _caStore <- mkCAStore _runSettings + let _tls = TLSSettings {..} return Env {..} where mkEndpoint s = RPC.host (encodeUtf8 (s ^. epHost)) . RPC.port (s ^. epPort) $ RPC.empty From ae0e984389d906e53104bdbdefaffccec6af67c7 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Mon, 26 Jul 2021 08:39:21 +0200 Subject: [PATCH 03/12] Add settings for client certificate --- services/federator/federator.cabal | 6 +++- services/federator/package.yaml | 33 ++++++++++--------- services/federator/src/Federator/Env.hs | 6 +++- services/federator/src/Federator/Options.hs | 14 +++++++- services/federator/src/Federator/Run.hs | 21 ++++++++---- .../unit/Test/Federator/ExternalServer.hs | 11 +++---- .../unit/Test/Federator/InternalServer.hs | 19 +++++------ .../test/unit/Test/Federator/Remote.hs | 28 +++++++++++++--- .../test/unit/Test/Federator/Validation.hs | 2 +- 9 files changed, 92 insertions(+), 48 deletions(-) diff --git a/services/federator/federator.cabal b/services/federator/federator.cabal index 5f5836d0f9b..e7575bdc1de 100644 --- a/services/federator/federator.cabal +++ b/services/federator/federator.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 7ae942605e2cd7ddc1fc423b068b429970064332a02e90994295385a0722d1b9 +-- hash: cdb6771f196b12f78bb882147d96fd428eee25077be318520b83679ed05d5db9 name: federator version: 1.0.0 @@ -82,6 +82,7 @@ library , text , tinylog , tls + , transformers , types-common , unliftio , uri-bytestring @@ -140,6 +141,7 @@ executable federator , text , tinylog , tls + , transformers , types-common , unliftio , uri-bytestring @@ -208,6 +210,7 @@ executable federator-integration , text , tinylog , tls + , transformers , types-common , unliftio , uri-bytestring @@ -277,6 +280,7 @@ test-suite federator-tests , text , tinylog , tls + , transformers , types-common , unliftio , uri-bytestring diff --git a/services/federator/package.yaml b/services/federator/package.yaml index acc6c7280d3..bd38ce129df 100644 --- a/services/federator/package.yaml +++ b/services/federator/package.yaml @@ -11,19 +11,22 @@ license: AGPL-3 extra-source-files: test/resources/**/* dependencies: - aeson -- http-types -- either - base - bilge - bytestring - data-default - dns - dns-util +- either - exceptions - extended -- http-client +- HsOpenSSL +- HsOpenSSL-x509-system - http2-client - http2-client-grpc +- http-client +- http-client-openssl +- http-types - imports - lens - metrics-core @@ -32,29 +35,27 @@ dependencies: - mu-grpc-client - mu-grpc-server - mu-rpc +- network-uri +- polysemy +- polysemy-wire-zoo +- retry - servant - servant-server - string-conversions - text -- tls -- x509-store -- x509-system - tinylog +- tls +- transformers - types-common +- unliftio +- uri-bytestring - uuid +- wai-utilities - wire-api - wire-api-federation -- polysemy -- polysemy-wire-zoo -- retry -- HsOpenSSL -- HsOpenSSL-x509-system -- http-client-openssl -- unliftio -- wai-utilities -- network-uri -- uri-bytestring - x509 +- x509-store +- x509-system - x509-validation library: diff --git a/services/federator/src/Federator/Env.hs b/services/federator/src/Federator/Env.hs index 17f3f293935..0a6e68a896e 100644 --- a/services/federator/src/Federator/Env.hs +++ b/services/federator/src/Federator/Env.hs @@ -26,13 +26,17 @@ import Control.Lens (makeLenses) import Data.Metrics (Metrics) import Data.X509.CertificateStore import Federator.Options (RunSettings) +import Imports import Network.DNS.Resolver (Resolver) import qualified Network.HTTP.Client as HTTP +import qualified Network.TLS as TLS import qualified System.Logger.Class as LC import Wire.API.Federation.GRPC.Types data TLSSettings = TLSSettings - {_caStore :: CertificateStore} + { _caStore :: CertificateStore, + _creds :: Maybe TLS.Credential + } data Env = Env { _metrics :: Metrics, diff --git a/services/federator/src/Federator/Options.hs b/services/federator/src/Federator/Options.hs index 42f5b11c898..d4897773315 100644 --- a/services/federator/src/Federator/Options.hs +++ b/services/federator/src/Federator/Options.hs @@ -62,10 +62,22 @@ data RunSettings = RunSettings { -- | Would you like to federate with everyone or only with a select set of other wire-server installations? federationStrategy :: FederationStrategy, useSystemCAStore :: Bool, - remoteCAStore :: Maybe FilePath + remoteCAStore :: Maybe FilePath, + clientCertificate :: Maybe FilePath, + clientPrivateKey :: Maybe FilePath } deriving (Show, Generic) +defRunSettings :: RunSettings +defRunSettings = + RunSettings + { federationStrategy = AllowAll, + useSystemCAStore = True, + remoteCAStore = Nothing, + clientCertificate = Nothing, + clientPrivateKey = Nothing + } + instance FromJSON RunSettings data Opts = Opts diff --git a/services/federator/src/Federator/Run.hs b/services/federator/src/Federator/Run.hs index 2fd14d92792..4ac5b99bfb4 100644 --- a/services/federator/src/Federator/Run.hs +++ b/services/federator/src/Federator/Run.hs @@ -34,6 +34,7 @@ where import qualified Bilge as RPC import Control.Exception (throw) import Control.Lens ((^.)) +import Control.Monad.Trans.Maybe (runMaybeT) import Data.Default (def) import qualified Data.Metrics.Middleware as Metrics import Data.Text.Encoding (encodeUtf8) @@ -45,6 +46,7 @@ import Federator.Options as Opt import Imports import qualified Network.DNS as DNS import qualified Network.HTTP.Client as HTTP +import qualified Network.TLS as TLS import qualified Polysemy import qualified Polysemy.Error as Polysemy import qualified System.Logger.Class as Log @@ -83,10 +85,12 @@ run opts = ------------------------------------------------------------------------------- -- Environment -newtype InvalidCAStore = InvalidCAStore FilePath +data FederationSetupError + = InvalidCAStore FilePath + | InvalidClientCertificate String deriving (Show) -instance Exception InvalidCAStore +instance Exception FederationSetupError newEnv :: Opts -> DNS.Resolver -> IO Env newEnv o _dnsResolver = do @@ -98,6 +102,7 @@ newEnv o _dnsResolver = do _service Galley = mkEndpoint (Opt.galley o) _httpManager <- initHttpManager _caStore <- mkCAStore _runSettings + _creds <- mkCreds _runSettings let _tls = TLSSettings {..} return Env {..} where @@ -114,17 +119,21 @@ mkCAStore settings = do else pure mempty pure (customCAStore <> systemCAStore) +mkCreds :: RunSettings -> IO (Maybe TLS.Credential) +mkCreds settings = runMaybeT $ do + cert <- maybe mzero pure (clientCertificate settings) + key <- maybe mzero pure (clientPrivateKey settings) + lift (TLS.credentialLoadX509 cert key) >>= \case + Left e -> lift (throw (InvalidClientCertificate e)) + Right x -> pure x + closeEnv :: Env -> IO () closeEnv e = do Log.flush $ e ^. applog Log.close $ e ^. applog --- | Copied (and adjusted) from brig, do we want to put this somehwere common? --- FUTUREWORK(federation): review certificate and protocol security setting for this TLS --- manager initHttpManager :: IO HTTP.Manager initHttpManager = - -- See Note [SSL context] HTTP.newManager HTTP.defaultManagerSettings { HTTP.managerConnCount = 1024, diff --git a/services/federator/test/unit/Test/Federator/ExternalServer.hs b/services/federator/test/unit/Test/Federator/ExternalServer.hs index bcd08702c02..854f7bc3318 100644 --- a/services/federator/test/unit/Test/Federator/ExternalServer.hs +++ b/services/federator/test/unit/Test/Federator/ExternalServer.hs @@ -22,7 +22,7 @@ module Test.Federator.ExternalServer where import Data.Domain (Domain (..)) import Data.String.Conversions (cs) import Federator.ExternalServer (callLocal) -import Federator.Options (FederationStrategy (AllowAll), RunSettings (..)) +import Federator.Options (defRunSettings) import Federator.Service (Service) import Imports import qualified Network.HTTP.Types as HTTP @@ -53,7 +53,7 @@ requestBrigSuccess = mockServiceCallReturns @IO (\_ _ _ _ -> pure (HTTP.ok200, Just "response body")) let request = Request Brig "/federation/get-user-by-handle" "\"foo\"" exampleDomain - res :: InwardResponse <- mock @Service @IO . TinyLog.discardLogs . Polysemy.runReader allowAllSettings $ callLocal request + res :: InwardResponse <- mock @Service @IO . TinyLog.discardLogs . Polysemy.runReader defRunSettings $ callLocal request actualCalls <- mockServiceCallCalls @IO let expectedCall = (Brig, "federation/get-user-by-handle", "\"foo\"", aValidDomain) embed $ assertEqual "one call to brig should be made" [expectedCall] actualCalls @@ -66,7 +66,7 @@ requestBrigFailure = mockServiceCallReturns @IO (\_ _ _ _ -> pure (HTTP.notFound404, Just "response body")) let request = Request Brig "/federation/get-user-by-handle" "\"foo\"" exampleDomain - res <- mock @Service @IO . TinyLog.discardLogs . Polysemy.runReader allowAllSettings $ callLocal request + res <- mock @Service @IO . TinyLog.discardLogs . Polysemy.runReader defRunSettings $ callLocal request actualCalls <- mockServiceCallCalls @IO let expectedCall = (Brig, "federation/get-user-by-handle", "\"foo\"", aValidDomain) @@ -82,15 +82,12 @@ requestGalleySuccess = mockServiceCallReturns @IO (\_ _ _ _ -> pure (HTTP.ok200, Just "response body")) let request = Request Galley "federation/get-conversations" "{}" exampleDomain - res :: InwardResponse <- mock @Service @IO . TinyLog.discardLogs . Polysemy.runReader allowAllSettings $ callLocal request + res :: InwardResponse <- mock @Service @IO . TinyLog.discardLogs . Polysemy.runReader defRunSettings $ callLocal request actualCalls <- mockServiceCallCalls @IO let expectedCall = (Galley, "federation/get-conversations", "{}", aValidDomain) embed $ assertEqual "one call to brig should be made" [expectedCall] actualCalls embed $ assertEqual "response should be success with correct body" (InwardResponseBody "response body") res -allowAllSettings :: RunSettings -allowAllSettings = RunSettings AllowAll True Nothing - exampleDomain :: Text exampleDomain = "some.example.com" diff --git a/services/federator/test/unit/Test/Federator/InternalServer.hs b/services/federator/test/unit/Test/Federator/InternalServer.hs index 6b363eeb6fe..691b573c330 100644 --- a/services/federator/test/unit/Test/Federator/InternalServer.hs +++ b/services/federator/test/unit/Test/Federator/InternalServer.hs @@ -22,7 +22,7 @@ module Test.Federator.InternalServer (tests) where import Data.Domain (Domain (Domain)) import Federator.Discovery (LookupError (LookupErrorDNSError, LookupErrorSrvNotAvailable)) import Federator.InternalServer (callOutward) -import Federator.Options (AllowedDomains (..), FederationStrategy (..), RunSettings (..)) +import Federator.Options (AllowedDomains (..), FederationStrategy (..), RunSettings (..), defRunSettings) import Federator.Remote (Remote, RemoteError (RemoteErrorDiscoveryFailure)) import Imports import Mu.GRpc.Client.Record @@ -53,10 +53,7 @@ tests = settingsWithAllowList :: [Domain] -> RunSettings settingsWithAllowList domains = - RunSettings (AllowList (AllowedDomains domains)) True Nothing - -allowAllSettings :: RunSettings -allowAllSettings = RunSettings AllowAll True Nothing + defRunSettings {federationStrategy = AllowList (AllowedDomains domains)} federatedRequestSuccess :: TestTree federatedRequestSuccess = @@ -65,7 +62,7 @@ federatedRequestSuccess = mockDiscoverAndCallReturns @IO (const $ pure (Right (GRpcOk (InwardResponseBody "success!")))) let federatedRequest = FederatedRequest validDomainText (Just validLocalPart) - res <- mock @Remote @IO . Polysemy.runReader allowAllSettings $ callOutward federatedRequest + res <- mock @Remote @IO . Polysemy.runReader defRunSettings $ callOutward federatedRequest actualCalls <- mockDiscoverAndCallCalls @IO let expectedCall = ValidatedFederatedRequest (Domain validDomainText) validLocalPart @@ -81,7 +78,7 @@ federatedRequestFailureTMC = mockDiscoverAndCallReturns @IO (const $ pure (Right (GRpcTooMuchConcurrency (TooMuchConcurrency 2)))) let federatedRequest = FederatedRequest validDomainText (Just validLocalPart) - res <- mock @Remote @IO . Polysemy.runReader allowAllSettings $ callOutward federatedRequest + res <- mock @Remote @IO . Polysemy.runReader defRunSettings $ callOutward federatedRequest actualCalls <- mockDiscoverAndCallCalls @IO let expectedCall = ValidatedFederatedRequest (Domain validDomainText) validLocalPart @@ -96,7 +93,7 @@ federatedRequestFailureErrCode = mockDiscoverAndCallReturns @IO (const $ pure (Right (GRpcErrorCode 77))) -- TODO: Maybe use some legit HTTP2 error code? let federatedRequest = FederatedRequest validDomainText (Just validLocalPart) - res <- mock @Remote @IO . Polysemy.runReader allowAllSettings $ callOutward federatedRequest + res <- mock @Remote @IO . Polysemy.runReader defRunSettings $ callOutward federatedRequest actualCalls <- mockDiscoverAndCallCalls @IO let expectedCall = ValidatedFederatedRequest (Domain validDomainText) validLocalPart @@ -111,7 +108,7 @@ federatedRequestFailureErrStr = mockDiscoverAndCallReturns @IO (const $ pure (Right (GRpcErrorString "some grpc error"))) let federatedRequest = FederatedRequest validDomainText (Just validLocalPart) - res <- mock @Remote @IO . Polysemy.runReader allowAllSettings $ callOutward federatedRequest + res <- mock @Remote @IO . Polysemy.runReader defRunSettings $ callOutward federatedRequest actualCalls <- mockDiscoverAndCallCalls @IO let expectedCall = ValidatedFederatedRequest (Domain validDomainText) validLocalPart @@ -126,7 +123,7 @@ federatedRequestFailureNoRemote = mockDiscoverAndCallReturns @IO (const $ pure (Left $ RemoteErrorDiscoveryFailure (Domain "example.com") (LookupErrorSrvNotAvailable "_something._tcp.example.com"))) let federatedRequest = FederatedRequest validDomainText (Just validLocalPart) - res <- mock @Remote @IO . Polysemy.runReader allowAllSettings $ callOutward federatedRequest + res <- mock @Remote @IO . Polysemy.runReader defRunSettings $ callOutward federatedRequest actualCalls <- mockDiscoverAndCallCalls @IO let expectedCall = ValidatedFederatedRequest (Domain validDomainText) validLocalPart @@ -141,7 +138,7 @@ federatedRequestFailureDNS = mockDiscoverAndCallReturns @IO (const $ pure (Left $ RemoteErrorDiscoveryFailure (Domain "example.com") (LookupErrorDNSError "No route to 1.1.1.1"))) let federatedRequest = FederatedRequest validDomainText (Just validLocalPart) - res <- mock @Remote @IO . Polysemy.runReader allowAllSettings $ callOutward federatedRequest + res <- mock @Remote @IO . Polysemy.runReader defRunSettings $ callOutward federatedRequest actualCalls <- mockDiscoverAndCallCalls @IO let expectedCall = ValidatedFederatedRequest (Domain validDomainText) validLocalPart diff --git a/services/federator/test/unit/Test/Federator/Remote.hs b/services/federator/test/unit/Test/Federator/Remote.hs index e83869a8051..ba8d4c54395 100644 --- a/services/federator/test/unit/Test/Federator/Remote.hs +++ b/services/federator/test/unit/Test/Federator/Remote.hs @@ -37,14 +37,24 @@ testValidatesCertificateSuccess = "can get response with valid certificate" [ testCase "when hostname=localhost and certificate-for=localhost" $ do bracket (startMockServer certForLocalhost) (\(serverThread, _) -> Async.cancel serverThread) $ \(_, port) -> do - caStore <- mkCAStore (RunSettings AllowAll False (Just "test/resources/unit/unit-ca.pem")) + caStore <- + mkCAStore $ + defRunSettings + { useSystemCAStore = False, + remoteCAStore = Just "test/resources/unit/unit-ca.pem" + } eitherClient <- Polysemy.runM . TinyLog.discardLogs . Polysemy.runReader caStore $ mkGrpcClient (SrvTarget "localhost" (fromIntegral port)) case eitherClient of Left err -> assertFailure $ "Unexpected error: " <> show err Right _ -> pure (), testCase "when hostname=localhost. and certificate-for=localhost" $ do bracket (startMockServer certForLocalhost) (\(serverThread, _) -> Async.cancel serverThread) $ \(_, port) -> do - caStore <- mkCAStore (RunSettings AllowAll False (Just "test/resources/unit/unit-ca.pem")) + caStore <- + mkCAStore $ + defRunSettings + { useSystemCAStore = False, + remoteCAStore = Just "test/resources/unit/unit-ca.pem" + } eitherClient <- Polysemy.runM . TinyLog.discardLogs . Polysemy.runReader caStore $ mkGrpcClient (SrvTarget "localhost." (fromIntegral port)) case eitherClient of Left err -> assertFailure $ "Unexpected error: " <> show err @@ -52,7 +62,12 @@ testValidatesCertificateSuccess = -- This is a limitation of the TLS library, this test just exists to document that. testCase "when hostname=localhost. and certificate-for=localhost." $ do bracket (startMockServer certForLocalhostDot) (\(serverThread, _) -> Async.cancel serverThread) $ \(_, port) -> do - caStore <- mkCAStore (RunSettings AllowAll False (Just "test/resources/unit/unit-ca.pem")) + caStore <- + mkCAStore $ + defRunSettings + { useSystemCAStore = False, + remoteCAStore = Just "test/resources/unit/unit-ca.pem" + } eitherClient <- Polysemy.runM . TinyLog.discardLogs . Polysemy.runReader caStore $ mkGrpcClient (SrvTarget "localhost." (fromIntegral port)) @@ -67,7 +82,12 @@ testValidatesCertificateWrongHostname = "refuses to connect with server" [ testCase "when the server's certificate doesn't match the hostname" $ bracket (startMockServer certForWrongDomain) (Async.cancel . fst) $ \(_, port) -> do - caStore <- mkCAStore (RunSettings AllowAll False (Just "test/resources/unit/unit-ca.pem")) + caStore <- + mkCAStore $ + defRunSettings + { useSystemCAStore = False, + remoteCAStore = Just "test/resources/unit/unit-ca.pem" + } eitherClient <- Polysemy.runM . TinyLog.discardLogs . Polysemy.runReader caStore $ mkGrpcClient (SrvTarget "localhost." (fromIntegral port)) diff --git a/services/federator/test/unit/Test/Federator/Validation.hs b/services/federator/test/unit/Test/Federator/Validation.hs index bf0f3ebc8b5..ddb89260c7f 100644 --- a/services/federator/test/unit/Test/Federator/Validation.hs +++ b/services/federator/test/unit/Test/Federator/Validation.hs @@ -178,4 +178,4 @@ expectErr expectedType (Left err) = settingsWithAllowList :: [Domain] -> RunSettings settingsWithAllowList domains = - RunSettings (AllowList (AllowedDomains domains)) False Nothing + defRunSettings {federationStrategy = AllowList (AllowedDomains domains)} From 1d3e6b542bb385f17747ee78c96a4590284935f4 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Mon, 26 Jul 2021 08:52:26 +0200 Subject: [PATCH 04/12] Access TLSSettings in Remote --- .../federator/src/Federator/InternalServer.hs | 6 ++-- services/federator/src/Federator/Remote.hs | 31 ++++++++++++------- services/federator/src/Federator/Run.hs | 12 ++++--- .../integration/Test/Federator/IngressSpec.hs | 4 +-- .../test/integration/Test/Federator/Util.hs | 8 ++--- .../test/unit/Test/Federator/Remote.hs | 26 ++++++++-------- 6 files changed, 50 insertions(+), 37 deletions(-) diff --git a/services/federator/src/Federator/InternalServer.hs b/services/federator/src/Federator/InternalServer.hs index 5cf69f436c6..49d77c860b0 100644 --- a/services/federator/src/Federator/InternalServer.hs +++ b/services/federator/src/Federator/InternalServer.hs @@ -28,7 +28,7 @@ import qualified Data.Text.Encoding as Text import Data.X509.CertificateStore import Federator.App (Federator, runAppT) import Federator.Discovery (DiscoverFederator, LookupError (LookupErrorDNSError, LookupErrorSrvNotAvailable), runFederatorDiscovery) -import Federator.Env (Env, applog, caStore, dnsResolver, runSettings, tls) +import Federator.Env (Env, TLSSettings, applog, caStore, dnsResolver, runSettings, tls) import Federator.Options (RunSettings) import Federator.Remote (Remote, RemoteError (..), discoverAndCall, interpretRemote) import Federator.Utils.PolysemyServerError (absorbServerError) @@ -104,7 +104,7 @@ serveOutward env port = do Polysemy.Error ServerError, Embed IO, Polysemy.Reader RunSettings, - Polysemy.Reader CertificateStore, + Polysemy.Reader TLSSettings, Embed Federator ] a -> @@ -112,7 +112,7 @@ serveOutward env port = do transformer action = runAppT env . runM -- Embed Federator - . Polysemy.runReader (view (tls . caStore) env) -- Reader CertificateStore + . Polysemy.runReader (view tls env) -- Reader TLSSettings . Polysemy.runReader (view runSettings env) -- Reader RunSettings . embedToMonadIO @Federator -- Embed IO . absorbServerError diff --git a/services/federator/src/Federator/Remote.hs b/services/federator/src/Federator/Remote.hs index 3339f103171..1f5eeb4d064 100644 --- a/services/federator/src/Federator/Remote.hs +++ b/services/federator/src/Federator/Remote.hs @@ -17,29 +17,37 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Federator.Remote where +module Federator.Remote + ( Remote, + RemoteError (..), + discoverAndCall, + interpretRemote, + mkGrpcClient, + ) +where +import Control.Lens ((^.)) import Data.Default (def) import Data.Domain (Domain, domainText) import Data.String.Conversions (cs) import qualified Data.X509 as X509 -import Data.X509.CertificateStore import qualified Data.X509.Validation as X509 import Federator.Discovery (DiscoverFederator, LookupError, discoverFederator) +import Federator.Env (TLSSettings, caStore) import Federator.Options import Imports import Mu.GRpc.Client.Optics (GRpcReply) import Mu.GRpc.Client.Record (GRpcMessageProtocol (MsgProtoBuf)) import Mu.GRpc.Client.TyApps (gRpcCall) import Network.GRPC.Client.Helpers -import Network.TLS -import qualified Network.TLS as TLS +import Network.TLS as TLS import qualified Network.TLS.Extra.Cipher as TLS import Polysemy import qualified Polysemy.Error as Polysemy import qualified Polysemy.Reader as Polysemy import Polysemy.TinyLog (TinyLog) import qualified Polysemy.TinyLog as Log +import System.IO (hPutStrLn) import qualified System.Logger.Message as Log import Wire.API.Federation.GRPC.Client import Wire.API.Federation.GRPC.Types @@ -57,7 +65,7 @@ data Remote m a where makeSem ''Remote interpretRemote :: - (Members [Embed IO, DiscoverFederator, TinyLog, Polysemy.Reader RunSettings, Polysemy.Reader CertificateStore] r) => + (Members [Embed IO, DiscoverFederator, TinyLog, Polysemy.Reader RunSettings, Polysemy.Reader TLSSettings] r) => Sem (Remote ': r) a -> Sem r a interpretRemote = interpret $ \case @@ -84,11 +92,10 @@ callInward client request = -- FUTUREWORK(federation): Consider using HsOpenSSL instead of tls for better -- security and to avoid having to depend on cryptonite and override validation -- hooks. This might involve forking http2-client: https://github.com/lucasdicioccio/http2-client/issues/76 --- FUTUREWORK(federation): Allow a configurable trust store to be used in TLS certificate validation -- See also https://github.com/lucasdicioccio/http2-client/issues/76 -- FUTUREWORK(federation): Cache this client and use it for many requests mkGrpcClient :: - Members '[Embed IO, TinyLog, Polysemy.Reader CertificateStore] r => + Members '[Embed IO, TinyLog, Polysemy.Reader TLSSettings] r => SrvTarget -> Sem r (Either RemoteError GrpcClient) mkGrpcClient target@(SrvTarget host port) = logAndReturn target $ do @@ -115,7 +122,7 @@ mkGrpcClient target@(SrvTarget host port) = logAndReturn target $ do TLS.cipher_ECDHE_RSA_CHACHA20POLY1305_SHA256 ] - caStore <- Polysemy.ask + settings <- Polysemy.ask -- validate the hostname without a trailing dot as the certificate is not -- expected to have the trailing dot. @@ -139,10 +146,12 @@ mkGrpcClient target@(SrvTarget host port) = logAndReturn target $ do X509.validate X509.HashSHA256 (X509.defaultHooks {TLS.hookValidateName = validateName}) - X509.defaultChecks + X509.defaultChecks, + TLS.onCertificateRequest = \_ -> do + hPutStrLn stderr "***** CERTIFICATE REQUEST *****" + pure Nothing }, - -- FUTUREWORK: use onCertificateRequest to provide client certificates - TLS.clientShared = def {TLS.sharedCAStore = caStore} + TLS.clientShared = def {TLS.sharedCAStore = settings ^. caStore} } let cfg' = cfg {_grpcClientConfigTLS = Just tlsConfig} Polysemy.mapError (RemoteErrorClientFailure target) diff --git a/services/federator/src/Federator/Run.hs b/services/federator/src/Federator/Run.hs index 4ac5b99bfb4..15b1f422873 100644 --- a/services/federator/src/Federator/Run.hs +++ b/services/federator/src/Federator/Run.hs @@ -26,7 +26,7 @@ module Federator.Run -- * App Environment newEnv, - mkCAStore, + mkTLSSettings, closeEnv, ) where @@ -101,9 +101,7 @@ newEnv o _dnsResolver = do let _service Brig = mkEndpoint (Opt.brig o) _service Galley = mkEndpoint (Opt.galley o) _httpManager <- initHttpManager - _caStore <- mkCAStore _runSettings - _creds <- mkCreds _runSettings - let _tls = TLSSettings {..} + _tls <- mkTLSSettings _runSettings return Env {..} where mkEndpoint s = RPC.host (encodeUtf8 (s ^. epHost)) . RPC.port (s ^. epPort) $ RPC.empty @@ -127,6 +125,12 @@ mkCreds settings = runMaybeT $ do Left e -> lift (throw (InvalidClientCertificate e)) Right x -> pure x +mkTLSSettings :: RunSettings -> IO TLSSettings +mkTLSSettings settings = + TLSSettings + <$> mkCAStore settings + <*> mkCreds settings + closeEnv :: Env -> IO () closeEnv e = do Log.flush $ e ^. applog diff --git a/services/federator/test/integration/Test/Federator/IngressSpec.hs b/services/federator/test/integration/Test/Federator/IngressSpec.hs index 07491211a4a..c11a2067e97 100644 --- a/services/federator/test/integration/Test/Federator/IngressSpec.hs +++ b/services/federator/test/integration/Test/Federator/IngressSpec.hs @@ -59,8 +59,8 @@ inwardBrigCallViaIngress requestPath payload = do Endpoint ingressHost ingressPort <- cfgNginxIngress . view teTstOpts <$> ask let target = SrvTarget (cs ingressHost) ingressPort runSettings <- optSettings . view teOpts <$> ask - caStore <- view teCAStore <$> ask - c <- liftIO . Polysemy.runM . discardLogs . Polysemy.runReader caStore . Polysemy.runReader runSettings $ mkGrpcClient target + tlsSettings <- view teTLSSettings + c <- liftIO . Polysemy.runM . discardLogs . Polysemy.runReader tlsSettings . Polysemy.runReader runSettings $ mkGrpcClient target client <- case c of Left clientErr -> liftIO $ assertFailure (show clientErr) Right cli -> pure cli diff --git a/services/federator/test/integration/Test/Federator/Util.hs b/services/federator/test/integration/Test/Federator/Util.hs index ddd2e1e3c38..7c95f0faa2c 100644 --- a/services/federator/test/integration/Test/Federator/Util.hs +++ b/services/federator/test/integration/Test/Federator/Util.hs @@ -42,10 +42,10 @@ import Data.String.Conversions import qualified Data.Text as Text import qualified Data.UUID as UUID import qualified Data.UUID.V4 as UUID -import Data.X509.CertificateStore import qualified Data.Yaml as Yaml +import Federator.Env (TLSSettings (..)) import Federator.Options -import Federator.Run (mkCAStore) +import Federator.Run (mkTLSSettings) import Imports import Mu.GRpc.Client.TyApps import qualified Options.Applicative as OPA @@ -86,7 +86,7 @@ runTestFederator env = flip runReaderT env . unwrapTestFederator -- | See 'mkEnv' about what's in here. data TestEnv = TestEnv { _teMgr :: Manager, - _teCAStore :: CertificateStore, + _teTLSSettings :: TLSSettings, _teBrig :: BrigReq, -- | federator config _teOpts :: Opts, @@ -143,7 +143,7 @@ mkEnv :: HasCallStack => IntegrationConfig -> Opts -> IO TestEnv mkEnv _teTstOpts _teOpts = do _teMgr :: Manager <- newManager defaultManagerSettings let _teBrig = endpointToReq (cfgBrig _teTstOpts) - _teCAStore <- mkCAStore (optSettings _teOpts) + _teTLSSettings <- mkTLSSettings (optSettings _teOpts) pure TestEnv {..} destroyEnv :: HasCallStack => TestEnv -> IO () diff --git a/services/federator/test/unit/Test/Federator/Remote.hs b/services/federator/test/unit/Test/Federator/Remote.hs index ba8d4c54395..7168acbe5a1 100644 --- a/services/federator/test/unit/Test/Federator/Remote.hs +++ b/services/federator/test/unit/Test/Federator/Remote.hs @@ -5,7 +5,7 @@ module Test.Federator.Remote where import Data.Streaming.Network (bindRandomPortTCP) import Federator.Options import Federator.Remote -import Federator.Run (mkCAStore) +import Federator.Run (mkTLSSettings) import Imports import Network.HTTP.Types (status200) import Network.Wai @@ -37,39 +37,39 @@ testValidatesCertificateSuccess = "can get response with valid certificate" [ testCase "when hostname=localhost and certificate-for=localhost" $ do bracket (startMockServer certForLocalhost) (\(serverThread, _) -> Async.cancel serverThread) $ \(_, port) -> do - caStore <- - mkCAStore $ + tlsSettings <- + mkTLSSettings $ defRunSettings { useSystemCAStore = False, remoteCAStore = Just "test/resources/unit/unit-ca.pem" } - eitherClient <- Polysemy.runM . TinyLog.discardLogs . Polysemy.runReader caStore $ mkGrpcClient (SrvTarget "localhost" (fromIntegral port)) + eitherClient <- Polysemy.runM . TinyLog.discardLogs . Polysemy.runReader tlsSettings $ mkGrpcClient (SrvTarget "localhost" (fromIntegral port)) case eitherClient of Left err -> assertFailure $ "Unexpected error: " <> show err Right _ -> pure (), testCase "when hostname=localhost. and certificate-for=localhost" $ do bracket (startMockServer certForLocalhost) (\(serverThread, _) -> Async.cancel serverThread) $ \(_, port) -> do - caStore <- - mkCAStore $ + tlsSettings <- + mkTLSSettings $ defRunSettings { useSystemCAStore = False, remoteCAStore = Just "test/resources/unit/unit-ca.pem" } - eitherClient <- Polysemy.runM . TinyLog.discardLogs . Polysemy.runReader caStore $ mkGrpcClient (SrvTarget "localhost." (fromIntegral port)) + eitherClient <- Polysemy.runM . TinyLog.discardLogs . Polysemy.runReader tlsSettings $ mkGrpcClient (SrvTarget "localhost." (fromIntegral port)) case eitherClient of Left err -> assertFailure $ "Unexpected error: " <> show err Right _ -> pure (), -- This is a limitation of the TLS library, this test just exists to document that. testCase "when hostname=localhost. and certificate-for=localhost." $ do bracket (startMockServer certForLocalhostDot) (\(serverThread, _) -> Async.cancel serverThread) $ \(_, port) -> do - caStore <- - mkCAStore $ + tlsSettings <- + mkTLSSettings $ defRunSettings { useSystemCAStore = False, remoteCAStore = Just "test/resources/unit/unit-ca.pem" } eitherClient <- - Polysemy.runM . TinyLog.discardLogs . Polysemy.runReader caStore $ + Polysemy.runM . TinyLog.discardLogs . Polysemy.runReader tlsSettings $ mkGrpcClient (SrvTarget "localhost." (fromIntegral port)) case eitherClient of Left _ -> pure () @@ -82,14 +82,14 @@ testValidatesCertificateWrongHostname = "refuses to connect with server" [ testCase "when the server's certificate doesn't match the hostname" $ bracket (startMockServer certForWrongDomain) (Async.cancel . fst) $ \(_, port) -> do - caStore <- - mkCAStore $ + tlsSettings <- + mkTLSSettings $ defRunSettings { useSystemCAStore = False, remoteCAStore = Just "test/resources/unit/unit-ca.pem" } eitherClient <- - Polysemy.runM . TinyLog.discardLogs . Polysemy.runReader caStore $ + Polysemy.runM . TinyLog.discardLogs . Polysemy.runReader tlsSettings $ mkGrpcClient (SrvTarget "localhost." (fromIntegral port)) case eitherClient of Left (RemoteErrorTLSException _ _) -> pure () From 5c37f8065108c77789439b8453367c2de624119f Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Mon, 26 Jul 2021 09:04:04 +0200 Subject: [PATCH 05/12] Use leaf as client cert in integration tests --- services/federator/federator.cabal | 4 +++- services/federator/federator.integration.yaml | 3 +++ services/federator/src/Federator/Remote.hs | 7 ++----- services/federator/src/Federator/Run.hs | 7 +++++-- 4 files changed, 13 insertions(+), 8 deletions(-) diff --git a/services/federator/federator.cabal b/services/federator/federator.cabal index e7575bdc1de..ca16569f927 100644 --- a/services/federator/federator.cabal +++ b/services/federator/federator.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: cdb6771f196b12f78bb882147d96fd428eee25077be318520b83679ed05d5db9 +-- hash: ca50cc4e726e48c424a4b177f8e617dbb3921a04203d5c44809c2c43933c6f48 name: federator version: 1.0.0 @@ -17,6 +17,8 @@ license: AGPL-3 build-type: Simple extra-source-files: test/resources/integration-ca.pem + test/resources/integration-leaf-key.pem + test/resources/integration-leaf.pem test/resources/unit/gen-certs.sh test/resources/unit/localhost-dot-key.pem test/resources/unit/localhost-dot.pem diff --git a/services/federator/federator.integration.yaml b/services/federator/federator.integration.yaml index 9afe9b38575..ececd8c3b92 100644 --- a/services/federator/federator.integration.yaml +++ b/services/federator/federator.integration.yaml @@ -32,3 +32,6 @@ optSettings: # - example.com useSystemCAStore: true + + clientCertificate: "test/resources/integration-leaf.pem" + clientPrivateKey: "test/resources/integration-leaf-key.pem" diff --git a/services/federator/src/Federator/Remote.hs b/services/federator/src/Federator/Remote.hs index 1f5eeb4d064..8bb49dbb11d 100644 --- a/services/federator/src/Federator/Remote.hs +++ b/services/federator/src/Federator/Remote.hs @@ -33,7 +33,7 @@ import Data.String.Conversions (cs) import qualified Data.X509 as X509 import qualified Data.X509.Validation as X509 import Federator.Discovery (DiscoverFederator, LookupError, discoverFederator) -import Federator.Env (TLSSettings, caStore) +import Federator.Env (TLSSettings, caStore, creds) import Federator.Options import Imports import Mu.GRpc.Client.Optics (GRpcReply) @@ -47,7 +47,6 @@ import qualified Polysemy.Error as Polysemy import qualified Polysemy.Reader as Polysemy import Polysemy.TinyLog (TinyLog) import qualified Polysemy.TinyLog as Log -import System.IO (hPutStrLn) import qualified System.Logger.Message as Log import Wire.API.Federation.GRPC.Client import Wire.API.Federation.GRPC.Types @@ -147,9 +146,7 @@ mkGrpcClient target@(SrvTarget host port) = logAndReturn target $ do X509.HashSHA256 (X509.defaultHooks {TLS.hookValidateName = validateName}) X509.defaultChecks, - TLS.onCertificateRequest = \_ -> do - hPutStrLn stderr "***** CERTIFICATE REQUEST *****" - pure Nothing + TLS.onCertificateRequest = \_ -> pure (settings ^. creds) }, TLS.clientShared = def {TLS.sharedCAStore = settings ^. caStore} } diff --git a/services/federator/src/Federator/Run.hs b/services/federator/src/Federator/Run.hs index 15b1f422873..a108bb2aace 100644 --- a/services/federator/src/Federator/Run.hs +++ b/services/federator/src/Federator/Run.hs @@ -32,7 +32,7 @@ module Federator.Run where import qualified Bilge as RPC -import Control.Exception (throw) +import Control.Exception (handle, throw) import Control.Lens ((^.)) import Control.Monad.Trans.Maybe (runMaybeT) import Data.Default (def) @@ -118,12 +118,15 @@ mkCAStore settings = do pure (customCAStore <> systemCAStore) mkCreds :: RunSettings -> IO (Maybe TLS.Credential) -mkCreds settings = runMaybeT $ do +mkCreds settings = handle h . runMaybeT $ do cert <- maybe mzero pure (clientCertificate settings) key <- maybe mzero pure (clientPrivateKey settings) lift (TLS.credentialLoadX509 cert key) >>= \case Left e -> lift (throw (InvalidClientCertificate e)) Right x -> pure x + where + h :: IOException -> IO a + h = throw . InvalidClientCertificate . show mkTLSSettings :: RunSettings -> IO TLSSettings mkTLSSettings settings = From f1a3a239edaf9668693893c5dccc951dd5772cbc Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Mon, 26 Jul 2021 11:32:45 +0200 Subject: [PATCH 06/12] Configure client certificate in helm --- charts/federator/templates/configmap-ca.yaml | 14 -------------- charts/federator/templates/configmap.yaml | 15 ++++++++++++++- charts/federator/templates/deployment.yaml | 12 ++++++------ charts/federator/templates/secrets.yaml | 13 +++++++++++++ charts/federator/values.yaml | 3 +++ .../nginx-ingress-services/templates/ingress.yaml | 2 ++ charts/nginx-ingress-services/values.yaml | 4 ++++ hack/bin/selfsigned-kubernetes.sh | 13 +++++++++++++ 8 files changed, 55 insertions(+), 21 deletions(-) delete mode 100644 charts/federator/templates/configmap-ca.yaml create mode 100644 charts/federator/templates/secrets.yaml diff --git a/charts/federator/templates/configmap-ca.yaml b/charts/federator/templates/configmap-ca.yaml deleted file mode 100644 index f73da24264a..00000000000 --- a/charts/federator/templates/configmap-ca.yaml +++ /dev/null @@ -1,14 +0,0 @@ -apiVersion: v1 -kind: Secret -metadata: - name: "federator-ca" - labels: - wireService: federator - chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} - release: {{ .Release.Name }} - heritage: {{ .Release.Service }} -data: - # TODO: add validation and fail early during templating: either contents should be provided; or explicitly system trust store enabled - {{- if .Values.remoteCAContents }} - remote-ca.pem: {{ .Values.remoteCAContents | b64enc | quote }} - {{- end }} diff --git a/charts/federator/templates/configmap.yaml b/charts/federator/templates/configmap.yaml index 33c02af8e1d..89004d5d4fd 100644 --- a/charts/federator/templates/configmap.yaml +++ b/charts/federator/templates/configmap.yaml @@ -43,7 +43,12 @@ data: # Filepath to one or more PEM-encoded server certificates to use as a trust # store when making grpc requests to remote backends {{- if $.Values.remoteCAContents }} - remoteCAStore: "/etc/wire/federator/ca/remote-ca.pem" + remoteCAStore: "/etc/wire/federator/conf/remote-ca.pem" + {{- end }} + useSystemCAStore: false + {{- if $.Values.clientCertificateContents }} + clientCertificate: "/etc/wire/federator/conf/client.pem" + clientPrivateKey: "/etc/wire/federator/secrets/client-key.pem" {{- end }} federationStrategy: {{- if .federationStrategy.allowAll }} @@ -60,3 +65,11 @@ data: {{- end}} {{- end }} {{- end }} + + # TODO: add validation and fail early during templating: either contents should be provided; or explicitly system trust store enabled + {{- if .Values.remoteCAContents }} + remote-ca.pem: {{ .Values.remoteCAContents | quote }} + {{- end }} + {{- if .Values.clientCertificateContents }} + client.pem: {{ .Values.clientCertificateContents | quote }} + {{- end }} diff --git a/charts/federator/templates/deployment.yaml b/charts/federator/templates/deployment.yaml index 8c5bebe8326..2f305b7db3e 100644 --- a/charts/federator/templates/deployment.yaml +++ b/charts/federator/templates/deployment.yaml @@ -25,18 +25,18 @@ spec: annotations: # An annotation of the configmap checksum ensures changes to the configmap cause a redeployment upon `helm upgrade` checksum/configmap: {{ include (print .Template.BasePath "/configmap.yaml") . | sha256sum }} - checksum/configmap-ca: {{ include (print .Template.BasePath "/configmap-ca.yaml") . | sha256sum }} + checksum/secrets: {{ include (print .Template.BasePath "/secrets.yaml") . | sha256sum }} fluentbit.io/parser: json spec: volumes: - name: "federator-config" configMap: name: "federator" - # federator-ca holds CA certificates to use as a trust store + # federator-secrets holds the private key for the client certificate to use # when making requests to remote backends - - name: "federator-ca" + - name: "federator-secrets" secret: - secretName: "federator-ca" + secretName: "federator-secrets" containers: - name: federator image: "{{ .Values.image.repository }}:{{ .Values.image.tag }}" @@ -44,8 +44,8 @@ spec: volumeMounts: - name: "federator-config" mountPath: "/etc/wire/federator/conf" - - name: "federator-ca" - mountPath: "/etc/wire/federator/ca" + - name: "federator-secrets" + mountPath: "/etc/wire/federator/secrets" ports: - name: internal containerPort: {{ .Values.service.internalFederatorPort }} diff --git a/charts/federator/templates/secrets.yaml b/charts/federator/templates/secrets.yaml new file mode 100644 index 00000000000..487ad8ca7e5 --- /dev/null +++ b/charts/federator/templates/secrets.yaml @@ -0,0 +1,13 @@ +apiVersion: v1 +kind: Secret +metadata: + name: "federator-secrets" + labels: + wireService: federator + chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} + release: {{ .Release.Name }} + heritage: {{ .Release.Service }} +data: + {{- if .Values.clientPrivateKeyContents }} + client-key.pem: {{ .Values.clientPrivateKeyContents | b64enc | quote }} + {{- end }} diff --git a/charts/federator/values.yaml b/charts/federator/values.yaml index a316fda763d..b6be91f04d1 100644 --- a/charts/federator/values.yaml +++ b/charts/federator/values.yaml @@ -30,6 +30,9 @@ config: # # Using custom CA doesn't automatically disable system CA store, it should # be disabled explicitly by setting useSystemCAStore to false. + # + # A client certificate and corresponding private key can be specified + # similarly to a custom CA store. useSystemCAStore: true federationStrategy: allowedDomains: [] diff --git a/charts/nginx-ingress-services/templates/ingress.yaml b/charts/nginx-ingress-services/templates/ingress.yaml index 34dbcdb35c9..8a7551fa211 100644 --- a/charts/nginx-ingress-services/templates/ingress.yaml +++ b/charts/nginx-ingress-services/templates/ingress.yaml @@ -4,6 +4,8 @@ metadata: name: nginx-ingress annotations: kubernetes.io/ingress.class: "nginx" + # nginx.ingress.kubernetes.io/auth-tls-verify-client: "on" + # nginx.ingress.kubernetes.io/auth-tls-secret: "tlsClientCA" spec: # This assumes you have created the given cert (see secret.yaml) # https://github.com/kubernetes/ingress-nginx/blob/master/docs/examples/PREREQUISITES.md#tls-certificates diff --git a/charts/nginx-ingress-services/values.yaml b/charts/nginx-ingress-services/values.yaml index fc87dbebccc..6a4c1a51d4a 100644 --- a/charts/nginx-ingress-services/values.yaml +++ b/charts/nginx-ingress-services/values.yaml @@ -75,6 +75,10 @@ service: # tlsWildcardKey: | # -----BEGIN PRIVATE KEY----- # -----END PRIVATE KEY----- +# tlsClientCA: | +# -----BEGIN PRIVATE KEY----- +# -----END PRIVATE KEY----- +# ^ CA to use to verify client certificates. # # For Services: # service: diff --git a/hack/bin/selfsigned-kubernetes.sh b/hack/bin/selfsigned-kubernetes.sh index df2d7f5252b..73b97762312 100755 --- a/hack/bin/selfsigned-kubernetes.sh +++ b/hack/bin/selfsigned-kubernetes.sh @@ -10,6 +10,7 @@ TEMP=${TEMP:-/tmp} CSR="$TEMP/csr.json" OUTPUTNAME_CA="integration-ca" OUTPUTNAME_LEAF_CERT="integration-leaf" +OUTPUTNAME_CLIENT_CERT="integration-client" DIR="$(cd "$(dirname "${BASH_SOURCE[0]}")" && pwd)" TOP_LEVEL="$DIR/../.." OUTPUT_CONFIG_FEDERATOR="$TOP_LEVEL/hack/helm_vars/wire-server/certificates.yaml" @@ -55,6 +56,9 @@ echo '{ # generate cert and key based on CA given comma-separated hostnames as SANs cfssl gencert -ca "$OUTPUTNAME_CA.pem" -ca-key "$OUTPUTNAME_CA-key.pem" -hostname="*.$FEDERATION_DOMAIN_BASE" "$CSR" | cfssljson -bare "$OUTPUTNAME_LEAF_CERT" +# generate client certificate and key +cfssl gencert -ca "$OUTPUTNAME_CA.pem" -ca-key "$OUTPUTNAME_CA-key.pem" -hostname="*.$FEDERATION_DOMAIN_BASE" "$CSR" | cfssljson -bare "$OUTPUTNAME_CLIENT_CERT" + # the following yaml override file is needed as an override to # nginx-ingress-services helm chart # for domain A, ingress@A needs cert+key for A @@ -64,6 +68,8 @@ cfssl gencert -ca "$OUTPUTNAME_CA.pem" -ca-key "$OUTPUTNAME_CA-key.pem" -hostnam sed -e 's/^/ /' $OUTPUTNAME_LEAF_CERT.pem echo " tlsWildcardKey: |" sed -e 's/^/ /' $OUTPUTNAME_LEAF_CERT-key.pem + echo " tlsClientCA: |" + sed -e 's/^/ /' $OUTPUTNAME_CA.pem } | tee "$OUTPUT_CONFIG_INGRESS" # the following yaml override file is needed as an override to @@ -75,10 +81,17 @@ cfssl gencert -ca "$OUTPUTNAME_CA.pem" -ca-key "$OUTPUTNAME_CA-key.pem" -hostnam echo "federator:" echo " remoteCAContents: |" sed -e 's/^/ /' $OUTPUTNAME_CA.pem + echo " clientCertificateContents: |" + sed -e 's/^/ /' $OUTPUTNAME_CLIENT_CERT.pem + echo " clientPrivateKeyContents: |" + sed -e 's/^/ /' $OUTPUTNAME_CLIENT_CERT-key.pem } | tee "$OUTPUT_CONFIG_FEDERATOR" # cleanup unneeded files rm "$OUTPUTNAME_LEAF_CERT.csr" rm "$OUTPUTNAME_LEAF_CERT.pem" rm "$OUTPUTNAME_LEAF_CERT-key.pem" +rm "$OUTPUTNAME_CLIENT_CERT.csr" +rm "$OUTPUTNAME_CLIENT_CERT.pem" +rm "$OUTPUTNAME_CLIENT_CERT-key.pem" rm "$CSR" From 070ddbc922719108b6c3013dc0b058061711bbdc Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Mon, 26 Jul 2021 17:04:07 +0200 Subject: [PATCH 07/12] Enable client certificates in federator ingress Also add client certificate CA to TLS secret --- charts/nginx-ingress-services/templates/ingress.yaml | 2 -- .../nginx-ingress-services/templates/ingress_federator.yaml | 2 ++ charts/nginx-ingress-services/templates/secret.yaml | 6 ++++-- 3 files changed, 6 insertions(+), 4 deletions(-) diff --git a/charts/nginx-ingress-services/templates/ingress.yaml b/charts/nginx-ingress-services/templates/ingress.yaml index 8a7551fa211..34dbcdb35c9 100644 --- a/charts/nginx-ingress-services/templates/ingress.yaml +++ b/charts/nginx-ingress-services/templates/ingress.yaml @@ -4,8 +4,6 @@ metadata: name: nginx-ingress annotations: kubernetes.io/ingress.class: "nginx" - # nginx.ingress.kubernetes.io/auth-tls-verify-client: "on" - # nginx.ingress.kubernetes.io/auth-tls-secret: "tlsClientCA" spec: # This assumes you have created the given cert (see secret.yaml) # https://github.com/kubernetes/ingress-nginx/blob/master/docs/examples/PREREQUISITES.md#tls-certificates diff --git a/charts/nginx-ingress-services/templates/ingress_federator.yaml b/charts/nginx-ingress-services/templates/ingress_federator.yaml index ea375b0ec44..9b951308a54 100644 --- a/charts/nginx-ingress-services/templates/ingress_federator.yaml +++ b/charts/nginx-ingress-services/templates/ingress_federator.yaml @@ -12,6 +12,8 @@ metadata: kubernetes.io/ingress.class: "nginx" nginx.ingress.kubernetes.io/ssl-redirect: "true" nginx.ingress.kubernetes.io/backend-protocol: "GRPC" + nginx.ingress.kubernetes.io/auth-tls-verify-client: "on" + nginx.ingress.kubernetes.io/auth-tls-secret: "{{ .Release.Namespace }}/{{ include "nginx-ingress-services.getCertificateSecretName" . }}" spec: tls: - hosts: diff --git a/charts/nginx-ingress-services/templates/secret.yaml b/charts/nginx-ingress-services/templates/secret.yaml index e0472b0fb4e..236fc3769ba 100644 --- a/charts/nginx-ingress-services/templates/secret.yaml +++ b/charts/nginx-ingress-services/templates/secret.yaml @@ -7,14 +7,16 @@ metadata: release: "{{ .Release.Name }}" heritage: "{{ .Release.Service }}" type: kubernetes.io/tls +data: +{{- if (and .Values.federator.enabled .Values.secrets.tlsClientCA) }} + ca.crt: {{ .Values.secrets.tlsClientCA | b64enc | quote }} +{{- end }} {{ if .Values.tls.useCertManager -}} {{- /* NOTE: providing `data` (and empty strings) allows to manage this secret resource with Helm if cert-manager is used */ -}} -data: tls.crt: "" tls.key: "" {{- end -}} {{- if (not .Values.tls.useCertManager) -}} -data: {{- /* for_helm_linting is necessary only since the 'with' block below does not throw an error upon an empty .Values.secrets */}} for_helm_linting: {{ required "No .secrets found in configuration. Did you forget to helm -f path/to/secrets.yaml ?" .Values.secrets | quote | b64enc | quote }} From f6a75ff61a25c79c598058d525e822cc277444a0 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Tue, 27 Jul 2021 08:40:24 +0200 Subject: [PATCH 08/12] Validate credentials and add tests It is now an error to specify a client certificate without a private key or vice versa. We also fail in case the certificate cannot be parsed, instead of returning an empty certificate chain. --- services/federator/federator.cabal | 7 +- services/federator/package.yaml | 1 - services/federator/src/Federator/Options.hs | 2 +- services/federator/src/Federator/Run.hs | 33 +++- .../federator/test/resources/unit/invalid.pem | 1 + .../test/unit/Test/Federator/Options.hs | 143 +++++++++++++++++- 6 files changed, 172 insertions(+), 15 deletions(-) create mode 100644 services/federator/test/resources/unit/invalid.pem diff --git a/services/federator/federator.cabal b/services/federator/federator.cabal index ca16569f927..dbf05f0824b 100644 --- a/services/federator/federator.cabal +++ b/services/federator/federator.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: ca50cc4e726e48c424a4b177f8e617dbb3921a04203d5c44809c2c43933c6f48 +-- hash: 451ccf76c662e1aed949e16099a7c771478e2563768df87b145adf53f4c0f4b8 name: federator version: 1.0.0 @@ -20,6 +20,7 @@ extra-source-files: test/resources/integration-leaf-key.pem test/resources/integration-leaf.pem test/resources/unit/gen-certs.sh + test/resources/unit/invalid.pem test/resources/unit/localhost-dot-key.pem test/resources/unit/localhost-dot.pem test/resources/unit/localhost-key.pem @@ -84,7 +85,6 @@ library , text , tinylog , tls - , transformers , types-common , unliftio , uri-bytestring @@ -143,7 +143,6 @@ executable federator , text , tinylog , tls - , transformers , types-common , unliftio , uri-bytestring @@ -212,7 +211,6 @@ executable federator-integration , text , tinylog , tls - , transformers , types-common , unliftio , uri-bytestring @@ -282,7 +280,6 @@ test-suite federator-tests , text , tinylog , tls - , transformers , types-common , unliftio , uri-bytestring diff --git a/services/federator/package.yaml b/services/federator/package.yaml index bd38ce129df..081e2a97668 100644 --- a/services/federator/package.yaml +++ b/services/federator/package.yaml @@ -45,7 +45,6 @@ dependencies: - text - tinylog - tls -- transformers - types-common - unliftio - uri-bytestring diff --git a/services/federator/src/Federator/Options.hs b/services/federator/src/Federator/Options.hs index d4897773315..f08d9d1d98d 100644 --- a/services/federator/src/Federator/Options.hs +++ b/services/federator/src/Federator/Options.hs @@ -66,7 +66,7 @@ data RunSettings = RunSettings clientCertificate :: Maybe FilePath, clientPrivateKey :: Maybe FilePath } - deriving (Show, Generic) + deriving (Eq, Show, Generic) defRunSettings :: RunSettings defRunSettings = diff --git a/services/federator/src/Federator/Run.hs b/services/federator/src/Federator/Run.hs index a108bb2aace..6456ebf8eab 100644 --- a/services/federator/src/Federator/Run.hs +++ b/services/federator/src/Federator/Run.hs @@ -27,6 +27,7 @@ module Federator.Run -- * App Environment newEnv, mkTLSSettings, + FederationSetupError (..), closeEnv, ) where @@ -34,10 +35,10 @@ where import qualified Bilge as RPC import Control.Exception (handle, throw) import Control.Lens ((^.)) -import Control.Monad.Trans.Maybe (runMaybeT) import Data.Default (def) import qualified Data.Metrics.Middleware as Metrics import Data.Text.Encoding (encodeUtf8) +import qualified Data.X509 as X509 import Data.X509.CertificateStore import Federator.Env import Federator.ExternalServer (serveInward) @@ -117,13 +118,31 @@ mkCAStore settings = do else pure mempty pure (customCAStore <> systemCAStore) +getClientCredentials :: RunSettings -> Either String (Maybe (FilePath, FilePath)) +getClientCredentials settings = case clientCertificate settings of + Nothing -> noCreds1 $> Nothing + Just cert -> Just . (cert,) <$> getCreds1 + where + noCreds1 :: Either String () + noCreds1 + | isNothing (clientPrivateKey settings) = pure () + | otherwise = Left "invalid client credentials: no certificate" + + getCreds1 :: Either String FilePath + getCreds1 = + maybe (Left "invalid client credentials: no private key") pure $ + clientPrivateKey settings + mkCreds :: RunSettings -> IO (Maybe TLS.Credential) -mkCreds settings = handle h . runMaybeT $ do - cert <- maybe mzero pure (clientCertificate settings) - key <- maybe mzero pure (clientPrivateKey settings) - lift (TLS.credentialLoadX509 cert key) >>= \case - Left e -> lift (throw (InvalidClientCertificate e)) - Right x -> pure x +mkCreds settings = handle h $ case getClientCredentials settings of + Left e -> throw (InvalidClientCertificate e) + Right Nothing -> pure Nothing + Right (Just (cert, key)) -> + TLS.credentialLoadX509 cert key >>= \case + Left e -> throw (InvalidClientCertificate e) + Right (X509.CertificateChain [], _) -> + throw (InvalidClientCertificate "could not read client certificate") + Right x -> pure (Just x) where h :: IOException -> IO a h = throw . InvalidClientCertificate . show diff --git a/services/federator/test/resources/unit/invalid.pem b/services/federator/test/resources/unit/invalid.pem new file mode 100644 index 00000000000..2716bf650ca --- /dev/null +++ b/services/federator/test/resources/unit/invalid.pem @@ -0,0 +1 @@ +not a certificate diff --git a/services/federator/test/unit/Test/Federator/Options.hs b/services/federator/test/unit/Test/Federator/Options.hs index d05a62d10c5..1eba51b2e10 100644 --- a/services/federator/test/unit/Test/Federator/Options.hs +++ b/services/federator/test/unit/Test/Federator/Options.hs @@ -21,12 +21,16 @@ module Test.Federator.Options where +import Control.Exception (try) +import Control.Lens import Data.Aeson (FromJSON) import qualified Data.Aeson as Aeson import Data.ByteString.Lazy (toStrict) import Data.Domain (mkDomain) import qualified Data.Yaml as Yaml +import Federator.Env import Federator.Options +import Federator.Run import Imports import Test.Tasty import Test.Tasty.HUnit @@ -35,7 +39,8 @@ tests :: TestTree tests = testGroup "Options" - [ parseFederationStrategy + [ parseFederationStrategy, + testTLSSettings ] parseFederationStrategy :: TestTree @@ -63,6 +68,142 @@ parseFederationStrategy = withAllowList = AllowList . AllowedDomains . map (either error id . mkDomain) +testTLSSettings :: TestTree +testTLSSettings = + testGroup + "TLS settings" + [ testCase "succefully read client credentials" $ do + let settings = + defRunSettings + { clientCertificate = Just "test/resources/unit/localhost.pem", + clientPrivateKey = Just "test/resources/unit/localhost-key.pem" + } + assertParsesAs settings $ + "useSystemCAStore: true\n\ + \federationStrategy:\n\ + \ allowAll: null\n\ + \clientCertificate: test/resources/unit/localhost.pem\n\ + \clientPrivateKey: test/resources/unit/localhost-key.pem\n" + tlsSettings <- mkTLSSettings settings + assertBool "expected TLS client credentials" $ + notNullOf (creds . _Just) tlsSettings, + testCase "parse missing client credentials" $ do + let settings = defRunSettings + assertParsesAs settings $ + "useSystemCAStore: true\n\ + \federationStrategy:\n\ + \ allowAll: null\n" + tlsSettings <- mkTLSSettings settings + assertBool "unexpected TLS client credentials" $ + nullOf (creds . _Just) tlsSettings, + testCase "fail on missing client private key" $ do + let settings = + defRunSettings + { clientCertificate = Just "test/resources/unit/localhost.pem" + } + assertParsesAs settings $ + "useSystemCAStore: true\n\ + \federationStrategy:\n\ + \ allowAll: null\n\ + \clientCertificate: test/resources/unit/localhost.pem\n" + try @FederationSetupError (mkTLSSettings settings) >>= \case + Left (InvalidClientCertificate _) -> pure () + Left e -> + assertFailure $ + "expected invalid client certificate exception, got: " + <> show e + Right tlsSettings -> + assertFailure $ + "expected failure for partial client credentials, got: " + <> show (tlsSettings ^. creds), + testCase "fail on missing certificate" $ do + let settings = + defRunSettings + { clientPrivateKey = Just "test/resources/unit/localhost-key.pem" + } + assertParsesAs settings $ + "useSystemCAStore: true\n\ + \federationStrategy:\n\ + \ allowAll: null\n\ + \clientPrivateKey: test/resources/unit/localhost-key.pem\n" + try @FederationSetupError (mkTLSSettings settings) >>= \case + Left (InvalidClientCertificate _) -> pure () + Left e -> + assertFailure $ + "expected invalid client certificate exception, got: " + <> show e + Right tlsSettings -> + assertFailure $ + "expected failure for partial client credentials, got: " + <> show (tlsSettings ^. creds), + testCase "fail on non-existent certificate" $ do + let settings = + defRunSettings + { clientCertificate = Just "non-existent", + clientPrivateKey = Just "non-existent" + } + assertParsesAs settings $ + "useSystemCAStore: true\n\ + \federationStrategy:\n\ + \ allowAll: null\n\ + \clientCertificate: non-existent\n\ + \clientPrivateKey: non-existent" + try @FederationSetupError (mkTLSSettings settings) >>= \case + Left (InvalidClientCertificate _) -> pure () + Left e -> + assertFailure $ + "expected invalid client certificate exception, got: " + <> show e + Right tlsSettings -> + assertFailure $ + "expected failure for non-existing client certificate, got: " + <> show (tlsSettings ^. creds), + testCase "fail on invalid certificate" $ do + let settings = + defRunSettings + { clientCertificate = Just "test/resources/unit/invalid.pem", + clientPrivateKey = Just "test/resources/unit/localhost-key.pem" + } + assertParsesAs settings $ + "useSystemCAStore: true\n\ + \federationStrategy:\n\ + \ allowAll: null\n\ + \clientCertificate: test/resources/unit/invalid.pem\n\ + \clientPrivateKey: test/resources/unit/localhost-key.pem" + try @FederationSetupError (mkTLSSettings settings) >>= \case + Left (InvalidClientCertificate _) -> pure () + Left e -> + assertFailure $ + "expected invalid client certificate exception, got: " + <> show e + Right tlsSettings -> + assertFailure $ + "expected failure for invalid client certificate, got: " + <> show (tlsSettings ^. creds), + testCase "fail on invalid private key" $ do + let settings = + defRunSettings + { clientCertificate = Just "test/resources/unit/localhost.pem", + clientPrivateKey = Just "test/resources/unit/invalid.pem" + } + assertParsesAs settings $ + "useSystemCAStore: true\n\ + \federationStrategy:\n\ + \ allowAll: null\n\ + \clientCertificate: test/resources/unit/localhost.pem\n\ + \clientPrivateKey: test/resources/unit/invalid.pem" + try @FederationSetupError (mkTLSSettings settings) >>= \case + Left (InvalidClientCertificate _) -> pure () + Left e -> + assertFailure $ + "expected invalid client certificate exception, got: " + <> show e + Right tlsSettings -> + assertFailure $ + "expected failure for invalid private key, got: " + <> show (tlsSettings ^. creds) + ] + assertParsesAs :: (HasCallStack, Eq a, FromJSON a, Show a) => a -> ByteString -> Assertion assertParsesAs v bs = assertEqual "YAML parsing" (Right v) $ From 011e83a2fa55e10554a825b70e2f9325487b57c2 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Tue, 27 Jul 2021 09:02:31 +0200 Subject: [PATCH 09/12] Document client certificate options Also add examples of federator configuration --- docs/reference/config-options.md | 47 ++++++++++++++++--- .../test/unit/Test/Federator/Options.hs | 36 +++++++++++--- 2 files changed, 71 insertions(+), 12 deletions(-) diff --git a/docs/reference/config-options.md b/docs/reference/config-options.md index f7627bae552..37bb33b276a 100644 --- a/docs/reference/config-options.md +++ b/docs/reference/config-options.md @@ -194,14 +194,49 @@ federator: ### Federation TLS Config When a federator connects with another federator, it does so over HTTPS. There -are two options to configure the CA for this: +are a few options to configure the CA for this: 1. `useSystemCAStore`: Boolean. If set to `True` it will use the system CA. -1. `remoteCAStore`: Maybe Filepath. This config option can be used to specify +2. `remoteCAStore`: Maybe Filepath. This config option can be used to specify multiple certificates from either a single file (multiple PEM formatted certificates concatenated) or directory (one certificate per file, file names are hashes from certificate). +3. `clientCertificate`: Maybe Filepath. A client certificate to use when + connecting to remote federators. If this option is omitted, no client + certificate is used. If it is provided, then the `clientPrivateKey` option + (see below) must be provided as well. +4. `clientPrivateKey`: Maybe Filepath. The private key corresponding to the + `clientCertificate` option above. It is an error to provide only a private key + without the corresponding certificate. -Both of these options can be specified, in this case the stores are concatenated -and used for verifying certificates. When `useSystemCAStore` is `False` and -`remoteCAStore` is not set, then all outbound connections will fail with TLS -error as there will be no CA to verify. +Both the `useSystemCAStore` and `remoteCAStore` options can be specified, in +which case the stores are concatenated and used for verifying certificates. +When `useSystemCAStore` is set to `false` and `remoteCAStore` is not provided, +all outbound connections will fail with a TLS error as there will be no CA for +verifying the server certificate. + +#### Examples + +Federate with anyone, no client certificates, use system CA store to verify +server certificates: + +```yaml +federator: + optSettings: + federationStrategy: + allowAll: + useSystemCAStore: true +``` + +Federate only with `server2.example.com`, use a client certificate and a +specific CA: + +```yaml +federator: + optSettings: + federationStrategy: + allowedDomains: + - server2.example.com + useSystemCAStore: false + clientCertificate: client.pem + clientPrivateKey: client-key.pem +``` diff --git a/services/federator/test/unit/Test/Federator/Options.hs b/services/federator/test/unit/Test/Federator/Options.hs index 1eba51b2e10..c1dc834a2d6 100644 --- a/services/federator/test/unit/Test/Federator/Options.hs +++ b/services/federator/test/unit/Test/Federator/Options.hs @@ -26,7 +26,7 @@ import Control.Lens import Data.Aeson (FromJSON) import qualified Data.Aeson as Aeson import Data.ByteString.Lazy (toStrict) -import Data.Domain (mkDomain) +import Data.Domain (Domain (..), mkDomain) import qualified Data.Yaml as Yaml import Federator.Env import Federator.Options @@ -40,7 +40,7 @@ tests = testGroup "Options" [ parseFederationStrategy, - testTLSSettings + testSettings ] parseFederationStrategy :: TestTree @@ -68,11 +68,35 @@ parseFederationStrategy = withAllowList = AllowList . AllowedDomains . map (either error id . mkDomain) -testTLSSettings :: TestTree -testTLSSettings = +testSettings :: TestTree +testSettings = testGroup - "TLS settings" - [ testCase "succefully read client credentials" $ do + "settings" + [ testCase "parse configuration example (open federation)" $ do + assertParsesAs + defRunSettings + "federationStrategy:\n\ + \ allowAll:\n\ + \useSystemCAStore: true", + testCase "parse configuration example (closed federation)" $ do + let settings = + defRunSettings + { federationStrategy = + AllowList + ( AllowedDomains [Domain "server2.example.com"] + ), + useSystemCAStore = False, + clientCertificate = Just "client.pem", + clientPrivateKey = Just "client-key.pem" + } + assertParsesAs settings $ + "federationStrategy:\n\ + \ allowedDomains:\n\ + \ - server2.example.com\n\ + \useSystemCAStore: false\n\ + \clientCertificate: client.pem\n\ + \clientPrivateKey: client-key.pem", + testCase "succefully read client credentials" $ do let settings = defRunSettings { clientCertificate = Just "test/resources/unit/localhost.pem", From b8daf2d6124bab2eca123db07d8edfdf6feaa7ca Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Tue, 27 Jul 2021 09:28:32 +0200 Subject: [PATCH 10/12] Update CHANGELOG --- CHANGELOG.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index c581719da7a..148f875391f 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -19,7 +19,7 @@ # [unreleased] -[please put all changes that only affect federation into this section to unclutter the rest of the release notes.] +[please put all changes that only affect federation into the "Federation changes" section to unclutter the rest of the release notes.] [if something is both an API change and a feature, please mention it twice (you can abbreviate the second mention and add "see above").] ## Release Notes @@ -66,6 +66,7 @@ Upgrade nginz (#1658) ## Federation changes (alpha feature, do not use yet) +* Added client certificate support for server to server authentication (#1682) # [2021-07-09] From 375c507e99a3f0bca6c363689296a0423151e9b1 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Tue, 27 Jul 2021 09:33:57 +0200 Subject: [PATCH 11/12] Move entry for #1662 to Federation section --- CHANGELOG.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 148f875391f..6c102383577 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -45,7 +45,6 @@ Upgrade nginz (#1658) * Extend feature config API (#1658) * `fileSharing` feature config (#1652, #1654, #1655) * Add user_id to csv export (#1663) -* Validate server TLS certificate between federators (#1662) ## Bug fixes and other updates @@ -66,6 +65,7 @@ Upgrade nginz (#1658) ## Federation changes (alpha feature, do not use yet) +* Validate server TLS certificate between federators (#1662) * Added client certificate support for server to server authentication (#1682) # [2021-07-09] From d3db326222c2b953c34b8dba6de08baad7319e87 Mon Sep 17 00:00:00 2001 From: jschaul Date: Tue, 27 Jul 2021 09:53:07 +0200 Subject: [PATCH 12/12] Validate server TLS certificate between federators (#1662) This sets a reasonably secure TLS configuration for the GRPC client that federator uses to connect to other federators (or rather, nginx ingresses, assuming a wire-server instance on the other side). ## Summary of changes - Enabled TLS validation and specifying a CA when creating a GRPC client - Added new configuration options for federator and corresponding docs (`docs/reference/config-options.md`) - Added integration test for the GRPC client against a local nginx playing the role of ingress - Changed end2end tests so that certificates for the ingress are created on the fly (using correct domains) - Added unit tests for the GRPC client using a mock http2/TLS server --- .gitignore | 2 +- CHANGELOG.md | 1 + Makefile | 5 + charts/federator/templates/configmap-ca.yaml | 14 ++ charts/federator/templates/configmap.yaml | 16 +- charts/federator/templates/deployment.yaml | 8 + .../federator/templates/tests/configmap.yaml | 3 + .../tests/federator-integration.yaml | 6 + charts/federator/values.yaml | 13 +- .../templates/certificate.yaml | 3 + deploy/services-demo/conf/nginz/nginx.conf | 1 + docs/reference/config-options.md | 25 +- hack/bin/buildah-make-images.sh | 2 +- hack/bin/integration-setup.sh | 22 +- hack/bin/selfsigned-kubernetes.sh | 84 +++++++ hack/helm_vars/.gitignore | 1 + .../nginx-ingress-services/values.yaml | 57 +---- hack/helm_vars/wire-server/values.yaml | 5 +- .../polysemy-wire-zoo/src/Polysemy/TinyLog.hs | 6 + services/federator/federator.cabal | 41 ++- services/federator/federator.integration.yaml | 10 +- services/federator/package.yaml | 14 +- services/federator/src/Federator/Env.hs | 4 +- .../federator/src/Federator/InternalServer.hs | 31 ++- services/federator/src/Federator/Options.hs | 13 +- services/federator/src/Federator/Remote.hs | 100 +++++++- services/federator/src/Federator/Run.hs | 39 +-- .../federator/src/Federator/Validation.hs | 3 +- services/federator/test/integration/Main.hs | 2 + .../integration/Test/Federator/IngressSpec.hs | 74 ++++++ .../integration/Test/Federator/InwardSpec.hs | 223 +--------------- .../test/integration/Test/Federator/Util.hs | 237 +++++++++++++++++- .../test/resources/integration-ca.pem | 1 + .../federator/test/resources/unit/.gitignore | 1 + .../test/resources/unit/gen-certs.sh | 49 ++++ .../test/resources/unit/localhost-dot-key.pem | 27 ++ .../test/resources/unit/localhost-dot.pem | 20 ++ .../test/resources/unit/localhost-key.pem | 27 ++ .../unit/localhost.example.com-key.pem | 27 ++ .../resources/unit/localhost.example.com.pem | 20 ++ .../test/resources/unit/localhost.pem | 20 ++ .../test/resources/unit/unit-ca-key.pem | 27 ++ .../federator/test/resources/unit/unit-ca.pem | 19 ++ services/federator/test/unit/Main.hs | 4 +- .../unit/Test/Federator/ExternalServer.hs | 18 +- .../unit/Test/Federator/InternalServer.hs | 15 +- .../test/unit/Test/Federator/Remote.hs | 111 ++++++++ .../test/unit/Test/Federator/Validation.hs | 24 +- services/integration.yaml | 10 + 49 files changed, 1107 insertions(+), 378 deletions(-) create mode 100644 charts/federator/templates/configmap-ca.yaml create mode 100755 hack/bin/selfsigned-kubernetes.sh create mode 100644 hack/helm_vars/.gitignore create mode 100644 services/federator/test/integration/Test/Federator/IngressSpec.hs create mode 120000 services/federator/test/resources/integration-ca.pem create mode 100644 services/federator/test/resources/unit/.gitignore create mode 100755 services/federator/test/resources/unit/gen-certs.sh create mode 100644 services/federator/test/resources/unit/localhost-dot-key.pem create mode 100644 services/federator/test/resources/unit/localhost-dot.pem create mode 100644 services/federator/test/resources/unit/localhost-key.pem create mode 100644 services/federator/test/resources/unit/localhost.example.com-key.pem create mode 100644 services/federator/test/resources/unit/localhost.example.com.pem create mode 100644 services/federator/test/resources/unit/localhost.pem create mode 100644 services/federator/test/resources/unit/unit-ca-key.pem create mode 100644 services/federator/test/resources/unit/unit-ca.pem create mode 100644 services/federator/test/unit/Test/Federator/Remote.hs diff --git a/.gitignore b/.gitignore index 6e5c0aaa8bf..c8af0964efe 100644 --- a/.gitignore +++ b/.gitignore @@ -99,4 +99,4 @@ i.yaml b.yaml telepresence.log -/.ghci +/.ghci \ No newline at end of file diff --git a/CHANGELOG.md b/CHANGELOG.md index 32414921fc7..e16b41c543d 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -45,6 +45,7 @@ Upgrade nginz (#1658) * Extend feature config API (#1658) * `fileSharing` feature config (#1652, #1654, #1655) * Add user_id to csv export (#1663) +* Validate server TLS certificate between federators (#1662) ## Bug fixes and other updates diff --git a/Makefile b/Makefile index 1977164db03..dec6ef464a1 100644 --- a/Makefile +++ b/Makefile @@ -439,6 +439,11 @@ kind-restart-all: .local/kind-kubeconfig kubectl delete pod -n $(NAMESPACE) -l release=$(NAMESPACE)-wire-server && \ kubectl delete pod -n $(NAMESPACE)-fed2 -l release=$(NAMESPACE)-fed2-wire-server +kind-restart-nginx-ingress: .local/kind-kubeconfig + export KUBECONFIG=$(CURDIR)/.local/kind-kubeconfig && \ + kubectl delete pod -n $(NAMESPACE) -l app=nginx-ingress && \ + kubectl delete pod -n $(NAMESPACE)-fed2 -l app=nginx-ingress + kind-restart-%: .local/kind-kubeconfig export KUBECONFIG=$(CURDIR)/.local/kind-kubeconfig && \ kubectl delete pod -n $(NAMESPACE) -l wireService=$(*) && \ diff --git a/charts/federator/templates/configmap-ca.yaml b/charts/federator/templates/configmap-ca.yaml new file mode 100644 index 00000000000..f73da24264a --- /dev/null +++ b/charts/federator/templates/configmap-ca.yaml @@ -0,0 +1,14 @@ +apiVersion: v1 +kind: Secret +metadata: + name: "federator-ca" + labels: + wireService: federator + chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} + release: {{ .Release.Name }} + heritage: {{ .Release.Service }} +data: + # TODO: add validation and fail early during templating: either contents should be provided; or explicitly system trust store enabled + {{- if .Values.remoteCAContents }} + remote-ca.pem: {{ .Values.remoteCAContents | b64enc | quote }} + {{- end }} diff --git a/charts/federator/templates/configmap.yaml b/charts/federator/templates/configmap.yaml index bf757849476..50df2444def 100644 --- a/charts/federator/templates/configmap.yaml +++ b/charts/federator/templates/configmap.yaml @@ -3,7 +3,7 @@ kind: ConfigMap metadata: name: "federator" labels: - wireService: fedrator + wireService: federator chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} @@ -40,12 +40,18 @@ data: {{- with .optSettings }} optSettings: - setFederationStrategy: - {{- if .setFederationStrategy.allowAll }} + # Filepath to one or more PEM-encoded server certificates to use as a trust + # store when making grpc requests to remote backends + {{- if $.Values.remoteCAContents }} + remoteCAStore: "/etc/wire/federator/ca/remote-ca.pem" + {{- end }} + useSystemCAStore: {{ .useSystemCAStore }} + federationStrategy: + {{- if .federationStrategy.allowAll }} allowAll: - {{- else if .setFederationStrategy.allowedDomains }} + {{- else if .federationStrategy.allowedDomains }} allowedDomains: - {{- range $domain := .setFederationStrategy.allowedDomains }} + {{- range $domain := .federationStrategy.allowedDomains }} - {{ $domain | quote }} {{- end }} {{- else }} diff --git a/charts/federator/templates/deployment.yaml b/charts/federator/templates/deployment.yaml index a13cb1138c4..8c5bebe8326 100644 --- a/charts/federator/templates/deployment.yaml +++ b/charts/federator/templates/deployment.yaml @@ -25,12 +25,18 @@ spec: annotations: # An annotation of the configmap checksum ensures changes to the configmap cause a redeployment upon `helm upgrade` checksum/configmap: {{ include (print .Template.BasePath "/configmap.yaml") . | sha256sum }} + checksum/configmap-ca: {{ include (print .Template.BasePath "/configmap-ca.yaml") . | sha256sum }} fluentbit.io/parser: json spec: volumes: - name: "federator-config" configMap: name: "federator" + # federator-ca holds CA certificates to use as a trust store + # when making requests to remote backends + - name: "federator-ca" + secret: + secretName: "federator-ca" containers: - name: federator image: "{{ .Values.image.repository }}:{{ .Values.image.tag }}" @@ -38,6 +44,8 @@ spec: volumeMounts: - name: "federator-config" mountPath: "/etc/wire/federator/conf" + - name: "federator-ca" + mountPath: "/etc/wire/federator/ca" ports: - name: internal containerPort: {{ .Values.service.internalFederatorPort }} diff --git a/charts/federator/templates/tests/configmap.yaml b/charts/federator/templates/tests/configmap.yaml index df817abac4b..7016c7d3c7f 100644 --- a/charts/federator/templates/tests/configmap.yaml +++ b/charts/federator/templates/tests/configmap.yaml @@ -16,3 +16,6 @@ data: galley: host: galley port: 8080 + nginxIngress: + host: federation-test-helper.{{ .Release.Namespace }}.svc.cluster.local + port: 443 diff --git a/charts/federator/templates/tests/federator-integration.yaml b/charts/federator/templates/tests/federator-integration.yaml index 916d0b25222..6891e7dbc53 100644 --- a/charts/federator/templates/tests/federator-integration.yaml +++ b/charts/federator/templates/tests/federator-integration.yaml @@ -13,6 +13,10 @@ spec: - name: "federator-config" configMap: name: "federator" + # integration tests need access to the CA + - name: "federator-ca" + secret: + secretName: "federator-ca" containers: - name: integration command: ["federator-integration"] @@ -22,4 +26,6 @@ spec: mountPath: "/etc/wire/integration" - name: "federator-config" mountPath: "/etc/wire/federator/conf" + - name: "federator-ca" + mountPath: "/etc/wire/federator/ca" restartPolicy: Never diff --git a/charts/federator/values.yaml b/charts/federator/values.yaml index 2611c896769..a316fda763d 100644 --- a/charts/federator/values.yaml +++ b/charts/federator/values.yaml @@ -20,5 +20,16 @@ config: logLevel: Debug logFormat: JSON optSettings: - setFederationStrategy: + # Defaults to using system CA store in the federator image for making + # connections to remote federators. + # A custom CA certificate can be provided by specifying + # federator.remoteCAContents + # e.g. from a pem file myca.pem: + # { echo "federator:"; echo " remoteCAContents: |"; sed -e 's/^/ /' myca.pem; } > myca.yaml + # then use '-f myca.yaml' as additional flag to your helm commands. + # + # Using custom CA doesn't automatically disable system CA store, it should + # be disabled explicitly by setting useSystemCAStore to false. + useSystemCAStore: true + federationStrategy: allowedDomains: [] diff --git a/charts/nginx-ingress-services/templates/certificate.yaml b/charts/nginx-ingress-services/templates/certificate.yaml index 21975e93c71..bf2561d9d97 100644 --- a/charts/nginx-ingress-services/templates/certificate.yaml +++ b/charts/nginx-ingress-services/templates/certificate.yaml @@ -36,4 +36,7 @@ spec: {{- if .Values.accountPages.enabled }} - {{ .Values.config.dns.accountPages }} {{- end }} + {{- if .Values.federator.enabled }} + - {{ .Values.config.dns.federator }} + {{- end }} {{- end -}} diff --git a/deploy/services-demo/conf/nginz/nginx.conf b/deploy/services-demo/conf/nginz/nginx.conf index 0daab72a5a9..f4249995d7b 100644 --- a/deploy/services-demo/conf/nginz/nginx.conf +++ b/deploy/services-demo/conf/nginz/nginx.conf @@ -124,6 +124,7 @@ http { # This applies only locally, as for kubernetes (helm chart) based deployments, # TLS is terminated at the ingress level, not at nginz level listen 8443 ssl http2; + listen [::]:8443 ssl http2; # self-signed certificates generated using wire-server/hack/bin/selfsigned.sh ssl_certificate integration-leaf.pem; diff --git a/docs/reference/config-options.md b/docs/reference/config-options.md index 409a85ea9ff..6075402a9f6 100644 --- a/docs/reference/config-options.md +++ b/docs/reference/config-options.md @@ -156,12 +156,12 @@ optSettings: ### Federation allow list -As of 2021-02, federation (whatever is implemented by the time you read this) is turned off by default by means of having an empty allow list: +As of 2021-07, federation (whatever is implemented by the time you read this) is turned off by default by means of having an empty allow list: ```yaml # federator.yaml optSettings: - setFederationStrategy: + federationStrategy: allowedDomains: [] ``` @@ -171,7 +171,7 @@ You can choose to federate with a specific list of allowed servers: ```yaml # federator.yaml optSettings: - setFederationStrategy: + federationStrategy: allowedDomains: - server1.example.com - server2.example.com @@ -182,7 +182,7 @@ or, you can federate with everyone: ```yaml # federator.yaml optSettings: - setFederationStrategy: + federationStrategy: # note the 'empty' value after 'allowAll' allowAll: @@ -190,6 +190,21 @@ optSettings: # inside helm_vars/wire-server: federator: optSettings: - setFederationStrategy: + federationStrategy: allowAll: true ``` + +### Federation TLS Config + +When a federator connects with another federator, it does so over HTTPS. There +are two options to configure the CA for this: +1. `useSystemCAStore`: Boolean. If set to `True` it will use the system CA. +1. `remoteCAStore`: Maybe Filepath. This config option can be used to specify + multiple certificates from either a single file (multiple PEM formatted + certificates concatenated) or directory (one certificate per file, file names + are hashes from certificate). + +Both of these options can be specified, in this case the stores are concatenated +and used for verifying certificates. When `useSystemCAStore` is `False` and +`remoteCAStore` is not set, then all outbound connections will fail with TLS +error as there will be no CA to verify. diff --git a/hack/bin/buildah-make-images.sh b/hack/bin/buildah-make-images.sh index 1efd9b46cb5..a52c470282d 100755 --- a/hack/bin/buildah-make-images.sh +++ b/hack/bin/buildah-make-images.sh @@ -9,7 +9,7 @@ EXECUTABLES=${EXECUTABLES:-"cannon brig cargohold galley gundeck federator brig- CONTAINER_NAME="output" DOCKER_TAG=${DOCKER_TAG:-$USER} -buildah containers | awk '{print $5}' | grep "$CONTAINER_NAME" || \ +buildah containers | awk '{print $5}' | grep "$CONTAINER_NAME" || buildah from --name "$CONTAINER_NAME" -v "${TOP_LEVEL}":/src --pull quay.io/wire/alpine-deps:develop # Only brig needs these templates, but for simplicity we add them to all resulting images (optimization FUTUREWORK) diff --git a/hack/bin/integration-setup.sh b/hack/bin/integration-setup.sh index 4b224524c52..1f917dfc24f 100755 --- a/hack/bin/integration-setup.sh +++ b/hack/bin/integration-setup.sh @@ -4,22 +4,22 @@ USAGE="Usage: $0" set -e -DIR="$( cd "$( dirname "${BASH_SOURCE[0]}" )" && pwd )" +DIR="$(cd "$(dirname "${BASH_SOURCE[0]}")" && pwd)" TOP_LEVEL="$DIR/../.." CHARTS_DIR="${TOP_LEVEL}/.local/charts" NAMESPACE=${NAMESPACE:-test-integration} ENABLE_KIND_VALUES=${ENABLE_KIND_VALUES:-0} -kubectl create namespace "${NAMESPACE}" > /dev/null 2>&1 || true +kubectl create namespace "${NAMESPACE}" >/dev/null 2>&1 || true ${DIR}/integration-cleanup.sh -charts=( fake-aws databases-ephemeral wire-server nginx-ingress-controller nginx-ingress-services ) +charts=(fake-aws databases-ephemeral wire-server nginx-ingress-controller nginx-ingress-services) echo "updating recursive dependencies ..." for chart in "${charts[@]}"; do - "$DIR/update.sh" "$CHARTS_DIR/$chart" + "$DIR/update.sh" "$CHARTS_DIR/$chart" done echo "Installing charts..." @@ -37,12 +37,15 @@ function printLogs() { trap printLogs ERR -FEDERATION_DOMAIN="federation-test-helper.$NAMESPACE.svc.cluster.local" +export FEDERATION_DOMAIN_BASE="$NAMESPACE.svc.cluster.local" +FEDERATION_DOMAIN="federation-test-helper.$FEDERATION_DOMAIN_BASE" +"$DIR/selfsigned-kubernetes.sh" for chart in "${charts[@]}"; do kubectl -n ${NAMESPACE} get pods valuesfile="${DIR}/../helm_vars/${chart}/values.yaml" kindValuesfile="${DIR}/../helm_vars/${chart}/kind-values.yaml" + certificatesValuesfile="${DIR}/../helm_vars/${chart}/certificates.yaml" declare -a options=() @@ -50,6 +53,10 @@ for chart in "${charts[@]}"; do options+=(-f "$valuesfile") fi + if [ -f "$certificatesValuesfile" ]; then + options+=(-f "$certificatesValuesfile") + fi + if [[ "$chart" == "nginx-ingress-services" ]]; then # Federation domain is also the SRV record created by the # federation-test-helper service. Maybe we can find a way to make these @@ -78,7 +85,10 @@ resourcesReady() { SNS_POD=$(kubectl -n "${NAMESPACE}" get pods | grep fake-aws-sns | grep Running | awk '{print $1}') kubectl -n "${NAMESPACE}" logs "$SNS_POD" -c initiate-fake-aws-sns | grep created } -until resourcesReady; do echo 'waiting for SNS resources'; sleep 1; done +until resourcesReady; do + echo 'waiting for SNS resources' + sleep 1 +done kubectl -n ${NAMESPACE} get pods diff --git a/hack/bin/selfsigned-kubernetes.sh b/hack/bin/selfsigned-kubernetes.sh new file mode 100755 index 00000000000..df2d7f5252b --- /dev/null +++ b/hack/bin/selfsigned-kubernetes.sh @@ -0,0 +1,84 @@ +#!/usr/bin/env bash + +# Create a self-signed x509 certificate in the hack/helm_vars directories (as helm yaml config). +# Requires 'cfssl' to be on your PATH (see https://github.com/cloudflare/cfssl) +# These certificates are only meant for integration tests. +# (The CA certificates are assumed to be re-used across the domains A and B for end2end integration tests.) + +set -ex +TEMP=${TEMP:-/tmp} +CSR="$TEMP/csr.json" +OUTPUTNAME_CA="integration-ca" +OUTPUTNAME_LEAF_CERT="integration-leaf" +DIR="$(cd "$(dirname "${BASH_SOURCE[0]}")" && pwd)" +TOP_LEVEL="$DIR/../.." +OUTPUT_CONFIG_FEDERATOR="$TOP_LEVEL/hack/helm_vars/wire-server/certificates.yaml" +OUTPUT_CONFIG_INGRESS="$TOP_LEVEL/hack/helm_vars/nginx-ingress-services/certificates.yaml" + +command -v cfssl >/dev/null 2>&1 || { + echo >&2 "cfssl is not installed, aborting. See https://github.com/cloudflare/cfssl" + exit 1 +} +command -v cfssljson >/dev/null 2>&1 || { + echo >&2 "cfssljson is not installed, aborting. See https://github.com/cloudflare/cfssl" + exit 1 +} + +FEDERATION_DOMAIN_BASE=${FEDERATION_DOMAIN_BASE:?"you must provide a FEDERATION_DOMAIN_BASE env variable"} + +# generate CA key and cert +if [ ! -f "$OUTPUTNAME_CA.pem" ]; then + echo "CA file not found, generating CA..." + echo '{ + "CN": "ca.example.com", + "key": { + "algo": "rsa", + "size": 2048 + } + }' >"$CSR" + cfssl gencert -initca "$CSR" | cfssljson -bare "$OUTPUTNAME_CA" + rm "$OUTPUTNAME_CA.csr" +else + echo "Re-using previous CA" +fi + +# For federation end2end tests, only the +# 'federation-test-helper.$FEDERATION_DOMAIN_BASE' is necessary for +# ingress->federator traffic. For other potential traffic in the integration +# tests of the future, we use a wildcard certificate here. +echo '{ + "key": { + "algo": "rsa", + "size": 2048 + } +}' >"$CSR" +# generate cert and key based on CA given comma-separated hostnames as SANs +cfssl gencert -ca "$OUTPUTNAME_CA.pem" -ca-key "$OUTPUTNAME_CA-key.pem" -hostname="*.$FEDERATION_DOMAIN_BASE" "$CSR" | cfssljson -bare "$OUTPUTNAME_LEAF_CERT" + +# the following yaml override file is needed as an override to +# nginx-ingress-services helm chart +# for domain A, ingress@A needs cert+key for A +{ + echo "secrets:" + echo " tlsWildcardCert: |" + sed -e 's/^/ /' $OUTPUTNAME_LEAF_CERT.pem + echo " tlsWildcardKey: |" + sed -e 's/^/ /' $OUTPUTNAME_LEAF_CERT-key.pem +} | tee "$OUTPUT_CONFIG_INGRESS" + +# the following yaml override file is needed as an override to +# the wire-server (federator) helm chart +# e.g. for installing on domain A, federator@A needs the CA for B +# As a "shortcut" for integration tests, we re-use the same CA for both domains +# A and B. +{ + echo "federator:" + echo " remoteCAContents: |" + sed -e 's/^/ /' $OUTPUTNAME_CA.pem +} | tee "$OUTPUT_CONFIG_FEDERATOR" + +# cleanup unneeded files +rm "$OUTPUTNAME_LEAF_CERT.csr" +rm "$OUTPUTNAME_LEAF_CERT.pem" +rm "$OUTPUTNAME_LEAF_CERT-key.pem" +rm "$CSR" diff --git a/hack/helm_vars/.gitignore b/hack/helm_vars/.gitignore new file mode 100644 index 00000000000..9849d951a02 --- /dev/null +++ b/hack/helm_vars/.gitignore @@ -0,0 +1 @@ +certificates.yaml diff --git a/hack/helm_vars/nginx-ingress-services/values.yaml b/hack/helm_vars/nginx-ingress-services/values.yaml index 1ca723babe2..34208c0de1b 100644 --- a/hack/helm_vars/nginx-ingress-services/values.yaml +++ b/hack/helm_vars/nginx-ingress-services/values.yaml @@ -18,58 +18,5 @@ config: accountPages: account.integration.example.com # federator: dynamically set by hack/bin/integration-setup.sh -secrets: - # self-signed certificates generated using wire-server/hack/bin/selfsigned.sh - # Note: currently these certificates are untrustable and don't match the domain queried. - # FUTUREWORK(federation): generate certificates on-the-fly valid for the respective federation domain, i.e. - # federator.$NAMESPACE.svc.cluster.local or *.$NAMESPACE.svc.cluster.local - # and find a way to add the CA cert to the local trust store when making requests. - # This can probably be built on top of the certificates generated with wire-server/hack/bin/selfsigned.sh - tlsWildcardCert: | - -----BEGIN CERTIFICATE----- - MIIDFDCCAfygAwIBAgIUaSFDTpHbxVsmWDkcLj3jqQevbBswDQYJKoZIhvcNAQEL - BQAwIjEgMB4GA1UEAxMXaW50ZWdyYXRpb24uZXhhbXBsZS5jb20wHhcNMjEwMzAz - MTUyOTAwWhcNMjYwMzAyMTUyOTAwWjAiMSAwHgYDVQQDExdpbnRlZ3JhdGlvbi5l - eGFtcGxlLmNvbTCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBAL0MPFET - VlPRAH22BxnWfqExFxFeBsB1IMJu2B0OALhSX+hUzNyTCVEXwQcwyh9T2e86D8Q3 - hoh5V0PoCuBP36KMdq7duiJdq5nZOh1wtlB7xrEObiUAstrd+r0yhSpBHi1BMGFL - YZL4OrBiQ7JzU6haWx+7Wq1upuqYKaB6ZcceqMoUyunrtEX/a1KlzMimq8FE5zjs - XyVUPt759wJNetiEz02Jc17rOzXGRafwEzF14iAAkuJGlZ6BugDLBSULk4QScYwv - xP+RrUHPIfyDVRfIjlM+wTp7sCbIy7Gkf8qgVyQnCFl4Axcmf1N+NF1/AysVCK2T - Inq/XvqNEbIwDvsCAwEAAaNCMEAwDgYDVR0PAQH/BAQDAgEGMA8GA1UdEwEB/wQF - MAMBAf8wHQYDVR0OBBYEFLQmruxKfRnOVVXfqNFO9SvfrGY6MA0GCSqGSIb3DQEB - CwUAA4IBAQAaxADjN+EIlkWzA43EpTZU4OSwzmlWyMe84n5FHM+wHAqDYggfb5vP - os88BwM+0ljoz6hcADBd1JHBlF15XzkpNmdz+9q6Y8RRmuJxZKUkml+GGLvE6Lbg - RGiv/XhsMgvbs3NTyUUUuyxGazRMqlrdrKVxDMCCuIYOA9m0CooZ/S8u3E2noDzA - 36bbcfKOlLcFtrnvVGpaSzb9/Ws1Trsj37HClsx3AybySRw8qb9IvVW7SLSKl/78 - iV+xnuiLcRmeMSuzZt5XPPSg0oblKTihiOpHfu5UNinvo/fBXJ4vqvh9eENyM0Rj - dyZ/xC223/Q8bUkv23LmQ/UDR4ljcYPa - -----END CERTIFICATE----- - tlsWildcardKey: | - -----BEGIN RSA PRIVATE KEY----- - MIIEpAIBAAKCAQEAvQw8URNWU9EAfbYHGdZ+oTEXEV4GwHUgwm7YHQ4AuFJf6FTM - 3JMJURfBBzDKH1PZ7zoPxDeGiHlXQ+gK4E/foox2rt26Il2rmdk6HXC2UHvGsQ5u - JQCy2t36vTKFKkEeLUEwYUthkvg6sGJDsnNTqFpbH7tarW6m6pgpoHplxx6oyhTK - 6eu0Rf9rUqXMyKarwUTnOOxfJVQ+3vn3Ak162ITPTYlzXus7NcZFp/ATMXXiIACS - 4kaVnoG6AMsFJQuThBJxjC/E/5GtQc8h/INVF8iOUz7BOnuwJsjLsaR/yqBXJCcI - WXgDFyZ/U340XX8DKxUIrZMier9e+o0RsjAO+wIDAQABAoIBAQCqgLKV3P7rMYFj - 4ByfbRlggEnx2//y7LDTK+22pr53f7QIcxMhjWvFu8rYlWR2xMW2QYOe0QWBaQ8P - q+TDUsa8cDtKk6gg/qKaa5VCoDmOdVRKtF0a+npVdAeFRF9eMMTqw/TCi55BU6h7 - FOVBuUomePfesreh3D6nLv28QygwYSTgbYClAdqGaNo6DhoD5jQ3ELWwOIjLgW+u - GPd4k+88Te6Vj8gD3OZqQFBcFXFvLNpy5L5gloD6gJfNqmz2Qw83+TfGe4uZnufN - k5HDgDde7UImFKLl7JQ0ZQ1nrQhwAeeqJizH7278pIs1qxDpgsPJ0ud8OoVtSLEL - er/eBt9BAoGBAOsJmStv9XlKIipoO+hhOQ3d0t+51QU7B8OvAT3XFNsWeSabYy52 - YuOsXwMF3wk/d6ek/u+FEF86IMI102EBFPoinbfxRWwTfE5qege8JgRs9STanZZr - Ys6U0p10blftPS76vd8A/OpWbdHUi60vyEgUguKo+TjZEB9riYJR4heDAoGBAM3o - mHIgyIOJWpdwBEAt126+ZvkhcbXAMPTf7k3+mLjpZq9rfbcKtZU7YW2T/dHYxsQ+ - aOb9+gnmLq7di+zUdlvd14sgJEDRtIWcVC/tlLAt7swDpPT9JbEcL6eTJX1EyROh - 4B0+gssWh8E39c73tzFkiRl/DrSRfpvuPvwmz5kpAoGAZqT5dIPfk0mx5A1DZHfZ - H9opNrWEd1VRTb9G7ofYvtlwrVCdHvRquX1UvRA6WGKUUe13vIjDHqNXHRm+p5V+ - YMLvWB6RL+LOnbxYcLpVbAddg+vJeKCLNSa/WC455kJgPv0YIKTgz0JRkZqeKVM9 - x2TVyED9HjuFlAM1uWkjMRsCgYEAjPdXHpMpEzw+o/yRPGrl2TBLCPYHhflsyshf - uk+5uKY5oZDCgUS4qdD8U2uE0lxJP+LGKJXpz0sh3J9aAyo1WZFX1iyMBUBMCUjM - Lf/F0pOvr0YzcXG5kzYLvfq0KL2lt2YUK5E3M9hZ2kL4atgWN59vaOAebipJdnE1 - 96SObXkCgYAAw7VFQXsmvJaZNxbfFfVc8SPzT0JuYlfeB5XHZ0SzxD4oJfePpgYJ - ZosmZOqR2C0ZCQ290pnf4b6eW0qooNN4DhfrswUecYifxGO2JqJz3mBUD46lT2Q1 - CvYZq7JCfRRW0AaoSmK5uFr4CGg9rMNew8B2EizrWRazghu4dC80cg== - -----END RSA PRIVATE KEY----- +# the secrets/tlsWildcardCert and secrets/tlsWildcardKey are +# dynamically provided from hack/bin/selfsigned-kubernetes.sh diff --git a/hack/helm_vars/wire-server/values.yaml b/hack/helm_vars/wire-server/values.yaml index 984900be33e..7a9fc90a534 100644 --- a/hack/helm_vars/wire-server/values.yaml +++ b/hack/helm_vars/wire-server/values.yaml @@ -235,8 +235,11 @@ spar: federator: replicaCount: 1 + resources: + requests: {} imagePullPolicy: Always config: optSettings: - setFederationStrategy: + federationStrategy: allowAll: true + useSystemCAStore: false diff --git a/libs/polysemy-wire-zoo/src/Polysemy/TinyLog.hs b/libs/polysemy-wire-zoo/src/Polysemy/TinyLog.hs index 3fb97a482b9..0f20dcf536d 100644 --- a/libs/polysemy-wire-zoo/src/Polysemy/TinyLog.hs +++ b/libs/polysemy-wire-zoo/src/Polysemy/TinyLog.hs @@ -30,6 +30,12 @@ makeSem ''TinyLog runTinyLog :: Member (Embed IO) r => Log.Logger -> Sem (TinyLog ': r) a -> Sem r a runTinyLog logger = interpret $ \(Polylog lvl msg) -> Log.log logger lvl msg +discardLogs :: Sem (TinyLog ': r) a -> Sem r a +discardLogs = interpret f + where + f :: Applicative n => TinyLog m x -> n x + f (Polylog _ _) = pure () + -- | Abbreviation of 'log' using the corresponding log level. trace, debug, info, warn, err, fatal :: Member TinyLog r => (Log.Msg -> Log.Msg) -> Sem r () trace = polylog Trace diff --git a/services/federator/federator.cabal b/services/federator/federator.cabal index 51e76bd8e17..ed4c2178fac 100644 --- a/services/federator/federator.cabal +++ b/services/federator/federator.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: c8d8d4810804d66206f0409a7239d3961d39ff18d757b13e15917b52ec2dfb08 +-- hash: b6af0b547d17e02b65a3d3cdef9ca81eb86c1292957b7f9ae6b6e3e108cb983f name: federator version: 1.0.0 @@ -15,6 +15,19 @@ maintainer: Wire Swiss GmbH copyright: (c) 2020 Wire Swiss GmbH license: AGPL-3 build-type: Simple +extra-source-files: + test/resources/integration-ca.pem + test/resources/integration-leaf-key.pem + test/resources/integration-leaf.pem + test/resources/unit/gen-certs.sh + test/resources/unit/localhost-dot-key.pem + test/resources/unit/localhost-dot.pem + test/resources/unit/localhost-key.pem + test/resources/unit/localhost.example.com-key.pem + test/resources/unit/localhost.example.com.pem + test/resources/unit/localhost.pem + test/resources/unit/unit-ca-key.pem + test/resources/unit/unit-ca.pem library exposed-modules: @@ -70,6 +83,7 @@ library , string-conversions , text , tinylog + , tls , types-common , unliftio , uri-bytestring @@ -77,6 +91,10 @@ library , wai-utilities , wire-api , wire-api-federation + , x509 + , x509-store + , x509-system + , x509-validation default-language: Haskell2010 executable federator @@ -123,6 +141,7 @@ executable federator , string-conversions , text , tinylog + , tls , types-common , unliftio , uri-bytestring @@ -130,11 +149,16 @@ executable federator , wai-utilities , wire-api , wire-api-federation + , x509 + , x509-store + , x509-system + , x509-validation default-language: Haskell2010 executable federator-integration main-is: Main.hs other-modules: + Test.Federator.IngressSpec Test.Federator.InwardSpec Test.Federator.JSON Test.Federator.Util @@ -185,6 +209,7 @@ executable federator-integration , tasty-hunit , text , tinylog + , tls , types-common , unliftio , uri-bytestring @@ -192,6 +217,10 @@ executable federator-integration , wai-utilities , wire-api , wire-api-federation + , x509 + , x509-store + , x509-system + , x509-validation , yaml default-language: Haskell2010 @@ -202,6 +231,7 @@ test-suite federator-tests Test.Federator.ExternalServer Test.Federator.InternalServer Test.Federator.Options + Test.Federator.Remote Test.Federator.Validation Paths_federator hs-source-dirs: @@ -242,17 +272,26 @@ test-suite federator-tests , retry , servant , servant-server + , streaming-commons , string-conversions , tasty , tasty-hunit , text , tinylog + , tls , types-common , unliftio , uri-bytestring , uuid + , wai , wai-utilities + , warp + , warp-tls , wire-api , wire-api-federation + , x509 + , x509-store + , x509-system + , x509-validation , yaml default-language: Haskell2010 diff --git a/services/federator/federator.integration.yaml b/services/federator/federator.integration.yaml index 18f3c17c823..9afe9b38575 100644 --- a/services/federator/federator.integration.yaml +++ b/services/federator/federator.integration.yaml @@ -15,14 +15,20 @@ logLevel: Debug logNetStrings: false optSettings: + # Filepath to one or more PEM-encoded server certificates to use as a trust + # store when making grpc requests to remote backends + remoteCAStore: "test/resources/integration-ca.pem" + # Would you like to federate with every wire-server installation ? # - setFederationStrategy: + federationStrategy: allowAll: # # or only with a select set of other wire-server installations? # - # setFederationStrategy: + # federationStrategy: # allowedDomains: # - wire.com # - example.com + + useSystemCAStore: true diff --git a/services/federator/package.yaml b/services/federator/package.yaml index 9e085558d55..acc6c7280d3 100644 --- a/services/federator/package.yaml +++ b/services/federator/package.yaml @@ -8,6 +8,7 @@ author: Wire Swiss GmbH maintainer: Wire Swiss GmbH copyright: (c) 2020 Wire Swiss GmbH license: AGPL-3 +extra-source-files: test/resources/**/* dependencies: - aeson - http-types @@ -35,6 +36,9 @@ dependencies: - servant-server - string-conversions - text +- tls +- x509-store +- x509-system - tinylog - types-common - uuid @@ -50,6 +54,8 @@ dependencies: - wai-utilities - network-uri - uri-bytestring +- x509 +- x509-validation library: source-dirs: src @@ -90,9 +96,13 @@ tests: - -threaded - -with-rtsopts=-N dependencies: + - bytestring - federator + - polysemy-mocks + - streaming-commons - tasty - tasty-hunit + - wai + - warp + - warp-tls - yaml - - bytestring - - polysemy-mocks diff --git a/services/federator/src/Federator/Env.hs b/services/federator/src/Federator/Env.hs index dfcc5f69a03..e9d24574994 100644 --- a/services/federator/src/Federator/Env.hs +++ b/services/federator/src/Federator/Env.hs @@ -24,6 +24,7 @@ import Bilge (RequestId) import qualified Bilge as RPC import Control.Lens (makeLenses) import Data.Metrics (Metrics) +import Data.X509.CertificateStore import Federator.Options (RunSettings) import Network.DNS.Resolver (Resolver) import qualified Network.HTTP.Client as HTTP @@ -37,7 +38,8 @@ data Env = Env _dnsResolver :: Resolver, _runSettings :: RunSettings, _service :: Component -> RPC.Request, - _httpManager :: HTTP.Manager + _httpManager :: HTTP.Manager, + _caStore :: CertificateStore } makeLenses ''Env diff --git a/services/federator/src/Federator/InternalServer.hs b/services/federator/src/Federator/InternalServer.hs index 9e2cc5676d8..1a95a1d3f16 100644 --- a/services/federator/src/Federator/InternalServer.hs +++ b/services/federator/src/Federator/InternalServer.hs @@ -25,11 +25,12 @@ import Data.Domain (domainText) import Data.Either.Validation (Validation (..)) import qualified Data.Text as Text import qualified Data.Text.Encoding as Text +import Data.X509.CertificateStore import Federator.App (Federator, runAppT) import Federator.Discovery (DiscoverFederator, LookupError (LookupErrorDNSError, LookupErrorSrvNotAvailable), runFederatorDiscovery) -import Federator.Env (Env, applog, dnsResolver, runSettings) +import Federator.Env (Env, applog, caStore, dnsResolver, runSettings) import Federator.Options (RunSettings) -import Federator.Remote (Remote, RemoteError (RemoteErrorClientFailure, RemoteErrorDiscoveryFailure), discoverAndCall, interpretRemote) +import Federator.Remote (Remote, RemoteError (..), discoverAndCall, interpretRemote) import Federator.Utils.PolysemyServerError (absorbServerError) import Federator.Validation import Imports @@ -73,14 +74,16 @@ mkRemoteResponse reply = mkOutwardErr RemoteFederatorError "grpc-error-string" ("error=" <> Text.pack grpcErr) Right (GRpcClientError clientErr) -> mkOutwardErr RemoteFederatorError "grpc-client-error" ("error=" <> Text.pack (show clientErr)) - Left (RemoteErrorDiscoveryFailure err domain) -> + Left (RemoteErrorDiscoveryFailure domain err) -> case err of LookupErrorSrvNotAvailable _srvDomain -> mkOutwardErr RemoteNotFound "srv-record-not-found" ("domain=" <> domainText domain) LookupErrorDNSError dnsErr -> - mkOutwardErr DiscoveryFailed "srv-lookup-dns-error" ("domain=" <> domainText domain <> "error=" <> Text.decodeUtf8 dnsErr) - Left (RemoteErrorClientFailure cltErr srvTarget) -> - mkOutwardErr RemoteFederatorError "cannot-connect-to-remote-federator" ("target=" <> Text.pack (show srvTarget) <> "error=" <> Text.pack (show cltErr)) + mkOutwardErr DiscoveryFailed "srv-lookup-dns-error" ("domain=" <> domainText domain <> "; error=" <> Text.decodeUtf8 dnsErr) + Left (RemoteErrorClientFailure srvTarget cltErr) -> + mkOutwardErr RemoteFederatorError "cannot-connect-to-remote-federator" ("target=" <> Text.pack (show srvTarget) <> "; error=" <> Text.pack (show cltErr)) + Left (RemoteErrorTLSException srvTarget exc) -> + mkOutwardErr TLSFailure "tls-failure" ("Failed to establish TLS session with remote: target=" <> Text.pack (show srvTarget) <> "; exception=" <> Text.pack (show exc)) mkOutwardErr :: OutwardErrorType -> Text -> Text -> OutwardResponse mkOutwardErr typ label msg = OutwardResponseError $ OutwardError typ (Just $ ErrorPayload label msg) @@ -92,10 +95,24 @@ serveOutward :: Env -> Int -> IO () serveOutward env port = do runGRpcAppTrans msgProtoBuf port transformer outward where - transformer :: Sem '[Remote, DiscoverFederator, TinyLog, DNSLookup, Polysemy.Error ServerError, Embed IO, Polysemy.Reader RunSettings, Embed Federator] a -> ServerErrorIO a + transformer :: + Sem + '[ Remote, + DiscoverFederator, + TinyLog, + DNSLookup, + Polysemy.Error ServerError, + Embed IO, + Polysemy.Reader RunSettings, + Polysemy.Reader CertificateStore, + Embed Federator + ] + a -> + ServerErrorIO a transformer action = runAppT env . runM -- Embed Federator + . Polysemy.runReader (view caStore env) -- Reader CertificateStore . Polysemy.runReader (view runSettings env) -- Reader RunSettings . embedToMonadIO @Federator -- Embed IO . absorbServerError diff --git a/services/federator/src/Federator/Options.hs b/services/federator/src/Federator/Options.hs index 115d06286f7..42f5b11c898 100644 --- a/services/federator/src/Federator/Options.hs +++ b/services/federator/src/Federator/Options.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StrictData #-} @@ -21,7 +20,6 @@ module Federator.Options where -import qualified Control.Lens as Lens import Data.Aeson import Data.Domain (Domain ()) import Imports @@ -60,9 +58,11 @@ instance FromJSON FederationStrategy where _ -> fail "invalid FederationStrategy: expected either allowAll or allowedDomains" -- | Options that persist as runtime settings. -newtype RunSettings = RunSettings +data RunSettings = RunSettings { -- | Would you like to federate with everyone or only with a select set of other wire-server installations? - setFederationStrategy :: FederationStrategy + federationStrategy :: FederationStrategy, + useSystemCAStore :: Bool, + remoteCAStore :: Maybe FilePath } deriving (Show, Generic) @@ -91,8 +91,3 @@ data Opts = Opts deriving (Show, Generic) instance FromJSON Opts - -Lens.makeLensesFor - [ ("setFederationStrategy", "federationStrategy") - ] - ''RunSettings diff --git a/services/federator/src/Federator/Remote.hs b/services/federator/src/Federator/Remote.hs index 92344111f46..3339f103171 100644 --- a/services/federator/src/Federator/Remote.hs +++ b/services/federator/src/Federator/Remote.hs @@ -19,15 +19,25 @@ module Federator.Remote where +import Data.Default (def) import Data.Domain (Domain, domainText) import Data.String.Conversions (cs) +import qualified Data.X509 as X509 +import Data.X509.CertificateStore +import qualified Data.X509.Validation as X509 import Federator.Discovery (DiscoverFederator, LookupError, discoverFederator) +import Federator.Options import Imports import Mu.GRpc.Client.Optics (GRpcReply) import Mu.GRpc.Client.Record (GRpcMessageProtocol (MsgProtoBuf)) import Mu.GRpc.Client.TyApps (gRpcCall) import Network.GRPC.Client.Helpers +import Network.TLS +import qualified Network.TLS as TLS +import qualified Network.TLS.Extra.Cipher as TLS import Polysemy +import qualified Polysemy.Error as Polysemy +import qualified Polysemy.Reader as Polysemy import Polysemy.TinyLog (TinyLog) import qualified Polysemy.TinyLog as Log import qualified System.Logger.Message as Log @@ -36,8 +46,9 @@ import Wire.API.Federation.GRPC.Types import Wire.Network.DNS.SRV (SrvTarget (SrvTarget)) data RemoteError - = RemoteErrorDiscoveryFailure LookupError Domain - | RemoteErrorClientFailure GrpcClientErr SrvTarget + = RemoteErrorDiscoveryFailure Domain LookupError + | RemoteErrorClientFailure SrvTarget GrpcClientErr + | RemoteErrorTLSException SrvTarget TLSException deriving (Show, Eq) data Remote m a where @@ -45,7 +56,10 @@ data Remote m a where makeSem ''Remote -interpretRemote :: (Members [Embed IO, DiscoverFederator, TinyLog] r) => Sem (Remote ': r) a -> Sem r a +interpretRemote :: + (Members [Embed IO, DiscoverFederator, TinyLog, Polysemy.Reader RunSettings, Polysemy.Reader CertificateStore] r) => + Sem (Remote ': r) a -> + Sem r a interpretRemote = interpret $ \case DiscoverAndCall ValidatedFederatedRequest {..} -> do eitherTarget <- discoverFederator vDomain @@ -55,7 +69,7 @@ interpretRemote = interpret $ \case Log.msg ("Failed to find remote federator" :: ByteString) . Log.field "domain" (domainText vDomain) . Log.field "error" (show err) - pure $ Left (RemoteErrorDiscoveryFailure err vDomain) + pure $ Left (RemoteErrorDiscoveryFailure vDomain err) Right target -> do eitherClient <- mkGrpcClient target case eitherClient of @@ -67,18 +81,77 @@ callInward :: MonadIO m => GrpcClient -> Request -> m (GRpcReply InwardResponse) callInward client request = liftIO $ gRpcCall @'MsgProtoBuf @Inward @"Inward" @"call" client request --- FUTUREWORK(federation): Make this use TLS with real certificate validation +-- FUTUREWORK(federation): Consider using HsOpenSSL instead of tls for better +-- security and to avoid having to depend on cryptonite and override validation +-- hooks. This might involve forking http2-client: https://github.com/lucasdicioccio/http2-client/issues/76 -- FUTUREWORK(federation): Allow a configurable trust store to be used in TLS certificate validation -- See also https://github.com/lucasdicioccio/http2-client/issues/76 -- FUTUREWORK(federation): Cache this client and use it for many requests -mkGrpcClient :: Members '[Embed IO, TinyLog] r => SrvTarget -> Sem r (Either RemoteError GrpcClient) -mkGrpcClient target@(SrvTarget host port) = do - -- FUTUREWORK(federation): grpcClientConfigSimple using TLS is INSECURE and IGNORES any certificates and there's no way - -- to change that (at least not when using the default functions from mu or http2-grpc-client) +mkGrpcClient :: + Members '[Embed IO, TinyLog, Polysemy.Reader CertificateStore] r => + SrvTarget -> + Sem r (Either RemoteError GrpcClient) +mkGrpcClient target@(SrvTarget host port) = logAndReturn target $ do + -- grpcClientConfigSimple using TLS is INSECURE and IGNORES any certificates -- See https://github.com/haskell-grpc-native/http2-grpc-haskell/issues/47 - -- While early testing, this is "convenient" but needs to be fixed! + -- + -- FUTUREWORK: load client certificate and client key from disk + -- and use it when making a request let cfg = grpcClientConfigSimple (cs host) (fromInteger $ toInteger port) True - eitherClient <- createGrpcClient cfg + + -- FUTUREWORK: get review on blessed ciphers + let blessed_ciphers = + [ TLS.cipher_TLS13_AES128CCM8_SHA256, + TLS.cipher_TLS13_AES128CCM_SHA256, + TLS.cipher_TLS13_AES128GCM_SHA256, + TLS.cipher_TLS13_AES256GCM_SHA384, + TLS.cipher_TLS13_CHACHA20POLY1305_SHA256, + -- For TLS 1.2 (copied from default nginx ingress config): + TLS.cipher_ECDHE_ECDSA_AES256GCM_SHA384, + TLS.cipher_ECDHE_RSA_AES256GCM_SHA384, + TLS.cipher_ECDHE_RSA_AES128GCM_SHA256, + TLS.cipher_ECDHE_ECDSA_AES128GCM_SHA256, + TLS.cipher_ECDHE_ECDSA_CHACHA20POLY1305_SHA256, + TLS.cipher_ECDHE_RSA_CHACHA20POLY1305_SHA256 + ] + + caStore <- Polysemy.ask + + -- validate the hostname without a trailing dot as the certificate is not + -- expected to have the trailing dot. + let stripDot hostname + | "." `isSuffixOf` hostname = take (length hostname - 1) hostname + | otherwise = hostname + let validateName hostname cert = + TLS.hookValidateName X509.defaultHooks (stripDot hostname) cert + + let tlsConfig = + (defaultParamsClient (cs host) (cs $ show port)) + { TLS.clientSupported = + def + { TLS.supportedCiphers = blessed_ciphers, + -- FUTUREWORK: Figure out if we can drop TLS 1.2 + TLS.supportedVersions = [TLS.TLS12, TLS.TLS13] + }, + TLS.clientHooks = + def + { TLS.onServerCertificate = + X509.validate + X509.HashSHA256 + (X509.defaultHooks {TLS.hookValidateName = validateName}) + X509.defaultChecks + }, + -- FUTUREWORK: use onCertificateRequest to provide client certificates + TLS.clientShared = def {TLS.sharedCAStore = caStore} + } + let cfg' = cfg {_grpcClientConfigTLS = Just tlsConfig} + Polysemy.mapError (RemoteErrorClientFailure target) + . Polysemy.fromEither + =<< Polysemy.fromExceptionVia (RemoteErrorTLSException target) (createGrpcClient cfg') + +logAndReturn :: Members '[TinyLog] r => SrvTarget -> Sem (Polysemy.Error RemoteError ': r) a -> Sem r (Either RemoteError a) +logAndReturn (SrvTarget host port) action = do + eitherClient <- Polysemy.runError action case eitherClient of Left err -> do Log.debug $ @@ -86,5 +159,6 @@ mkGrpcClient target@(SrvTarget host port) = do . Log.field "host" host . Log.field "port" port . Log.field "error" (show err) - pure $ Left (RemoteErrorClientFailure err target) - Right client -> pure $ Right client + pure () + _ -> pure () + pure eitherClient diff --git a/services/federator/src/Federator/Run.hs b/services/federator/src/Federator/Run.hs index 47124f09c7f..6faa0be985b 100644 --- a/services/federator/src/Federator/Run.hs +++ b/services/federator/src/Federator/Run.hs @@ -26,15 +26,18 @@ module Federator.Run -- * App Environment newEnv, + mkCAStore, closeEnv, ) where import qualified Bilge as RPC +import Control.Exception (throw) import Control.Lens ((^.)) import Data.Default (def) import qualified Data.Metrics.Middleware as Metrics import Data.Text.Encoding (encodeUtf8) +import Data.X509.CertificateStore import Federator.Env import Federator.ExternalServer (serveInward) import Federator.InternalServer (serveOutward) @@ -42,12 +45,11 @@ import Federator.Options as Opt import Imports import qualified Network.DNS as DNS import qualified Network.HTTP.Client as HTTP -import qualified Network.HTTP.Client.OpenSSL as HTTP -import OpenSSL.Session -import qualified OpenSSL.Session as SSL -import qualified OpenSSL.X509.SystemStore as SSL +import qualified Polysemy +import qualified Polysemy.Error as Polysemy import qualified System.Logger.Class as Log import qualified System.Logger.Extended as LogExt +import System.X509 import UnliftIO (bracket) import UnliftIO.Async (async, waitAnyCancel) import Util.Options @@ -81,6 +83,11 @@ run opts = ------------------------------------------------------------------------------- -- Environment +newtype InvalidCAStore = InvalidCAStore FilePath + deriving (Show) + +instance Exception InvalidCAStore + newEnv :: Opts -> DNS.Resolver -> IO Env newEnv o _dnsResolver = do _metrics <- Metrics.metrics @@ -90,10 +97,22 @@ newEnv o _dnsResolver = do let _service Brig = mkEndpoint (Opt.brig o) _service Galley = mkEndpoint (Opt.galley o) _httpManager <- initHttpManager + _caStore <- mkCAStore _runSettings return Env {..} where mkEndpoint s = RPC.host (encodeUtf8 (s ^. epHost)) . RPC.port (s ^. epPort) $ RPC.empty +mkCAStore :: RunSettings -> IO CertificateStore +mkCAStore settings = do + customCAStore <- fmap (fromRight mempty) . Polysemy.runM . Polysemy.runError @() $ do + path <- maybe (Polysemy.throw ()) pure $ remoteCAStore settings + Polysemy.embed $ readCertificateStore path >>= maybe (throw $ InvalidCAStore path) pure + systemCAStore <- + if useSystemCAStore settings + then getSystemCertificateStore + else pure mempty + pure (customCAStore <> systemCAStore) + closeEnv :: Env -> IO () closeEnv e = do Log.flush $ e ^. applog @@ -103,18 +122,10 @@ closeEnv e = do -- FUTUREWORK(federation): review certificate and protocol security setting for this TLS -- manager initHttpManager :: IO HTTP.Manager -initHttpManager = do +initHttpManager = -- See Note [SSL context] - ctx <- SSL.context - SSL.contextAddOption ctx SSL_OP_NO_SSLv2 - SSL.contextAddOption ctx SSL_OP_NO_SSLv2 - SSL.contextAddOption ctx SSL_OP_NO_TLSv1 - SSL.contextSetCiphers ctx "HIGH" - SSL.contextSetVerificationMode ctx $ - SSL.VerifyPeer True True Nothing - SSL.contextLoadSystemCerts ctx HTTP.newManager - (HTTP.opensslManagerSettings (pure ctx)) + HTTP.defaultManagerSettings { HTTP.managerConnCount = 1024, HTTP.managerIdleConnectionCount = 4096, HTTP.managerResponseTimeout = HTTP.responseTimeoutMicro 10000000 diff --git a/services/federator/src/Federator/Validation.hs b/services/federator/src/Federator/Validation.hs index d04536ad2cf..71499347416 100644 --- a/services/federator/src/Federator/Validation.hs +++ b/services/federator/src/Federator/Validation.hs @@ -23,7 +23,6 @@ module Federator.Validation ) where -import Control.Lens (view) import qualified Data.ByteString as BS import Data.Domain (Domain, domainText, mkDomain) import Data.String.Conversions (cs) @@ -39,7 +38,7 @@ import Wire.API.Federation.GRPC.Types -- startup configuration. federateWith :: Members '[Polysemy.Reader RunSettings] r => Domain -> Sem r Bool federateWith targetDomain = do - strategy <- view federationStrategy <$> Polysemy.ask + strategy <- Polysemy.asks federationStrategy pure $ case strategy of AllowAll -> True AllowList (AllowedDomains domains) -> targetDomain `elem` domains diff --git a/services/federator/test/integration/Main.hs b/services/federator/test/integration/Main.hs index 8d9d31bd053..1c6432c981e 100644 --- a/services/federator/test/integration/Main.hs +++ b/services/federator/test/integration/Main.hs @@ -23,6 +23,7 @@ where import Data.String.Conversions import Imports import System.Environment (withArgs) +import qualified Test.Federator.IngressSpec import qualified Test.Federator.InwardSpec import Test.Federator.Util (TestEnv, mkEnvFromOptions) import Test.Hspec @@ -49,3 +50,4 @@ mkspec env = do -- describe "Metrics" Test.MetricsSpec.spec describe "Federator.API" $ do Test.Federator.InwardSpec.spec env + Test.Federator.IngressSpec.spec env diff --git a/services/federator/test/integration/Test/Federator/IngressSpec.hs b/services/federator/test/integration/Test/Federator/IngressSpec.hs new file mode 100644 index 00000000000..07491211a4a --- /dev/null +++ b/services/federator/test/integration/Test/Federator/IngressSpec.hs @@ -0,0 +1,74 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2020 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . + +module Test.Federator.IngressSpec where + +import Bilge +import Control.Lens (view) +import Data.Aeson +import qualified Data.ByteString.Lazy as LBS +import Data.Handle +import Data.LegalHold (UserLegalHoldStatus (UserLegalHoldNoConsent)) +import Data.String.Conversions (cs) +import Federator.Options +import Federator.Remote (mkGrpcClient) +import Imports +import Mu.GRpc.Client.TyApps +import qualified Polysemy +import qualified Polysemy.Reader as Polysemy +import Polysemy.TinyLog (discardLogs) +import Test.Federator.Util +import Test.Hspec +import Test.Tasty.HUnit (assertFailure) +import Util.Options (Endpoint (Endpoint)) +import Wire.API.Federation.GRPC.Types hiding (body, path) +import qualified Wire.API.Federation.GRPC.Types as GRPC +import Wire.API.User +import Wire.Network.DNS.SRV + +spec :: TestEnv -> Spec +spec env = + describe "Ingress" $ do + it "should be accessible using grpc client and forward to the local brig" $ + runTestFederator env $ do + brig <- view teBrig <$> ask + user <- randomUser brig + hdl <- randomHandle + _ <- putHandle brig (userId user) hdl + + let expectedProfile = (publicProfile user UserLegalHoldNoConsent) {profileHandle = Just (Handle hdl)} + bdy <- asInwardBody =<< inwardBrigCallViaIngress "federation/get-user-by-handle" (encode hdl) + liftIO $ bdy `shouldBe` expectedProfile + +inwardBrigCallViaIngress :: (MonadIO m, MonadHttp m, MonadReader TestEnv m, HasCallStack) => ByteString -> LBS.ByteString -> m (GRpcReply InwardResponse) +inwardBrigCallViaIngress requestPath payload = do + Endpoint ingressHost ingressPort <- cfgNginxIngress . view teTstOpts <$> ask + let target = SrvTarget (cs ingressHost) ingressPort + runSettings <- optSettings . view teOpts <$> ask + caStore <- view teCAStore <$> ask + c <- liftIO . Polysemy.runM . discardLogs . Polysemy.runReader caStore . Polysemy.runReader runSettings $ mkGrpcClient target + client <- case c of + Left clientErr -> liftIO $ assertFailure (show clientErr) + Right cli -> pure cli + let brigCall = + GRPC.Request + { GRPC.component = Brig, + GRPC.path = requestPath, + GRPC.body = LBS.toStrict payload, + GRPC.originDomain = "foo.example.com" + } + liftIO $ gRpcCall @'MsgProtoBuf @Inward @"Inward" @"call" client brigCall diff --git a/services/federator/test/integration/Test/Federator/InwardSpec.hs b/services/federator/test/integration/Test/Federator/InwardSpec.hs index 069b448420e..5d35841e223 100644 --- a/services/federator/test/integration/Test/Federator/InwardSpec.hs +++ b/services/federator/test/integration/Test/Federator/InwardSpec.hs @@ -18,26 +18,15 @@ module Test.Federator.InwardSpec where import Bilge -import Bilge.Assert import Control.Lens (view) -import Control.Monad.Catch import Data.Aeson import qualified Data.Aeson.Types as Aeson -import Data.Bifunctor (first) -import qualified Data.ByteString.Char8 as C8 import qualified Data.ByteString.Lazy as LBS -import Data.Data (typeRep) -import qualified Data.Data as Data.Proxy import Data.Handle -import Data.Id import Data.LegalHold (UserLegalHoldStatus (UserLegalHoldNoConsent)) -import Data.Misc import qualified Data.Text as Text -import qualified Data.UUID as UUID -import qualified Data.UUID.V4 as UUID import Imports import Mu.GRpc.Client.TyApps -import System.Random import Test.Federator.Util import Test.Hspec import Test.Tasty.HUnit (assertFailure) @@ -46,7 +35,6 @@ import Wire.API.Federation.GRPC.Client import Wire.API.Federation.GRPC.Types hiding (body, path) import qualified Wire.API.Federation.GRPC.Types as GRPC import Wire.API.User -import Wire.API.User.Auth -- FUTUREWORK(federation): move these tests to brig-integration (benefit: avoid duplicating all of the brig helper code) @@ -113,37 +101,6 @@ expectErr expectedType err = . liftIO $ assertFailure $ "expected type '" <> show expectedType <> "' but got " <> show err -asInwardBody :: forall a. (HasCallStack, Typeable a, FromJSON a) => GRpcReply InwardResponse -> TestFederator IO a -asInwardBody = either (liftIO . assertFailure) pure . asInwardBodyEither - -asInwardBodyUnsafe :: (HasCallStack, Typeable a, FromJSON a) => GRpcReply InwardResponse -> a -asInwardBodyUnsafe = either err id . asInwardBodyEither - where - err parserErr = error . unwords $ ["asInwardBodyUnsafe:"] <> [parserErr] - -asInwardBodyEither :: forall a. (HasCallStack, Typeable a, FromJSON a) => GRpcReply InwardResponse -> Either String a -asInwardBodyEither (GRpcOk (InwardResponseError err)) = Left (show err) -asInwardBodyEither (GRpcOk (InwardResponseBody bdy)) = first addTypeInfo $ eitherDecodeStrict bdy - where - addTypeInfo :: String -> String - addTypeInfo = (("Could not parse InwardResponseBody as '" <> show (typeRep (Data.Proxy.Proxy @a)) <> "': ") <>) -asInwardBodyEither other = Left $ "GRpc call failed unexpectedly: " <> show other - -asInwardError :: HasCallStack => GRpcReply InwardResponse -> TestFederator IO InwardError -asInwardError = either err pure . asInwardErrorEither - where - err parserErr = liftIO $ assertFailure (unwords $ ["asInwardError:"] <> [parserErr]) - -asInwardErrorUnsafe :: HasCallStack => GRpcReply InwardResponse -> InwardError -asInwardErrorUnsafe = either err id . asInwardErrorEither - where - err parserErr = error . unwords $ ["asInwardErrorUnsafe:"] <> [parserErr] - -asInwardErrorEither :: HasCallStack => GRpcReply InwardResponse -> Either String InwardError -asInwardErrorEither (GRpcOk (InwardResponseError err)) = Right err -asInwardErrorEither (GRpcOk (InwardResponseBody bdy)) = Left ("expected InwardError, but got InwardResponseBody: " <> show bdy) -asInwardErrorEither other = Left $ "GRpc call failed unexpectedly: " <> show other - inwardBrigCall :: (MonadIO m, MonadHttp m, MonadReader TestEnv m, HasCallStack) => ByteString -> LBS.ByteString -> m (GRpcReply InwardResponse) inwardBrigCall requestPath payload = do c <- viewFederatorExternalClient @@ -161,182 +118,8 @@ viewFederatorExternalClient = do Endpoint fedHost fedPort <- cfgFederatorExternal . view teTstOpts <$> ask client <- createGrpcClient (grpcClientConfigSimple (Text.unpack fedHost) (fromIntegral fedPort) False) case client of - Left err -> liftIO $ assertFailure (show err) + Left clientErr -> liftIO $ assertFailure (show clientErr) Right cli -> pure cli --- All the code below is copied from brig-integration tests --- FUTUREWORK: This should live in another package and shared by all the integration tests - -randomUser :: - (MonadCatch m, MonadIO m, MonadHttp m, HasCallStack) => - BrigReq -> - m User -randomUser = randomUser' True - -randomUser' :: - (MonadCatch m, MonadIO m, MonadHttp m, HasCallStack) => - Bool -> - BrigReq -> - m User -randomUser' hasPwd brig = do - n <- fromName <$> randomName - createUser' hasPwd n brig - -createUser :: - (MonadCatch m, MonadIO m, MonadHttp m, HasCallStack) => - Text -> - BrigReq -> - m User -createUser = createUser' True - -createUser' :: - (MonadCatch m, MonadIO m, MonadHttp m, HasCallStack) => - Bool -> - Text -> - BrigReq -> - m User -createUser' hasPwd name brig = do - r <- - postUser' hasPwd True name True False Nothing Nothing brig - - Bool -> - Bool -> - Text -> - Bool -> - Bool -> - Maybe UserSSOId -> - Maybe TeamId -> - BrigReq -> - m ResponseLBS -postUser' hasPassword validateBody name haveEmail havePhone ssoid teamid brig = do - email <- - if haveEmail - then Just <$> randomEmail - else pure Nothing - postUserWithEmail hasPassword validateBody name email havePhone ssoid teamid brig - --- | More flexible variant of 'createUserUntrustedEmail' (see above). -postUserWithEmail :: - (MonadIO m, MonadHttp m, HasCallStack) => - Bool -> - Bool -> - Text -> - Maybe Email -> - Bool -> - Maybe UserSSOId -> - Maybe TeamId -> - BrigReq -> - m ResponseLBS -postUserWithEmail hasPassword validateBody name email havePhone ssoid teamid brig = do - phone <- - if havePhone - then Just <$> randomPhone - else pure Nothing - let o = - object $ - [ "name" .= name, - "email" .= (fromEmail <$> email), - "phone" .= phone, - "cookie" .= defCookieLabel, - "sso_id" .= ssoid, - "team_id" .= teamid - ] - <> ["password" .= defPassword | hasPassword] - p = case Aeson.parse parseJSON o of - Aeson.Success (p_ :: NewUser) -> p_ - bad -> error $ show (bad, o) - bdy = if validateBody then Bilge.json p else Bilge.json o - post (brig . path "/i/users" . bdy) - -putHandle :: - (MonadIO m, MonadHttp m, HasCallStack) => - BrigReq -> - UserId -> - Text -> - m ResponseLBS -putHandle brig usr h = - put $ - brig - . path "/self/handle" - . contentJson - . body payload - . zUser usr - . zConn "conn" - where - payload = RequestBodyLBS . encode $ object ["handle" .= h] - -randomName :: MonadIO m => m Name -randomName = randomNameWithMaxLen 128 - --- | For testing purposes we restrict ourselves to code points in the --- Basic Multilingual Plane that are considered to be numbers, letters, --- punctuation or symbols and ensure the name starts with a "letter". --- That is in order for the name to be searchable at all, since the standard --- ElasticSearch tokenizer may otherwise produce an empty list of tokens, --- e.g. if the name is entirely made of characters from categories that --- the standard tokenizer considers as word boundaries (or which are --- simply unassigned code points), yielding no tokens to match and thus --- no results in search queries. -randomNameWithMaxLen :: MonadIO m => Word -> m Name -randomNameWithMaxLen maxLen = liftIO $ do - len <- randomRIO (2, maxLen) - chars <- fill len [] - return $ Name (Text.pack chars) - where - fill 0 cs = return cs - fill 1 cs = (: cs) <$> randLetter - fill n cs = do - c <- randChar - if isLetter c || isNumber c || isPunctuation c || isSymbol c - then fill (n - 1) (c : cs) - else fill n cs - randChar = chr <$> randomRIO (0x0000, 0xFFFF) - randLetter = do - c <- randChar - if isLetter c - then return c - else randLetter - -randomPhone :: MonadIO m => m Phone -randomPhone = liftIO $ do - nrs <- map show <$> replicateM 14 (randomRIO (0, 9) :: IO Int) - let phone = parsePhone . Text.pack $ "+0" ++ concat nrs - return $ fromMaybe (error "Invalid random phone#") phone - -defPassword :: PlainTextPassword -defPassword = PlainTextPassword "secret" - -defCookieLabel :: CookieLabel -defCookieLabel = CookieLabel "auth" - --- | Generate emails that are in the trusted whitelist of domains whose @+@ suffices count for email --- disambiguation. See also: 'Brig.Email.mkEmailKey'. -randomEmail :: MonadIO m => m Email -randomEmail = mkSimulatorEmail "success" - -mkSimulatorEmail :: MonadIO m => Text -> m Email -mkSimulatorEmail loc = mkEmailRandomLocalSuffix (loc <> "@simulator.amazonses.com") - -mkEmailRandomLocalSuffix :: MonadIO m => Text -> m Email -mkEmailRandomLocalSuffix e = do - uid <- liftIO UUID.nextRandom - case parseEmail e of - Just (Email loc dom) -> return $ Email (loc <> "+" <> UUID.toText uid) dom - Nothing -> error $ "Invalid email address: " ++ Text.unpack e - -zUser :: UserId -> Bilge.Request -> Bilge.Request -zUser = header "Z-User" . C8.pack . show - -zConn :: ByteString -> Bilge.Request -> Bilge.Request -zConn = header "Z-Connection" - -randomHandle :: MonadIO m => m Text -randomHandle = liftIO $ do - nrs <- replicateM 21 (randomRIO (97, 122)) -- a-z - return (Text.pack (map chr nrs)) +viewIngress :: (MonadReader TestEnv m, HasCallStack) => m Endpoint +viewIngress = cfgNginxIngress . view teTstOpts <$> ask diff --git a/services/federator/test/integration/Test/Federator/Util.hs b/services/federator/test/integration/Test/Federator/Util.hs index b52bba6275c..ddd2e1e3c38 100644 --- a/services/federator/test/integration/Test/Federator/Util.hs +++ b/services/federator/test/integration/Test/Federator/Util.hs @@ -23,19 +23,39 @@ module Test.Federator.Util where import Bilge +import Bilge.Assert import Control.Exception import Control.Lens hiding ((.=)) import Control.Monad.Catch import Control.Monad.Except import Crypto.Random.Types (MonadRandom, getRandomBytes) +import Data.Aeson import Data.Aeson.TH +import qualified Data.Aeson.Types as Aeson +import Data.Bifunctor (first) +import qualified Data.ByteString.Char8 as C8 +import Data.Data (typeRep) +import Data.Id +import Data.Misc +import Data.Proxy import Data.String.Conversions +import qualified Data.Text as Text +import qualified Data.UUID as UUID +import qualified Data.UUID.V4 as UUID +import Data.X509.CertificateStore import qualified Data.Yaml as Yaml import Federator.Options -import Imports hiding (head) +import Federator.Run (mkCAStore) +import Imports +import Mu.GRpc.Client.TyApps import qualified Options.Applicative as OPA +import System.Random import Test.Federator.JSON +import Test.Tasty.HUnit import Util.Options +import Wire.API.Federation.GRPC.Types (InwardError, InwardResponse (..)) +import Wire.API.User +import Wire.API.User.Auth type BrigReq = Request -> Request @@ -66,6 +86,7 @@ runTestFederator env = flip runReaderT env . unwrapTestFederator -- | See 'mkEnv' about what's in here. data TestEnv = TestEnv { _teMgr :: Manager, + _teCAStore :: CertificateStore, _teBrig :: BrigReq, -- | federator config _teOpts :: Opts, @@ -77,7 +98,8 @@ type Select = TestEnv -> (Request -> Request) data IntegrationConfig = IntegrationConfig { cfgBrig :: Endpoint, - cfgFederatorExternal :: Endpoint + cfgFederatorExternal :: Endpoint, + cfgNginxIngress :: Endpoint } deriving (Show, Generic) @@ -121,6 +143,7 @@ mkEnv :: HasCallStack => IntegrationConfig -> Opts -> IO TestEnv mkEnv _teTstOpts _teOpts = do _teMgr :: Manager <- newManager defaultManagerSettings let _teBrig = endpointToReq (cfgBrig _teTstOpts) + _teCAStore <- mkCAStore (optSettings _teOpts) pure TestEnv {..} destroyEnv :: HasCallStack => TestEnv -> IO () @@ -128,3 +151,213 @@ destroyEnv _ = pure () endpointToReq :: Endpoint -> (Bilge.Request -> Bilge.Request) endpointToReq ep = Bilge.host (ep ^. epHost . to cs) . Bilge.port (ep ^. epPort) + +-- grpc utilities + +asInwardBody :: forall a. (HasCallStack, Typeable a, FromJSON a) => GRpcReply InwardResponse -> TestFederator IO a +asInwardBody = either (liftIO . assertFailure) pure . asInwardBodyEither + +asInwardBodyUnsafe :: (HasCallStack, Typeable a, FromJSON a) => GRpcReply InwardResponse -> a +asInwardBodyUnsafe = either err id . asInwardBodyEither + where + err parserErr = error . unwords $ ["asInwardBodyUnsafe:"] <> [parserErr] + +asInwardBodyEither :: forall a. (HasCallStack, Typeable a, FromJSON a) => GRpcReply InwardResponse -> Either String a +asInwardBodyEither (GRpcOk (InwardResponseError err)) = Left (show err) +asInwardBodyEither (GRpcOk (InwardResponseBody bdy)) = first addTypeInfo $ eitherDecodeStrict bdy + where + addTypeInfo :: String -> String + addTypeInfo = (("Could not parse InwardResponseBody as '" <> show (typeRep (Proxy @a)) <> "': ") <>) +asInwardBodyEither other = Left $ "GRpc call failed unexpectedly: " <> show other + +asInwardError :: HasCallStack => GRpcReply InwardResponse -> TestFederator IO InwardError +asInwardError = either err pure . asInwardErrorEither + where + err parserErr = liftIO $ assertFailure (unwords $ ["asInwardError:"] <> [parserErr]) + +asInwardErrorUnsafe :: HasCallStack => GRpcReply InwardResponse -> InwardError +asInwardErrorUnsafe = either err id . asInwardErrorEither + where + err parserErr = error . unwords $ ["asInwardErrorUnsafe:"] <> [parserErr] + +asInwardErrorEither :: HasCallStack => GRpcReply InwardResponse -> Either String InwardError +asInwardErrorEither (GRpcOk (InwardResponseError err)) = Right err +asInwardErrorEither (GRpcOk (InwardResponseBody bdy)) = Left ("expected InwardError, but got InwardResponseBody: " <> show bdy) +asInwardErrorEither other = Left $ "GRpc call failed unexpectedly: " <> show other + +-- All the code below is copied from brig-integration tests +-- FUTUREWORK: This should live in another package and shared by all the integration tests + +randomUser :: + (MonadCatch m, MonadIO m, MonadHttp m, HasCallStack) => + BrigReq -> + m User +randomUser = randomUser' True + +randomUser' :: + (MonadCatch m, MonadIO m, MonadHttp m, HasCallStack) => + Bool -> + BrigReq -> + m User +randomUser' hasPwd brig = do + n <- fromName <$> randomName + createUser' hasPwd n brig + +createUser :: + (MonadCatch m, MonadIO m, MonadHttp m, HasCallStack) => + Text -> + BrigReq -> + m User +createUser = createUser' True + +createUser' :: + (MonadCatch m, MonadIO m, MonadHttp m, HasCallStack) => + Bool -> + Text -> + BrigReq -> + m User +createUser' hasPwd name brig = do + r <- + postUser' hasPwd True name True False Nothing Nothing brig + + Bool -> + Bool -> + Text -> + Bool -> + Bool -> + Maybe UserSSOId -> + Maybe TeamId -> + BrigReq -> + m ResponseLBS +postUser' hasPassword validateBody name haveEmail havePhone ssoid teamid brig = do + email <- + if haveEmail + then Just <$> randomEmail + else pure Nothing + postUserWithEmail hasPassword validateBody name email havePhone ssoid teamid brig + +-- | More flexible variant of 'createUserUntrustedEmail' (see above). +postUserWithEmail :: + (MonadIO m, MonadHttp m, HasCallStack) => + Bool -> + Bool -> + Text -> + Maybe Email -> + Bool -> + Maybe UserSSOId -> + Maybe TeamId -> + BrigReq -> + m ResponseLBS +postUserWithEmail hasPassword validateBody name email havePhone ssoid teamid brig = do + phone <- + if havePhone + then Just <$> randomPhone + else pure Nothing + let o = + object $ + [ "name" .= name, + "email" .= (fromEmail <$> email), + "phone" .= phone, + "cookie" .= defCookieLabel, + "sso_id" .= ssoid, + "team_id" .= teamid + ] + <> ["password" .= defPassword | hasPassword] + p = case Aeson.parse parseJSON o of + Aeson.Success (p_ :: NewUser) -> p_ + bad -> error $ show (bad, o) + bdy = if validateBody then Bilge.json p else Bilge.json o + post (brig . path "/i/users" . bdy) + +putHandle :: + (MonadIO m, MonadHttp m, HasCallStack) => + BrigReq -> + UserId -> + Text -> + m ResponseLBS +putHandle brig usr h = + put $ + brig + . path "/self/handle" + . contentJson + . body payload + . zUser usr + . zConn "conn" + where + payload = RequestBodyLBS . encode $ object ["handle" .= h] + +randomName :: MonadIO m => m Name +randomName = randomNameWithMaxLen 128 + +-- | For testing purposes we restrict ourselves to code points in the +-- Basic Multilingual Plane that are considered to be numbers, letters, +-- punctuation or symbols and ensure the name starts with a "letter". +-- That is in order for the name to be searchable at all, since the standard +-- ElasticSearch tokenizer may otherwise produce an empty list of tokens, +-- e.g. if the name is entirely made of characters from categories that +-- the standard tokenizer considers as word boundaries (or which are +-- simply unassigned code points), yielding no tokens to match and thus +-- no results in search queries. +randomNameWithMaxLen :: MonadIO m => Word -> m Name +randomNameWithMaxLen maxLen = liftIO $ do + len <- randomRIO (2, maxLen) + chars <- fill len [] + return $ Name (Text.pack chars) + where + fill 0 characters = return characters + fill 1 characters = (: characters) <$> randLetter + fill n characters = do + c <- randChar + if isLetter c || isNumber c || isPunctuation c || isSymbol c + then fill (n - 1) (c : characters) + else fill n characters + randChar = chr <$> randomRIO (0x0000, 0xFFFF) + randLetter = do + c <- randChar + if isLetter c + then return c + else randLetter + +randomPhone :: MonadIO m => m Phone +randomPhone = liftIO $ do + nrs <- map show <$> replicateM 14 (randomRIO (0, 9) :: IO Int) + let phone = parsePhone . Text.pack $ "+0" ++ concat nrs + return $ fromMaybe (error "Invalid random phone#") phone + +defPassword :: PlainTextPassword +defPassword = PlainTextPassword "secret" + +defCookieLabel :: CookieLabel +defCookieLabel = CookieLabel "auth" + +-- | Generate emails that are in the trusted whitelist of domains whose @+@ suffices count for email +-- disambiguation. See also: 'Brig.Email.mkEmailKey'. +randomEmail :: MonadIO m => m Email +randomEmail = mkSimulatorEmail "success" + +mkSimulatorEmail :: MonadIO m => Text -> m Email +mkSimulatorEmail loc = mkEmailRandomLocalSuffix (loc <> "@simulator.amazonses.com") + +mkEmailRandomLocalSuffix :: MonadIO m => Text -> m Email +mkEmailRandomLocalSuffix e = do + uid <- liftIO UUID.nextRandom + case parseEmail e of + Just (Email loc dom) -> return $ Email (loc <> "+" <> UUID.toText uid) dom + Nothing -> error $ "Invalid email address: " ++ Text.unpack e + +zUser :: UserId -> Bilge.Request -> Bilge.Request +zUser = header "Z-User" . C8.pack . show + +zConn :: ByteString -> Bilge.Request -> Bilge.Request +zConn = header "Z-Connection" + +randomHandle :: MonadIO m => m Text +randomHandle = liftIO $ do + nrs <- replicateM 21 (randomRIO (97, 122)) -- a-z + return (Text.pack (map chr nrs)) diff --git a/services/federator/test/resources/integration-ca.pem b/services/federator/test/resources/integration-ca.pem new file mode 120000 index 00000000000..36da21ffee9 --- /dev/null +++ b/services/federator/test/resources/integration-ca.pem @@ -0,0 +1 @@ +../../../../deploy/services-demo/conf/nginz/integration-ca.pem \ No newline at end of file diff --git a/services/federator/test/resources/unit/.gitignore b/services/federator/test/resources/unit/.gitignore new file mode 100644 index 00000000000..a128116537f --- /dev/null +++ b/services/federator/test/resources/unit/.gitignore @@ -0,0 +1 @@ +!/*.pem \ No newline at end of file diff --git a/services/federator/test/resources/unit/gen-certs.sh b/services/federator/test/resources/unit/gen-certs.sh new file mode 100755 index 00000000000..f02d3983c91 --- /dev/null +++ b/services/federator/test/resources/unit/gen-certs.sh @@ -0,0 +1,49 @@ +#!/usr/bin/env bash + +set -euo pipefail + +# Create a self-signed x509 certificate in script directory. +# Requires 'cfssl' to be on your PATH (see https://github.com/cloudflare/cfssl) +# These certificates are only meant for federator unit tests + +DIR="$(cd "$(dirname "${BASH_SOURCE[0]}")" && pwd)" + +set -e +TEMP=${TEMP:-"$(mktemp -d)"} +CSR="$TEMP/csr.json" +OUTPUTNAME_CA="$DIR/unit-ca" +OUTPUTNAME_LOCALHOST_CERT="$DIR/localhost" +OUTPUTNAME_LOCALHOST_DOT_CERT="$DIR/localhost-dot" +OUTPUTNAME_EXAMPLE_COM_CERT="$DIR/localhost.example.com" + +command -v cfssl >/dev/null 2>&1 || { echo >&2 "cfssl is not installed, aborting. See https://github.com/cloudflare/cfssl"; exit 1; } +command -v cfssljson >/dev/null 2>&1 || { echo >&2 "cfssljson is not installed, aborting. See https://github.com/cloudflare/cfssl"; exit 1; } + +echo '{ + "CN": "ca.example.com", + "key": { + "algo": "rsa", + "size": 2048 + } +}' >"$CSR" + +# generate CA key and cert +cfssl gencert -initca "$CSR" | cfssljson -bare "$OUTPUTNAME_CA" + +echo '{ + "key": { + "algo": "rsa", + "size": 2048 + } +}' >"$CSR" + +# generate cert and key based on CA given comma-separated hostnames as SANs +cfssl gencert -ca "$OUTPUTNAME_CA.pem" -ca-key "$OUTPUTNAME_CA-key.pem" -hostname="localhost" "$CSR" | cfssljson -bare "$OUTPUTNAME_LOCALHOST_CERT" +cfssl gencert -ca "$OUTPUTNAME_CA.pem" -ca-key "$OUTPUTNAME_CA-key.pem" -hostname="localhost." "$CSR" | cfssljson -bare "$OUTPUTNAME_LOCALHOST_DOT_CERT" +cfssl gencert -ca "$OUTPUTNAME_CA.pem" -ca-key "$OUTPUTNAME_CA-key.pem" -hostname="localhost.example.com" "$CSR" | cfssljson -bare "$OUTPUTNAME_EXAMPLE_COM_CERT" + +# cleanup unneeded files +rm "$OUTPUTNAME_CA.csr" +rm "$OUTPUTNAME_LOCALHOST_CERT.csr" +rm "$OUTPUTNAME_LOCALHOST_DOT_CERT.csr" +rm "$OUTPUTNAME_EXAMPLE_COM_CERT.csr" diff --git a/services/federator/test/resources/unit/localhost-dot-key.pem b/services/federator/test/resources/unit/localhost-dot-key.pem new file mode 100644 index 00000000000..94b9c30a877 --- /dev/null +++ b/services/federator/test/resources/unit/localhost-dot-key.pem @@ -0,0 +1,27 @@ +-----BEGIN RSA PRIVATE KEY----- +MIIEowIBAAKCAQEAqFqePfkZcSX8ipeLVJPAInrBHvVlTeOPhZNglnZffFO6uUNi ++3y65dLNWB1UBUoF+TnAIjKL29jV106Pvx9trw6+LDZUDDii5g4nM85ujhwujHon +8HoxyPIpDpaXF4wM14U2n90XSP7FaxFjU7P2zwfaF231mJwXYwNeyCAs+Y4/PzLE +olm7HT1Q/JZ7zEGjrSGJQZ+pDUAZojd1FBXw49cRuG/8t7aSAjU5B/0XNPrZrsVJ +sQ9p1wTltmSVwDG9uUBFhjLNIjcTHnD2PmKz1gTToE45n/mKtIlNQ69MS84X4da2 +1J9k0ku0eOw3EEXxugXoflj2pfoyeQVJBvZOMwIDAQABAoIBAFsPaLgsnE5PNaHh +BkPhBvOfYgXUxc6zX1XouT2pGUyuHTlH8aoFdTIKK3eVpXSW7VQ4oGve2zc2ubOT +krzVywX8+2/+ksdpevLkhN/IsJO9OpBRInk4HuWJ1htF6MObxPZt33XoqEebRjz7 +UrZbiQvCO3ygxU6eXyf3ErU8chcosQJV2DXgb6ANocWv/fqAuLcGHK+vZ4p57ZxB +OU/BMNWke4RNV9SmYkISvyRiHHsRNFz9YEyALWHEi/sSS+2fDZrIANx5Okt7p2sQ +RtFuV9ZCxakvq0C9NgHKGfbQepf7CwCkt38PS4HqTfi6HT1MXhZ7Yp6E779Pn9op +RkklPQECgYEAzKbE/gi+TUIOfpW/wLpDf/X6kzKIuZeyalR6S+lp/qXJAK+Nm/om +15QEUVUG8jbYf9/FVhvJxmWE8rk0nCelGFXAqtwRv7tEiCwb7407n76zP00Y3nCH +Q5a/1SDUTOJDAEpk2QgHvm/ZOKG7R4/C8CXWtmP6CeDeATi3lKyUtDECgYEA0phh +Gs8LTJMKwdqqGiZH89JuK7CZKlFvAXj2fa8hkkl0uVOyR4lJxVi4b5dzoAP8dGXl +GxZlK30oCEC9EXUcp76C0DB/heLjnazGBR6oBcmXv1axtpUC1t4Au419cz9TuO4N +Gy++HAFX90iLbO9tfU/Tf8vbrFIG/r4+kHUbA6MCgYAZxYKXLwiv9/qVTExae9pW +Oea1NK7tGEJai4rfFmTHsZ7vXCwsEUNk8HneuCNoyylWaRqTrmopds1YN6R9aayr +tNjPa2k8yNtnfo6CCzoP8tblyNKx6F/QTiKYN0sk53ViivvKLO20uKcVL6DC8UKu +NUWlsE9jgRLT+o17xoPvcQKBgFjwneISmvUGDL7+OGS+0hh5QKoW9TjYF4eJrKA7 +/HOprjAu1tY7dvpvk8UdM2nbBR2rguzDsoqBWwzROohK64U0gk6mjNTgk7ydoSu8 +XL3E+9+FH5y6pe5U5/5NrTOlBRjPAJ4AtctiDeKTsr6ZB6aqten9EJNgOTAQ7J9Z +tcT9AoGBAIdiOVWN9ugbqufhGfoxP14nQQR8KXfo44rLoZOcVaz7w5bnah7w0kJt +l18o29v4wSh6Jip+paCSwgrkrcvJLShpyC6W2WuhMj6Hc/61bw2a3ktsP0d6cToM +MhoKZwAxUL36jtI96wGEDds4bRoKnIUOeQM3ZdW99RmjJEc90xqk +-----END RSA PRIVATE KEY----- diff --git a/services/federator/test/resources/unit/localhost-dot.pem b/services/federator/test/resources/unit/localhost-dot.pem new file mode 100644 index 00000000000..d30ae984f25 --- /dev/null +++ b/services/federator/test/resources/unit/localhost-dot.pem @@ -0,0 +1,20 @@ +-----BEGIN CERTIFICATE----- +MIIDQjCCAiqgAwIBAgIUKM71V/GhhKmlqD3wYYOABp9CtPAwDQYJKoZIhvcNAQEL +BQAwGTEXMBUGA1UEAxMOY2EuZXhhbXBsZS5jb20wHhcNMjEwNzIxMTUwMDAwWhcN +MjIwNzIxMTUwMDAwWjAAMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA +qFqePfkZcSX8ipeLVJPAInrBHvVlTeOPhZNglnZffFO6uUNi+3y65dLNWB1UBUoF ++TnAIjKL29jV106Pvx9trw6+LDZUDDii5g4nM85ujhwujHon8HoxyPIpDpaXF4wM +14U2n90XSP7FaxFjU7P2zwfaF231mJwXYwNeyCAs+Y4/PzLEolm7HT1Q/JZ7zEGj +rSGJQZ+pDUAZojd1FBXw49cRuG/8t7aSAjU5B/0XNPrZrsVJsQ9p1wTltmSVwDG9 +uUBFhjLNIjcTHnD2PmKz1gTToE45n/mKtIlNQ69MS84X4da21J9k0ku0eOw3EEXx +ugXoflj2pfoyeQVJBvZOMwIDAQABo4GaMIGXMA4GA1UdDwEB/wQEAwIFoDAdBgNV +HSUEFjAUBggrBgEFBQcDAQYIKwYBBQUHAwIwDAYDVR0TAQH/BAIwADAdBgNVHQ4E +FgQUfecJNfVPMmzPIJo+b6RxlBVdPccwHwYDVR0jBBgwFoAUz2uNyRBHMR6k8WqX +xJBP4C8QgykwGAYDVR0RAQH/BA4wDIIKbG9jYWxob3N0LjANBgkqhkiG9w0BAQsF +AAOCAQEAUEoT+NxDyFe/NCN9EmodemYfLE6eXKLAQDJf+dFg5BW3s51ExQW3tDr9 +UbqoV308ZaW0Quqs+0JJLxIerK+QTOCtOhLkOlCSKEYBCXGUww8w+itpSmSUvovQ +3HUGqpLpBTLkE/YKtD20Nh+xSC4DogdEnY6zdy3+1zZJJ5GrpLP89Alp3aTc51Or +LxVmD2CiOy0DTbycgBsnAm6Z1UIJzeNuSEKdJpFJ1AWzeWq7MuKCbVz4EqyJONGO +KeY87dsH21TH/fGruEpgn9GMUj5avApidDceJ5DEu9U/JYQ/6LgzfGNE5eDKTe+t +bNm46Ir7IEMsgIHgiQZpNKKWja0SdA== +-----END CERTIFICATE----- diff --git a/services/federator/test/resources/unit/localhost-key.pem b/services/federator/test/resources/unit/localhost-key.pem new file mode 100644 index 00000000000..5af42da1999 --- /dev/null +++ b/services/federator/test/resources/unit/localhost-key.pem @@ -0,0 +1,27 @@ +-----BEGIN RSA PRIVATE KEY----- +MIIEowIBAAKCAQEA7LIuwvavcwk7H9T+H/shb8ELeVVxXPGOT/G6M9KgUwfbiuke +JYNURAqz3OPogAmWIVq+jQZKWZI6WJOGNaoNXBG/AankJW23UErK92bweqad0IOm +yj53ISya350RD/sR+sCWkdKoXm1twwkiRjmV6kHIBihxVIyKy98kFBVH/lOScFMh +x1y64v8Q0659B6cxn/GUbhKZqJbrMkq+mRoI7T2eR0M5kn4VkZvGN+louOXUM40d +9Lssr/UuzAdCvgMK6O/8rmKGrCDOBHt/wd6nKbRFbNx3jXVZTtqv4//cVN+7PB5r +2lwR6bMIKX2PdQYQgBqSC03UIHe72mdN7shBTwIDAQABAoIBAAuoix0XQXUNE1hy +CUJSAEec3o/PYZIOY9AUO/OpgDQWwv2Ile+LFG91h35ty1njHv3tlk0j7i2TQkRy +n72s7pOGXD4cvBwL12ehB3ZAH8AqzMMkeOalRQDhTY+OEPUUjMIpEkGEer6L7UgZ +/xIua+/p5YxIGazsbzmzd/d1ROKF6wGT8kALAy9jHWDU/jIEh87ui0ta86J8JVHr +FfA8CfnpuI/wTT9yz/JH7OI9VpTZdPp601byle6M8aKxtOEDKwVNcl04ZfCaZs+b +aZWGe14m9N7lQouwM1XiIcZTRplCFjk8xVofwmTIxmnEdGAfQWcKL/AiZyUJoaEv +kh5CtgECgYEA/ix2kJqS12Jdt6H2oxSqcPvV0/PkBu0/TXOeJ3HE11BcRk20GW97 +SVt34ruPx2CJBNQk+JNitj6CbwLeKkEi8vYW6Dbl5dDzFyj9qAu/DKVqyCjcy0iQ +9yXs5HDE5Tep5AzC0yBs9oLPeuDMCTTxqLRryrJREEy1Yr6fReE7SsECgYEA7mWS +CHO/Kg2c2Lj8Ibhm4LktBcx7a+qgRqljUq/mTqSEhJJkhfxOByDldjBbd+65S2mS +07aGtSnYPwV8PgWYZfLPlvOeo1CGRC4cXDyfDpIPg8fLiKovpJyZcLAN2J5EKCF6 +y+MVxHB4tgEXLvfIJpUnFng0+IfhirB24JJm4A8CgYBshfOBvl3gFKHLHB5Adzxm +zT/5JXNA+d9DZJAsa0kOXcNoSRkSmyTap3FCn66+BBu8sg+vCs7k3T+3wlO1WuZf +Mm+JapcyTsrcIqZbL9i8v4weNkQ/j5ZF0C2bRALtk5y4QDKXDos3nZaU8pJrg+2C +iLZVb1lpSjdQF+/NWGOGgQKBgAtu1ZUQL//NTVNbc8QOOujWGKGpj9W6F9urrfa+ +NtZYr35IIwgF9JwE6NxFL23OBhbmxkLfAxDXI+bJ1Y6H6Cojfe8oWdhNOVM1vuhx +g9NID/Rq9YjlWImVdQphdxiHZo9iI6h5iIa2OiPIY5s+CNxI1OoP88Jjid6D3f+h +JcvjAoGBAOM5jo/Pol4pN0glfbmNatsqAwAMbvXfA99PMurDb651MUqvqf1fSesZ +kNCs8H892HNpyHteNEExTv0fzZqTZpUTu/h3lPqSSiQHOf/213BeDwAj3HoIZNd+ +CxO12u6HNv1hDGLNqLwB/aHQnaoGRD35+A6W7LOE8lgAcZIBUMsz +-----END RSA PRIVATE KEY----- diff --git a/services/federator/test/resources/unit/localhost.example.com-key.pem b/services/federator/test/resources/unit/localhost.example.com-key.pem new file mode 100644 index 00000000000..ca7d9de0333 --- /dev/null +++ b/services/federator/test/resources/unit/localhost.example.com-key.pem @@ -0,0 +1,27 @@ +-----BEGIN RSA PRIVATE KEY----- +MIIEpAIBAAKCAQEAscMdBkdLLJ+3G67HZxwGojftXTXkzoQIrEErA6XKf5RjuyOz +beSEzYD7h5TuohnXc6B+LV+RAnTyF7KAt3+Yk8TaFpl/BKbnppyUUAYRNWEHlfR+ +gA+zyGdInbdsQ2FCSieh40eqY7H/mkiwCGJWqZO5w1eIEDr98/uV20vOkON4iSpt +Qry92uHcThtC+lO7Qc5+FI0isnR7FrUXmpX6FvPV4ZECsIoqvraoAEwfwsYuiy+r +PY0w9qyyY46dG3p2FIXDBtgRrjVPoiN0w5qhTHrOPRdVUkBJx6DJnkSMerVMQFXI +lxgLx/e2eEuh31eamgYIWO0T6W17n3LgfNPb6wIDAQABAoIBABFGde6jRRH8H45o +KObDWX2wU7gIQck0Gaer2aNMHGbTo/GO4aQfXiyeiVM+zQYh3sdU5I5CSFRlyxU0 +er/afZh2u/8QQcDQ+5g8hUlVnZyDZnpTPWvymrUyHGN/bN0Leaa9PUVaNJvls4Jp +5/mYnPVz7symGAoDwaRRYdni/xsjZp5xpvAfTnsbo/8bcEAH8irypwyuubEvhmtw +g4n8xjaK0RE4Tyqo8lqp4f8SZqVyTVHHb3qkuUR+bsd0pz6/M+UgY1G11u5PuXxC +dxbECdZqBDplJGRYVGeHRewZMRDvC/wQhAaT8eFO033HZBw8V2XmRIsv89gPko05 +l4YABLECgYEA0dzQIz+xoebwc5yvyTigAkXPulG2YGatlELkl6cn6etm004Se7Nb +VVM8OcVuvSML0Hdjbl65nClEia5PVaPtNqsz8uCWF6FHHeyqrrbz1QC7QeT0VX0V +0nP3RqecUISyUPDaU9HPovlnMP0RJt11enY9iuKlEc9zbSyWP1MbdGMCgYEA2Ner +8wol5RILP/xn1/6MhlfjMPTj7YJFsQxe/ajleTnwd6ls6A93i5kMrCv6Di5XQbyg +F/fwpUYAxG09uT35ljf9RAbb+h/01Z+bm8FcnVSOhmtLcZqxnFoQ6haRMjBKFuEq ++5RyjiM58zqPVgDHpuckju2uBWWbQLM/enjNPNkCgYEAxlQGw3kbNyVX0fqeyexg +kyVElhFI6LvAiN/axlMrTk6wQzuCDjNHOlDKFtK1v7rSHHXnmtOcV69MXU1FHmsn +78VF9981GSnKWsZh23F856ykSzbDjdMDf3smkjguao2tMv8bZaFft+Y5FjvjLLaX +ol8B9DISy80giWlcqIWy6X8CgYEAg4tKb5TPakho9LcdE+YCv5jfZRqajsHBn2ce +1Qi5tLHWU/E+9QQ1BEWjb2r6NdIc8u8Hu6KYpNpzqrWOhSq4l0194d+7YOAz+cfq +cTF7CqJ6F8dNLCyo5G2q5ycri+PJflm4Zogmel2aURhMTeMJOxHrlp1PPUznQve6 +YYSZFPkCgYABlUiDiRi4Cbc7tiuQzSKL8a+JLMxmb9eaSU9a3b49zYTi3VF+St+u +m8tg8X/0gOpYs/0bBMB9s6M2X5vQPl4h1yATUpsYtc0moM3mhAJkMQHDEGBPhG6g +ECmV1EWMhbHzy8ubqqBsDzlSldy+02Vjjft+lL72wKvd99x2+xIM2Q== +-----END RSA PRIVATE KEY----- diff --git a/services/federator/test/resources/unit/localhost.example.com.pem b/services/federator/test/resources/unit/localhost.example.com.pem new file mode 100644 index 00000000000..a4d040eab81 --- /dev/null +++ b/services/federator/test/resources/unit/localhost.example.com.pem @@ -0,0 +1,20 @@ +-----BEGIN CERTIFICATE----- +MIIDTTCCAjWgAwIBAgIUV7wfK0oB5UhMDdbC4nVYseYw214wDQYJKoZIhvcNAQEL +BQAwGTEXMBUGA1UEAxMOY2EuZXhhbXBsZS5jb20wHhcNMjEwNzIxMTUwMDAwWhcN +MjIwNzIxMTUwMDAwWjAAMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA +scMdBkdLLJ+3G67HZxwGojftXTXkzoQIrEErA6XKf5RjuyOzbeSEzYD7h5TuohnX +c6B+LV+RAnTyF7KAt3+Yk8TaFpl/BKbnppyUUAYRNWEHlfR+gA+zyGdInbdsQ2FC +Sieh40eqY7H/mkiwCGJWqZO5w1eIEDr98/uV20vOkON4iSptQry92uHcThtC+lO7 +Qc5+FI0isnR7FrUXmpX6FvPV4ZECsIoqvraoAEwfwsYuiy+rPY0w9qyyY46dG3p2 +FIXDBtgRrjVPoiN0w5qhTHrOPRdVUkBJx6DJnkSMerVMQFXIlxgLx/e2eEuh31ea +mgYIWO0T6W17n3LgfNPb6wIDAQABo4GlMIGiMA4GA1UdDwEB/wQEAwIFoDAdBgNV +HSUEFjAUBggrBgEFBQcDAQYIKwYBBQUHAwIwDAYDVR0TAQH/BAIwADAdBgNVHQ4E +FgQUZ33VqP8jGpIOleV/Nii1Byqb8aEwHwYDVR0jBBgwFoAUz2uNyRBHMR6k8WqX +xJBP4C8QgykwIwYDVR0RAQH/BBkwF4IVbG9jYWxob3N0LmV4YW1wbGUuY29tMA0G +CSqGSIb3DQEBCwUAA4IBAQBJallQQcsGlXEQAf/A/uWap2osOViVV2PmpgalYT88 +yvyvf+KUMs3qthWlIvUsYXEzYHdoyIt6Q9puuduogr9wtEiQ3ZRqSz3rku15eQiw +aoo+QmbPj7ZupN3r/IsJOHImru3yAJ8nOWYdodtINwyYBabLrCzvdZ1O1qbpxJYn +2cYaphgNRiMNcKkqJuSkoix6iJXKoEduercILaugPOZpEPh11bqv5eZouGYZwRwS +tP1EN68C2IzGC+qYHYzTUIAQ4ulfw1A62fdjtM82Oii/VUs1py2V2MPbhu+XOEE2 +aWqbOwkcGGzmn1zghbPJdXKCzImjBUzPUquVTaavA/3z +-----END CERTIFICATE----- diff --git a/services/federator/test/resources/unit/localhost.pem b/services/federator/test/resources/unit/localhost.pem new file mode 100644 index 00000000000..0ebf5e32724 --- /dev/null +++ b/services/federator/test/resources/unit/localhost.pem @@ -0,0 +1,20 @@ +-----BEGIN CERTIFICATE----- +MIIDQTCCAimgAwIBAgIUIsbc/p8C1W5wIcmFes37HPhsU2UwDQYJKoZIhvcNAQEL +BQAwGTEXMBUGA1UEAxMOY2EuZXhhbXBsZS5jb20wHhcNMjEwNzIxMTUwMDAwWhcN +MjIwNzIxMTUwMDAwWjAAMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA +7LIuwvavcwk7H9T+H/shb8ELeVVxXPGOT/G6M9KgUwfbiukeJYNURAqz3OPogAmW +IVq+jQZKWZI6WJOGNaoNXBG/AankJW23UErK92bweqad0IOmyj53ISya350RD/sR ++sCWkdKoXm1twwkiRjmV6kHIBihxVIyKy98kFBVH/lOScFMhx1y64v8Q0659B6cx +n/GUbhKZqJbrMkq+mRoI7T2eR0M5kn4VkZvGN+louOXUM40d9Lssr/UuzAdCvgMK +6O/8rmKGrCDOBHt/wd6nKbRFbNx3jXVZTtqv4//cVN+7PB5r2lwR6bMIKX2PdQYQ +gBqSC03UIHe72mdN7shBTwIDAQABo4GZMIGWMA4GA1UdDwEB/wQEAwIFoDAdBgNV +HSUEFjAUBggrBgEFBQcDAQYIKwYBBQUHAwIwDAYDVR0TAQH/BAIwADAdBgNVHQ4E +FgQU6Ok4159SPm49hMw+xkw8z5XGz2YwHwYDVR0jBBgwFoAUz2uNyRBHMR6k8WqX +xJBP4C8QgykwFwYDVR0RAQH/BA0wC4IJbG9jYWxob3N0MA0GCSqGSIb3DQEBCwUA +A4IBAQDRACieKpiroZDzT1dnnnkk0mzOhIU01WZ3sWn37WP2nKvVssVXznGEJaJ1 +NsbS5f1DDOfPymNMC7iTw65NPimjx7JExmyT0zLNPnETgdxNJSeFK9e/lH919hPS +h6h7oDVZE90WW0WVAEttQz9SaM8+KCTircqfLW5Y5hrvpTEl0QwsagP5u25uEccT +B4D0RAl/72fIcSyMQSyrb38V4L7jU5iQMz0XvqVCaO5hCCDDLlL7d8nR8noKD63W +p6il2R/CDp3j/6afWPVpYStpml2wlZhqtL6p45DaSoAtvvp04qjtHNsNNzMq3pIg +6KwDhuovWaidey8R36T76NqCgkyZ +-----END CERTIFICATE----- diff --git a/services/federator/test/resources/unit/unit-ca-key.pem b/services/federator/test/resources/unit/unit-ca-key.pem new file mode 100644 index 00000000000..0a9895123d9 --- /dev/null +++ b/services/federator/test/resources/unit/unit-ca-key.pem @@ -0,0 +1,27 @@ +-----BEGIN RSA PRIVATE KEY----- +MIIEowIBAAKCAQEA90E7WukUx4um4Gv1MJrfaveLWJHh9n7DoQtSGIeMzHAjpLcC +u2Vs4NnrWs/1IRPtTvPpTjNpenZzn+Mbj02z+0mSsG2gwK2gFi/0VfYO8CFegHo5 +CfQga0Yl3HyiZhMQMvMqrpwXfqL0m2ivTLIykjxYVyt5TXznZRjhysCATqguaGaG +hnURHQVd40+VygwDsAkHwznIREZASAC/ExLerPv+tOuajRUhFxbmXRQwFWg2JZl8 +DJzokqQ7L3xpy8t3BQpizU821VKT80AGTEch+9314rUnXRAtRo3E09LYnJLjUczS +PjFpCPoo3OQig8GQa7q0CUz+utgG+205LHQDvwIDAQABAoIBABZR0SXXvIR22s2P +cUa99EUXq4CHSrqRnt8+wl5sfg1GYjFQQ/LeqQFzKoe8FgiyX82svvbMNU1UvANG +4QoCnailb5R1kPlTswvNsGTCHX8XxAwc/GElpHeKkYhhx9cnCWNQCB5TANvxodsV +jB2ESIRi5iaYSg7wo4LAyEEhN3PiFUFQ7QkgMFNnk4x9OK5wBBWAEQmsqR+WGdeq +GOGgla/4hghsJiAYv8d+50XpV9kW+siyeDFctutPxEHH06IcJZlFv/hHdzE1clSH +kVEd7Lj+zhO76+mYXb4pRnIqssYztRj3JT1kAbY3MjS7yiZCnRnwqagPEFbAV+do +yltgU+ECgYEA/sD5VjdGFImrFulDwsCyX4vCs6MVAjSPpG6MeccXrA5Or02uLLFq +PFS9TVz9o8sRAbIlJaVyJlALrDRenJGyFN3N650HE3g3dayrZkAwSIa4YrK+7Fxu +G5ZiY/kQK5UhyYfTD6SoOwU1q8gq6U3liR5teBmnuz9DASBHoebIUzMCgYEA+Hbd +8Qru4WsG5KipHMmfddxvllf6ay2xAhG2BXBERXZsqTIuFkOR+VimKBxGavOsXt88 +N8X7JZzVKJ4p21YmNGVnVo9VJIvQBGZY1EpvOALtiLEsbER45v+pA+3shd8tc/CQ +bRHz14vzNGLfsqF9B5/KDKa+WCzL81ibY4LUDUUCgYEAqgJuYzMP+bTGEMwrBFVE +tK64iNlUs9wP4FRGOx66lYAW0rasffcIRqrmijJ8skpaVx9j2vPGcfsJTyrD2QkC +Jxq+yXZJupyHpmhNGjfMARqnAnb3IxWsBY0erEkSmYM0wSF7oPzpqDmZz8INoRTz +EcbUl0nHvhZByQaZx1oUZjECgYBNX+8D1ozHpCXUZXWsollHQet6HVG9uM/rvgo6 +LVkFbLiwBBF4G3jE9sdfrFZ9jf662LgPAleQwgNbj82nIW/qVz3UJfS02dlg1WKK +UdfK0JaaP9p+qOAhx7IhqCFFG1gzR9IiNToDgPCu+q+BGGswSaGJSQ/zs5eb45cY +aTCSJQKBgDzJCvx7DBodXoOo2TLx2KCHrPepP3gEqEyOjxvjbxtsfTw4XAKZz8Az +33zUceFalni37TXWFlsoFVYRM39BW/7Yqo/1XODi9wwA7tOS0Q2fH9PfJ+7G9XLe +yMPFHa+Xv2Y6xOL2LeCklfvbszv8/vmlBKGJdCfhMZiPQTa9rnOo +-----END RSA PRIVATE KEY----- diff --git a/services/federator/test/resources/unit/unit-ca.pem b/services/federator/test/resources/unit/unit-ca.pem new file mode 100644 index 00000000000..e0ccd3eb6a2 --- /dev/null +++ b/services/federator/test/resources/unit/unit-ca.pem @@ -0,0 +1,19 @@ +-----BEGIN CERTIFICATE----- +MIIDAjCCAeqgAwIBAgIUOh4d+r3RXlf0jYj93DxmyE9TzYEwDQYJKoZIhvcNAQEL +BQAwGTEXMBUGA1UEAxMOY2EuZXhhbXBsZS5jb20wHhcNMjEwNzIxMTUwMDAwWhcN +MjYwNzIwMTUwMDAwWjAZMRcwFQYDVQQDEw5jYS5leGFtcGxlLmNvbTCCASIwDQYJ +KoZIhvcNAQEBBQADggEPADCCAQoCggEBAPdBO1rpFMeLpuBr9TCa32r3i1iR4fZ+ +w6ELUhiHjMxwI6S3ArtlbODZ61rP9SET7U7z6U4zaXp2c5/jG49Ns/tJkrBtoMCt +oBYv9FX2DvAhXoB6OQn0IGtGJdx8omYTEDLzKq6cF36i9Jtor0yyMpI8WFcreU18 +52UY4crAgE6oLmhmhoZ1ER0FXeNPlcoMA7AJB8M5yERGQEgAvxMS3qz7/rTrmo0V +IRcW5l0UMBVoNiWZfAyc6JKkOy98acvLdwUKYs1PNtVSk/NABkxHIfvd9eK1J10Q +LUaNxNPS2JyS41HM0j4xaQj6KNzkIoPBkGu6tAlM/rrYBvttOSx0A78CAwEAAaNC +MEAwDgYDVR0PAQH/BAQDAgEGMA8GA1UdEwEB/wQFMAMBAf8wHQYDVR0OBBYEFM9r +jckQRzEepPFql8SQT+AvEIMpMA0GCSqGSIb3DQEBCwUAA4IBAQAATJ2EPkQinvcS +2/PUZH8A9ReS8+47EW+6vXlVu9rOKxgWG1Kc2BaF4bBD7rgxCg2PUrmPpO69nmXU +L0phwawrrSvhhc7Pe9yZodBQAzV0fa3EdmDH4FMD01sSygxtDd+1D8daSODLnZVf +dAN9jUwVkQGTEbG0kcwHNqIpBy2odMMAElAs+vuKEjRv88QHYhyzjsijDW/QnRCy +DsZDrcGwLYUhf+gRDFVnRjhdjPdZsLTBPUD0bgOfjIsjxcOFia6/ohWhC6alvJRZ +gqAGQOK7CtBp68dRlR0nQNu1OU6ilKat938Yi0u/jtpK4//U9HXxtls8x/m+QlQw +C7Pi9KDT +-----END CERTIFICATE----- diff --git a/services/federator/test/unit/Main.hs b/services/federator/test/unit/Main.hs index e2ee9cdb5e9..65efc215a74 100644 --- a/services/federator/test/unit/Main.hs +++ b/services/federator/test/unit/Main.hs @@ -24,6 +24,7 @@ import Imports import qualified Test.Federator.ExternalServer import qualified Test.Federator.InternalServer import qualified Test.Federator.Options +import qualified Test.Federator.Remote import qualified Test.Federator.Validation as Validation import Test.Tasty @@ -35,5 +36,6 @@ main = [ Test.Federator.Options.tests, Validation.tests, Test.Federator.InternalServer.tests, - Test.Federator.ExternalServer.tests + Test.Federator.ExternalServer.tests, + Test.Federator.Remote.tests ] diff --git a/services/federator/test/unit/Test/Federator/ExternalServer.hs b/services/federator/test/unit/Test/Federator/ExternalServer.hs index 446fd164922..bcd08702c02 100644 --- a/services/federator/test/unit/Test/Federator/ExternalServer.hs +++ b/services/federator/test/unit/Test/Federator/ExternalServer.hs @@ -27,10 +27,8 @@ import Federator.Service (Service) import Imports import qualified Network.HTTP.Types as HTTP import Polysemy (embed, runM) -import Polysemy.Internal (Sem) -import Polysemy.Internal.Combinators (interpret) import qualified Polysemy.Reader as Polysemy -import qualified Polysemy.TinyLog as Log +import qualified Polysemy.TinyLog as TinyLog import Test.Polysemy.Mock (Mock (mock), evalMock) import Test.Polysemy.Mock.TH (genMock) import Test.Tasty (TestTree, testGroup) @@ -55,7 +53,7 @@ requestBrigSuccess = mockServiceCallReturns @IO (\_ _ _ _ -> pure (HTTP.ok200, Just "response body")) let request = Request Brig "/federation/get-user-by-handle" "\"foo\"" exampleDomain - res :: InwardResponse <- mock @Service @IO . noLogs . Polysemy.runReader allowAllSettings $ callLocal request + res :: InwardResponse <- mock @Service @IO . TinyLog.discardLogs . Polysemy.runReader allowAllSettings $ callLocal request actualCalls <- mockServiceCallCalls @IO let expectedCall = (Brig, "federation/get-user-by-handle", "\"foo\"", aValidDomain) embed $ assertEqual "one call to brig should be made" [expectedCall] actualCalls @@ -68,7 +66,7 @@ requestBrigFailure = mockServiceCallReturns @IO (\_ _ _ _ -> pure (HTTP.notFound404, Just "response body")) let request = Request Brig "/federation/get-user-by-handle" "\"foo\"" exampleDomain - res <- mock @Service @IO . noLogs . Polysemy.runReader allowAllSettings $ callLocal request + res <- mock @Service @IO . TinyLog.discardLogs . Polysemy.runReader allowAllSettings $ callLocal request actualCalls <- mockServiceCallCalls @IO let expectedCall = (Brig, "federation/get-user-by-handle", "\"foo\"", aValidDomain) @@ -84,23 +82,17 @@ requestGalleySuccess = mockServiceCallReturns @IO (\_ _ _ _ -> pure (HTTP.ok200, Just "response body")) let request = Request Galley "federation/get-conversations" "{}" exampleDomain - res :: InwardResponse <- mock @Service @IO . noLogs . Polysemy.runReader allowAllSettings $ callLocal request + res :: InwardResponse <- mock @Service @IO . TinyLog.discardLogs . Polysemy.runReader allowAllSettings $ callLocal request actualCalls <- mockServiceCallCalls @IO let expectedCall = (Galley, "federation/get-conversations", "{}", aValidDomain) embed $ assertEqual "one call to brig should be made" [expectedCall] actualCalls embed $ assertEqual "response should be success with correct body" (InwardResponseBody "response body") res allowAllSettings :: RunSettings -allowAllSettings = RunSettings AllowAll +allowAllSettings = RunSettings AllowAll True Nothing exampleDomain :: Text exampleDomain = "some.example.com" aValidDomain :: Domain aValidDomain = Domain exampleDomain - -noLogs :: Sem (Log.TinyLog ': r) a -> Sem r a -noLogs = interpret f - where - f :: Applicative n => Log.TinyLog m x -> n x - f (Log.Polylog _ _) = pure () diff --git a/services/federator/test/unit/Test/Federator/InternalServer.hs b/services/federator/test/unit/Test/Federator/InternalServer.hs index 43079026037..6b363eeb6fe 100644 --- a/services/federator/test/unit/Test/Federator/InternalServer.hs +++ b/services/federator/test/unit/Test/Federator/InternalServer.hs @@ -51,8 +51,12 @@ tests = ] ] +settingsWithAllowList :: [Domain] -> RunSettings +settingsWithAllowList domains = + RunSettings (AllowList (AllowedDomains domains)) True Nothing + allowAllSettings :: RunSettings -allowAllSettings = RunSettings AllowAll +allowAllSettings = RunSettings AllowAll True Nothing federatedRequestSuccess :: TestTree federatedRequestSuccess = @@ -119,7 +123,7 @@ federatedRequestFailureNoRemote :: TestTree federatedRequestFailureNoRemote = testCase "should respond with error when SRV record is not found" $ runM . evalMock @Remote @IO $ do - mockDiscoverAndCallReturns @IO (const $ pure (Left $ RemoteErrorDiscoveryFailure (LookupErrorSrvNotAvailable "_something._tcp.example.com") (Domain "example.com"))) + mockDiscoverAndCallReturns @IO (const $ pure (Left $ RemoteErrorDiscoveryFailure (Domain "example.com") (LookupErrorSrvNotAvailable "_something._tcp.example.com"))) let federatedRequest = FederatedRequest validDomainText (Just validLocalPart) res <- mock @Remote @IO . Polysemy.runReader allowAllSettings $ callOutward federatedRequest @@ -134,7 +138,7 @@ federatedRequestFailureDNS :: TestTree federatedRequestFailureDNS = testCase "should respond with error when SRV lookup fails due to DNSError" $ runM . evalMock @Remote @IO $ do - mockDiscoverAndCallReturns @IO (const $ pure (Left $ RemoteErrorDiscoveryFailure (LookupErrorDNSError "No route to 1.1.1.1") (Domain "example.com"))) + mockDiscoverAndCallReturns @IO (const $ pure (Left $ RemoteErrorDiscoveryFailure (Domain "example.com") (LookupErrorDNSError "No route to 1.1.1.1"))) let federatedRequest = FederatedRequest validDomainText (Just validLocalPart) res <- mock @Remote @IO . Polysemy.runReader allowAllSettings $ callOutward federatedRequest @@ -150,9 +154,8 @@ federatedRequestFailureAllowList = testCase "should not make a call when target domain not in the allowList" $ runM . evalMock @Remote @IO $ do let federatedRequest = FederatedRequest validDomainText (Just validLocalPart) - let allowList = RunSettings (AllowList (AllowedDomains [Domain "hello.world"])) - - res <- mock @Remote @IO . Polysemy.runReader allowList $ callOutward federatedRequest + let settings = settingsWithAllowList [Domain "hello.world"] + res <- mock @Remote @IO . Polysemy.runReader settings $ callOutward federatedRequest actualCalls <- mockDiscoverAndCallCalls @IO embed $ do diff --git a/services/federator/test/unit/Test/Federator/Remote.hs b/services/federator/test/unit/Test/Federator/Remote.hs new file mode 100644 index 00000000000..e83869a8051 --- /dev/null +++ b/services/federator/test/unit/Test/Federator/Remote.hs @@ -0,0 +1,111 @@ +{-# LANGUAGE NumericUnderscores #-} + +module Test.Federator.Remote where + +import Data.Streaming.Network (bindRandomPortTCP) +import Federator.Options +import Federator.Remote +import Federator.Run (mkCAStore) +import Imports +import Network.HTTP.Types (status200) +import Network.Wai +import qualified Network.Wai.Handler.Warp as Warp +import qualified Network.Wai.Handler.WarpTLS as WarpTLS +import qualified Polysemy +import qualified Polysemy.Reader as Polysemy +import qualified Polysemy.TinyLog as TinyLog +import Test.Tasty +import Test.Tasty.HUnit +import UnliftIO (bracket, timeout) +import qualified UnliftIO.Async as Async +import Wire.Network.DNS.SRV (SrvTarget (SrvTarget)) + +tests :: TestTree +tests = + testGroup + "Federator.Remote" + [ testGroup + "mkGrpcClient" + [ testValidatesCertificateSuccess, + testValidatesCertificateWrongHostname + ] + ] + +testValidatesCertificateSuccess :: TestTree +testValidatesCertificateSuccess = + testGroup + "can get response with valid certificate" + [ testCase "when hostname=localhost and certificate-for=localhost" $ do + bracket (startMockServer certForLocalhost) (\(serverThread, _) -> Async.cancel serverThread) $ \(_, port) -> do + caStore <- mkCAStore (RunSettings AllowAll False (Just "test/resources/unit/unit-ca.pem")) + eitherClient <- Polysemy.runM . TinyLog.discardLogs . Polysemy.runReader caStore $ mkGrpcClient (SrvTarget "localhost" (fromIntegral port)) + case eitherClient of + Left err -> assertFailure $ "Unexpected error: " <> show err + Right _ -> pure (), + testCase "when hostname=localhost. and certificate-for=localhost" $ do + bracket (startMockServer certForLocalhost) (\(serverThread, _) -> Async.cancel serverThread) $ \(_, port) -> do + caStore <- mkCAStore (RunSettings AllowAll False (Just "test/resources/unit/unit-ca.pem")) + eitherClient <- Polysemy.runM . TinyLog.discardLogs . Polysemy.runReader caStore $ mkGrpcClient (SrvTarget "localhost." (fromIntegral port)) + case eitherClient of + Left err -> assertFailure $ "Unexpected error: " <> show err + Right _ -> pure (), + -- This is a limitation of the TLS library, this test just exists to document that. + testCase "when hostname=localhost. and certificate-for=localhost." $ do + bracket (startMockServer certForLocalhostDot) (\(serverThread, _) -> Async.cancel serverThread) $ \(_, port) -> do + caStore <- mkCAStore (RunSettings AllowAll False (Just "test/resources/unit/unit-ca.pem")) + eitherClient <- + Polysemy.runM . TinyLog.discardLogs . Polysemy.runReader caStore $ + mkGrpcClient (SrvTarget "localhost." (fromIntegral port)) + case eitherClient of + Left _ -> pure () + Right _ -> assertFailure "Congratulations, you fixed a known issue!" + ] + +testValidatesCertificateWrongHostname :: TestTree +testValidatesCertificateWrongHostname = + testGroup + "refuses to connect with server" + [ testCase "when the server's certificate doesn't match the hostname" $ + bracket (startMockServer certForWrongDomain) (Async.cancel . fst) $ \(_, port) -> do + caStore <- mkCAStore (RunSettings AllowAll False (Just "test/resources/unit/unit-ca.pem")) + eitherClient <- + Polysemy.runM . TinyLog.discardLogs . Polysemy.runReader caStore $ + mkGrpcClient (SrvTarget "localhost." (fromIntegral port)) + case eitherClient of + Left (RemoteErrorTLSException _ _) -> pure () + Left x -> assertFailure $ "Expected TLS failure, got: " <> show x + Right _ -> assertFailure "Expected connection with the server to fail" + ] + +certForLocalhost :: WarpTLS.TLSSettings +certForLocalhost = WarpTLS.tlsSettings "test/resources/unit/localhost.pem" "test/resources/unit/localhost-key.pem" + +certForLocalhostDot :: WarpTLS.TLSSettings +certForLocalhostDot = WarpTLS.tlsSettings "test/resources/unit/localhost-dot.pem" "test/resources/unit/localhost-dot-key.pem" + +certForWrongDomain :: WarpTLS.TLSSettings +certForWrongDomain = WarpTLS.tlsSettings "test/resources/unit/localhost.example.com.pem" "test/resources/unit/localhost.example.com-key.pem" + +startMockServer :: MonadIO m => WarpTLS.TLSSettings -> m (Async.Async (), Warp.Port) +startMockServer tlsSettings = liftIO $ do + (port, sock) <- bindRandomPortTCP "*6" + serverStarted <- newEmptyMVar + let settings = + Warp.defaultSettings + & Warp.setPort port + & Warp.setGracefulCloseTimeout2 0 -- Defaults to 2 seconds, causes server stop to take very long + & Warp.setBeforeMainLoop (putMVar serverStarted ()) + app _req respond = respond $ responseLBS status200 [] "dragons be here" + + serverThread <- Async.async $ WarpTLS.runTLSSocket tlsSettings settings sock app + serverStartedSignal <- timeout 10_000_000 (takeMVar serverStarted) + case serverStartedSignal of + Nothing -> do + maybeException <- Async.poll serverThread + case maybeException of + Just (Left err) -> assertFailure $ "mock server errored while starting: \n" <> show err + _ -> pure () + liftIO $ Async.cancel serverThread + assertFailure $ "Failed to start the mock server within 10 seconds on port: " <> show port + _ -> do + pure (serverThread, port) diff --git a/services/federator/test/unit/Test/Federator/Validation.hs b/services/federator/test/unit/Test/Federator/Validation.hs index 0fb639761b5..02927ace864 100644 --- a/services/federator/test/unit/Test/Federator/Validation.hs +++ b/services/federator/test/unit/Test/Federator/Validation.hs @@ -59,32 +59,32 @@ federateWithAllowListSuccess = testCase "should give True when target domain is in the list" $ -- removing evalMock @Remote doesn't seem to work, but why? runM . evalMock @Remote @IO $ do - let allowList = RunSettings (AllowList (AllowedDomains [Domain "hello.world"])) - res <- Polysemy.runReader allowList $ federateWith (Domain "hello.world") + let settings = settingsWithAllowList [Domain "hello.world"] + res <- Polysemy.runReader settings $ federateWith (Domain "hello.world") embed $ assertBool "federating should be allowed" res federateWithAllowListFail :: TestTree federateWithAllowListFail = testCase "should give False when target domain is not in the list" $ runM . evalMock @Remote @IO $ do - let allowList = RunSettings (AllowList (AllowedDomains [Domain "only.other.domain"])) - res <- Polysemy.runReader allowList $ federateWith (Domain "hello.world") + let settings = settingsWithAllowList [Domain "only.other.domain"] + res <- Polysemy.runReader settings $ federateWith (Domain "hello.world") embed $ assertBool "federating should not be allowed" (not res) validateDomainAllowListFailSemantic :: TestTree validateDomainAllowListFailSemantic = testCase "semantic validation" $ runM . evalMock @Remote @IO $ do - let allowList = RunSettings (AllowList (AllowedDomains [Domain "only.other.domain"])) - res :: Either InwardError Domain <- Polysemy.runError . Polysemy.runReader allowList $ validateDomain ("invalid//.><-semantic-&@-domain" :: Text) + let settings = settingsWithAllowList [Domain "only.other.domain"] + res :: Either InwardError Domain <- Polysemy.runError . Polysemy.runReader settings $ validateDomain ("invalid//.><-semantic-&@-domain" :: Text) embed $ assertEqual "semantic parse failure" (Left IInvalidDomain) (mapLeft inwardErrorType res) validateDomainAllowListFail :: TestTree validateDomainAllowListFail = testCase "allow list validation" $ runM . evalMock @Remote @IO $ do - let allowList = RunSettings (AllowList (AllowedDomains [Domain "only.other.domain"])) - res :: Either InwardError Domain <- Polysemy.runError . Polysemy.runReader allowList $ validateDomain ("hello.world" :: Text) + let settings = settingsWithAllowList [Domain "only.other.domain"] + res :: Either InwardError Domain <- Polysemy.runError . Polysemy.runReader settings $ validateDomain ("hello.world" :: Text) embed $ assertEqual "allow list:" (Left IFederationDeniedByRemote) (mapLeft inwardErrorType res) validateDomainAllowListSuccess :: TestTree @@ -93,8 +93,8 @@ validateDomainAllowListSuccess = -- removing evalMock @Remote doesn't seem to work, but why? runM . evalMock @Remote @IO $ do let domain = Domain "hello.world" - let allowList = RunSettings (AllowList (AllowedDomains [domain])) - res :: Either InwardError Domain <- Polysemy.runError . Polysemy.runReader allowList $ validateDomain ("hello.world" :: Text) + let settings = settingsWithAllowList [domain] + res :: Either InwardError Domain <- Polysemy.runError . Polysemy.runReader settings $ validateDomain ("hello.world" :: Text) embed $ assertEqual "validateDomain should give 'hello.world' as domain" (Right domain) res validatePathSuccess :: [TestTree] @@ -174,3 +174,7 @@ expectErr expectedType (Left err) = unless (inwardErrorType err == expectedType) . liftIO $ assertFailure $ "expected type '" <> show expectedType <> "' but got " <> show err + +settingsWithAllowList :: [Domain] -> RunSettings +settingsWithAllowList domains = + RunSettings (AllowList (AllowedDomains domains)) False Nothing diff --git a/services/integration.yaml b/services/integration.yaml index ea5bd5667e9..f28eb23f902 100644 --- a/services/integration.yaml +++ b/services/integration.yaml @@ -35,6 +35,16 @@ nginz: host: 127.0.0.1 port: 8080 +# client-API: +# webapp ---> load balancer ---> nginx-ingress (TLS termination) ---> nginz ----> brig +# +# federation API: +# federator@B ---> load balancer ---> nginx-ingress (TLS termination) ----> federator@A ---> brig@A +# (for local integration tests, we (ab)use nginz as a stand-in kube-ingress for TLS-aware tests) +nginxIngress: + host: localhost + port: 8443 + federatorInternal: host: 127.0.0.1 port: 8097