Merge pull request #3390 from input-output-hk/devops-992-x509-san-backport-release

[DEVOPS-992] Fix x509 generator SANs to work with IP addresses

Author: rvl

pkgs/default.nix

@@ -17386,11 +17386,13 @@ license = stdenv.lib.licenses.mit;
 , Glob
 , hourglass
 , hspec
+, ip
 , lens
 , lifted-async
 , log-warper
 , mtl
 , neat-interpolation
+, network-transport
 , network-transport-tcp
 , optparse-applicative
 , optparse-generic
@@ -17477,11 +17479,13 @@ filepath
 formatting
 Glob
 hourglass
+ip
 lens
 lifted-async
 log-warper
 mtl
 neat-interpolation
+network-transport
 network-transport-tcp
 optparse-applicative
 optparse-generic
@@ -46471,6 +46475,48 @@ homepage = "http://snapframework.com/";
 description = "HAProxy protocol 1.5 support for io-streams";
 license = stdenv.lib.licenses.bsd3;
 
+}) {};
+"ip" = callPackage
+({
+  mkDerivation
+, aeson
+, attoparsec
+, base
+, bytestring
+, fetchgit
+, hashable
+, primitive
+, stdenv
+, text
+, vector
+}:
+mkDerivation {
+
+pname = "ip";
+version = "1.3.0";
+src = fetchgit {
+
+url = "https://github.com/andrewthad/haskell-ip";
+sha256 = "199mfpbgca7rvwvwk2zsmcpibc0sk0ni7c5zlf4gk3cps8s85gyr";
+rev = "9bb453139aa82cc973125091800422a523e1eb8f";
+
+};
+libraryHaskellDepends = [
+aeson
+attoparsec
+base
+bytestring
+hashable
+primitive
+text
+vector
+];
+doHaddock = false;
+doCheck = false;
+homepage = "https://github.com/andrewthad/haskell-ip#readme";
+description = "Library for IP and MAC addresses";
+license = stdenv.lib.licenses.bsd3;
+
 }) {};
 "ip6addr" = callPackage
 ({

stack.yaml

@@ -92,6 +92,11 @@ packages:
     git: https://github.com/input-output-hk/cardano-crypto
     commit: 287cc575fafe86af9d24af9d012c47f9d3f04da0
   extra-dep: true
+  # to be removed when haskell-ip is in the current stackage version
+- location:
+    git: https://github.com/andrewthad/haskell-ip
+    commit: 9bb453139aa82cc973125091800422a523e1eb8f
+  extra-dep: true
 
 # Required for explorer.
 # We forked it because it has some unacceptable version bounds. We didn't

tools/cardano-sl-tools.cabal

@@ -499,18 +499,21 @@ executable cardano-x509-certificates
                , aeson
                , asn1-encoding
                , asn1-types
-               , bytestring
                , base64-bytestring
+               , bytestring
                , cryptonite
+               , data-default-class
                , filepath
                , hourglass
+               , ip
+               , network-transport
                , optparse-applicative
+               , text
                , universum
                , unordered-containers
                , x509
-               , x509-validation
                , x509-store
-               , data-default-class
+               , x509-validation
                , yaml
 
   default-extensions:   DeriveGeneric

tools/src/gencerts/Configuration.hs

@@ -21,13 +21,20 @@ import           Data.X509
 import           Data.X509.Validation (ValidationChecks (..), defaultChecks)
 import           Data.Yaml (decodeFileEither, parseMonad, withObject)
 import           GHC.Generics (Generic)
+import           Net.IP (IP, case_, decode)
+import           Net.IPv4 (IPv4 (..))
+import           Net.IPv6 (IPv6 (..))
+import           Network.Transport.Internal (encodeWord32)
 import           System.IO (FilePath)
 
 import qualified Data.Aeson as Aeson
 import qualified Data.Aeson.Types as Aeson
+import qualified Data.ByteString.Builder as BS
+import qualified Data.ByteString.Lazy as LBS
 import qualified Data.Char as Char
 import qualified Data.HashMap.Lazy as HM
 import qualified Data.List.NonEmpty as NonEmpty
+import qualified Data.Text as T
 
 
 -- | Type-alias for signature readability
@@ -225,10 +232,24 @@ usExtensionsV3 purpose subDN issDN =
 svExtensionsV3 :: DistinguishedName -> DistinguishedName -> NonEmpty String -> [ExtensionRaw]
 svExtensionsV3 subDN issDN altNames =
     let
-        subjectAltName = ExtSubjectAltName (AltNameDNS <$> NonEmpty.toList altNames)
+        subjectAltName = ExtSubjectAltName ( parseAltName <$> NonEmpty.toList altNames)
     in
         extensionEncode False subjectAltName : usExtensionsV3 KeyUsagePurpose_ServerAuth subDN issDN
 
+parseAltName :: String -> AltName
+parseAltName name = do
+    let
+        ipv4ToByteString :: IPv4 -> ByteString
+        ipv4ToByteString (IPv4 bytes) = encodeWord32 bytes
+        ipv6ToByteString :: IPv6 -> ByteString
+        ipv6ToByteString ipv6 = LBS.toStrict (BS.toLazyByteString $ ipv6ByteStringBuilder ipv6)
+        ipv6ByteStringBuilder :: IPv6 -> BS.Builder
+        ipv6ByteStringBuilder (IPv6 parta partb) = BS.word64BE parta <> BS.word64BE partb
+
+        go :: Maybe IP -> AltName
+        go (Just address) = AltNameIP $ case_ ipv4ToByteString ipv6ToByteString address
+        go Nothing = AltNameDNS name
+    go $ decode $ T.pack name
 
 clExtensionsV3 :: DistinguishedName -> DistinguishedName -> [ExtensionRaw]
 clExtensionsV3 =