From d17c915df3fe9f2be60da8eb98feb013422380e0 Mon Sep 17 00:00:00 2001
From: KtorZ <matthias.benkort@gmail.com>
Date: Mon, 24 Sep 2018 17:08:47 +0200
Subject: [PATCH] [CO-389] Patch x509 parseSAN function to encode IP to valid
 bytes

Turns out that we can't use the 'encode' function from Net.IP as it generates
invalid encoding for x509. I left a NOTE explaining what's going on such that
next readers will know what's going on.
---
 x509/cardano-sl-x509.cabal  |  1 +
 x509/src/Data/X509/Extra.hs | 34 ++++++++++++++++++++++++++++++----
 2 files changed, 31 insertions(+), 4 deletions(-)

diff --git a/x509/cardano-sl-x509.cabal b/x509/cardano-sl-x509.cabal
index 71477627bf7..00bf7145242 100644
--- a/x509/cardano-sl-x509.cabal
+++ b/x509/cardano-sl-x509.cabal
@@ -34,6 +34,7 @@ library
                , filepath
                , hourglass
                , ip
+               , network-transport
                , optparse-applicative
                , text
                , universum
diff --git a/x509/src/Data/X509/Extra.hs b/x509/src/Data/X509/Extra.hs
index a1171985806..4570cf0914c 100644
--- a/x509/src/Data/X509/Extra.hs
+++ b/x509/src/Data/X509/Extra.hs
@@ -47,17 +47,19 @@ import           Data.X509.CertificateStore (CertificateStore,
                      makeCertificateStore)
 import           Data.X509.Validation
 import           Net.IP (IP)
+import           Net.IPv4 (IPv4 (..))
+import           Net.IPv6 (IPv6 (..))
+import           Network.Transport.Internal (encodeWord32)
 
 import qualified Crypto.PubKey.RSA.Types as RSA
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Base64 as Base64
+import qualified Data.ByteString.Builder as BS
 import qualified Data.ByteString.Char8 as B8
 import qualified Data.ByteString.Lazy as BL
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 import qualified Net.IP as IP
-import qualified Net.IPv4 as IPv4
-import qualified Net.IPv6 as IPv6
 
 
 --
@@ -175,10 +177,34 @@ parseSAN :: String -> AltName
 parseSAN name =
     case IP.decode (toText name) of
         Just ip ->
-            AltNameIP . T.encodeUtf8 $ IP.case_ IPv4.encode IPv6.encode ip
+            AltNameIP $ IP.case_ ipv4ToBS ipv6ToBS ip
 
         Nothing ->
             AltNameDNS name
+  where
+    -- NOTE
+    -- Here, we define custom encoding functions and aren't using the ones
+    -- defined in `Net.IP`, `Net.IPv4` or `Net.IPv6`.
+    -- Those methods lead to invalid encodings for the underlying x509 certificates.
+    --
+    -- From the RFC 3779 (https://datatracker.ietf.org/doc/rfc3779):
+    --
+    -- > IP v4 address - a 32-bit identifier written as four decimal numbers,
+    -- >    each in the range 0 to 255, separated by a ".".  10.5.0.5 is an
+    -- >    example of an IPv4 address.
+    -- >
+    -- > IP v6 address - a 128-bit identifier written as eight hexadecimal
+    -- >    quantities, each in the range 0 to ffff, separated by a ":".
+    -- >    2001:0:200:3:0:0:0:1 is an example of an IPv6 address.  One string
+    -- >    of :0: fields may be replaced by "::", thus 2001:0:200:3::1
+    -- >    represents the same address as the immediately preceding example.
+    ipv4ToBS :: IPv4 -> ByteString
+    ipv4ToBS (IPv4 bytes) =
+        encodeWord32 bytes
+
+    ipv6ToBS :: IPv6 -> ByteString
+    ipv6ToBS (IPv6 a b) =
+        BL.toStrict $ BS.toLazyByteString (BS.word64BE a <> BS.word64BE b)
 
 
 --
@@ -282,7 +308,7 @@ validateCertificateIP ip cert =
         toCommonName =
             asn1CharacterToString >=> (ipFromBytes . B8.pack)
     in
-        if any (== ip) (maybeToList commonName ++ altNames) then
+        if ip `elem` (maybeToList commonName ++ altNames) then
             []
         else
             [NameMismatch $ T.unpack $ IP.encode ip]