Strip trailing dot when validating certificate

Author: pcapriotti

hack/bin/selfsigned-kubernetes.sh

@@ -43,19 +43,17 @@ else
 fi
 
 # For federation end2end tests, only the
-# 'federation-test-helper.$NAMESPACE.svc.cluster.local' is necessary for
+# '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.
-HOSTNAME_DOMAIN="*.$FEDERATION_DOMAIN_BASE"
-
 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="$HOSTNAME_DOMAIN" "$CSR" | cfssljson -bare "$OUTPUTNAME_LEAF_CERT"
+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

services/federator/federator.cabal

@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: c0fa14fcc8de193a5a256a3c145a8b3a60196f151787ead79ba62bc48e948fee
+-- hash: f20104e2f4934b00d12efd33f7c7bfb2c138ddded9a8bede22e437d5ef8803d1
 
 name:           federator
 version:        1.0.0
@@ -78,8 +78,10 @@ library
     , wai-utilities
     , wire-api
     , wire-api-federation
+    , x509
     , x509-store
     , x509-system
+    , x509-validation
   default-language: Haskell2010
 
 executable federator
@@ -134,8 +136,10 @@ executable federator
     , wai-utilities
     , wire-api
     , wire-api-federation
+    , x509
     , x509-store
     , x509-system
+    , x509-validation
   default-language: Haskell2010
 
 executable federator-integration
@@ -199,8 +203,10 @@ executable federator-integration
     , wai-utilities
     , wire-api
     , wire-api-federation
+    , x509
     , x509-store
     , x509-system
+    , x509-validation
     , yaml
   default-language: Haskell2010
 
@@ -264,7 +270,9 @@ test-suite federator-tests
     , wai-utilities
     , wire-api
     , wire-api-federation
+    , x509
     , x509-store
     , x509-system
+    , x509-validation
     , yaml
   default-language: Haskell2010

services/federator/package.yaml

@@ -53,6 +53,8 @@ dependencies:
 - wai-utilities
 - network-uri
 - uri-bytestring
+- x509
+- x509-validation
 
 library:
   source-dirs: src

services/federator/src/Federator/Remote.hs

@@ -22,7 +22,9 @@ 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
@@ -77,7 +79,9 @@ 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
@@ -116,10 +120,31 @@ mkGrpcClient target@(SrvTarget host port) = Polysemy.runError $ do
 
   let caStore = customCAStore <> systemCAStore
 
+  -- strip trailing dot to workaround issue in tls domain verification
+  let stripDot hostname
+        | isSuffixOf "." hostname = take (length hostname - 1) hostname
+        | otherwise = hostname
+  -- try validating the hostname without a trailing dot, and if that fails, try
+  -- again with the original hostname
+  let validateName hostname cert
+        | null validation = []
+        | isSuffixOf "." hostname = TLS.hookValidateName X509.defaultHooks hostname cert
+        | otherwise = validation
+        where
+          validation = TLS.hookValidateName X509.defaultHooks (stripDot hostname) cert
+
   let betterTLSConfig =
         (defaultParamsClient (cs host) (cs $ show port))
           { TLS.clientSupported = def {TLS.supportedCiphers = blessed_ciphers},
-            TLS.clientHooks = def, -- FUTUREWORK: use onCertificateRequest to provide client certificates
+            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 betterTLSConfig}