lib: parse bracketed IPv6 server addresses (#1807)

* Parse bracketed IPv6 server hosts

* lib: parse service-scheme and invitation hosts via TransportHost

* correct encoding

* encoding

---------

Co-authored-by: Paul Bottinelli <paul.bottinelli@trailofbits.com>
Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>

src/Simplex/Messaging/ServiceScheme.hs

@@ -11,8 +11,9 @@ import Control.Applicative ((<|>))
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import qualified Data.ByteString.Char8 as B
 import Data.Functor (($>))
-import Network.Socket (HostName, ServiceName)
+import Network.Socket (ServiceName)
 import Simplex.Messaging.Encoding.String (StrEncoding (..))
+import Simplex.Messaging.Transport.Client (TransportHost (..))
 
 data ServiceScheme = SSSimplex | SSAppServer SrvLoc
   deriving (Eq, Show)
@@ -25,14 +26,19 @@ instance StrEncoding ServiceScheme where
     "simplex:" $> SSSimplex
       <|> "https://" *> (SSAppServer <$> strP)
 
-data SrvLoc = SrvLoc HostName ServiceName
+data SrvLoc = SrvLoc TransportHost ServiceName
   deriving (Eq, Ord, Show)
 
 instance StrEncoding SrvLoc where
-  strEncode (SrvLoc host port) = B.pack $ host <> if null port then "" else ':' : port
-  strP = SrvLoc <$> host <*> (port <|> pure "")
+  strEncode (SrvLoc host port)
+    | null port = strEncode host
+    | otherwise = h <> B.pack (':' : port)
+    where
+      h = case host of
+        THIPv6 _ -> ('[' `B.cons` strEncode host) `B.snoc` ']'
+        _ -> strEncode host
+  strP = SrvLoc <$> strP <*> (port <|> pure "")
     where
-      host = B.unpack <$> A.takeWhile1 (A.notInClass ":#,;/ ")
       port = show <$> (A.char ':' *> (A.decimal :: A.Parser Int))
 
 simplexChat :: ServiceScheme

src/Simplex/Messaging/Transport/Client.hs

@@ -89,7 +89,7 @@ instance StrEncoding TransportHost where
       [ THIPv4 <$> ((,,,) <$> ipNum <*> ipNum <*> ipNum <*> A.decimal),
         maybe (Left "bad IPv6") (Right . THIPv6 . fromIPv6w) . readMaybe . B.unpack <$?> ipv6StrP,
         THOnionHost <$> ((<>) <$> A.takeWhile (\c -> isAsciiLower c || isDigit c) <*> A.string ".onion"),
-        THDomainName . B.unpack <$> (notOnion <$?> A.takeWhile1 (A.notInClass ":#,;/ \n\r\t"))
+        THDomainName . B.unpack <$> (notOnion <$?> A.takeWhile1 (A.notInClass ":#,;/ \n\r\t[]"))
       ]
     where
       ipNum = validIP <$?> (A.decimal <* A.char '.')

src/Simplex/RemoteControl/Invitation.hs

@@ -81,7 +81,7 @@ instance StrEncoding RCInvitation where
     _ <- A.string "xrcp:/"
     ca <- strP
     _ <- A.char '@'
-    host <- A.takeWhile (/= ':') >>= either fail pure . strDecode . urlDecode True
+    host <- strP
     _ <- A.char ':'
     port <- strP
     _ <- A.string "#/?"

tests/CoreTests/EncodingTests.hs

@@ -10,11 +10,14 @@ import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.ByteString.Internal (w2c)
 import Data.Int (Int64)
+import Data.List.NonEmpty (NonEmpty (..))
 import Data.Time.Clock.System (SystemTime (..), getSystemTime, utcToSystemTime)
 import Data.Time.ISO8601 (parseISO8601)
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (parseAll)
+import Simplex.Messaging.Protocol (ProtocolServer (..), XFTPServer)
+import Simplex.Messaging.ServiceScheme (ServiceScheme (..), SrvLoc (..))
 import Simplex.Messaging.Transport.Client (TransportHost (..))
 import Test.Hspec hiding (fit, it)
 import Test.Hspec.QuickCheck (modifyMaxSuccess)
@@ -67,7 +70,29 @@ encodingTests = modifyMaxSuccess (const 1000) $ do
         THDomainName "192.256.0.1" #==# "192.256.0.1"
         THDomainName "192.168.0.-1" #==# "192.168.0.-1"
         shouldNotParse @TransportHost "192.168.0.0.1" "endOfInput"
+        -- brackets are reserved for IPv6 literals
+        shouldReject @TransportHost "[simplex.chat]"
+        shouldReject @TransportHost "[smp.simplex.im]"
+  describe "Encoding service locations" $ do
+    it "should parse bracketed IPv6 host with port" $ do
+      strDecode @ServiceScheme "https://[2001:db8::1]:8443"
+        `shouldBe` Right (SSAppServer $ SrvLoc "2001:db8::1" "8443")
+      strEncode (SSAppServer $ SrvLoc "2001:db8::1" "8443")
+        `shouldBe` "https://[2001:db8::1]:8443"
+    it "should reject bracketed non-IPv6 host" $
+      shouldReject @ServiceScheme "https://[simplex.chat]:8443"
+  describe "Encoding protocol servers" $ do
+    it "should parse bracketed IPv6 server host with port" $
+      case strDecode @XFTPServer "xftp://1234-w==@[2001:db8::1]:443" of
+        Left err -> expectationFailure err
+        Right (ProtocolServer _ parsedHost parsedPort _) -> do
+          parsedHost `shouldBe` (ipv6Host :| [])
+          parsedPort `shouldBe` "443"
+    it "should reject bracketed non-IPv6 server host" $
+      shouldReject @XFTPServer "xftp://1234-w==@[simplex.chat]:443"
   where
+    ipv6Host :: TransportHost
+    ipv6Host = either error id $ strDecode "2001:db8::1"
     testSystemTime :: SystemTime -> Expectation
     testSystemTime t = do
       smpEncode t `shouldBe` smpEncode (systemSeconds t)
@@ -78,3 +103,7 @@ encodingTests = modifyMaxSuccess (const 1000) $ do
       strDecode s `shouldBe` Right x
     shouldNotParse :: forall s. (StrEncoding s, Eq s, Show s) => ByteString -> String -> Expectation
     shouldNotParse s err = strDecode s `shouldBe` (Left err :: Either String s)
+    shouldReject :: forall s. (StrEncoding s, Show s) => ByteString -> Expectation
+    shouldReject s = case strDecode s :: Either String s of
+      Left _ -> pure ()
+      Right a -> expectationFailure $ "expected parse failure, got " <> show a

tests/RemoteControl.hs

@@ -1,7 +1,9 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications #-}
 
 module RemoteControl where
 
@@ -9,15 +11,23 @@ import AgentTests.FunctionalAPITests (runRight)
 import Control.Logger.Simple
 import Crypto.Random (ChaChaDRG)
 import qualified Data.Aeson as J
+import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
+import Data.List (stripPrefix)
 import Data.List.NonEmpty (NonEmpty (..))
+import Data.Time.Clock.System (SystemTime (..))
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String (StrEncoding (..))
 import Simplex.Messaging.Transport (TSbChainKeys (..))
+import Simplex.Messaging.Transport.Client (TransportHost)
 import qualified Simplex.RemoteControl.Client as HC (RCHostClient (action))
 import qualified Simplex.RemoteControl.Client as RC
 import Simplex.RemoteControl.Discovery (mkLastLocalHost, preferAddress)
-import Simplex.RemoteControl.Invitation (RCSignedInvitation, verifySignedInvitation)
+import Simplex.RemoteControl.Invitation
+  ( RCInvitation (..),
+    RCSignedInvitation,
+    verifySignedInvitation,
+  )
 import Simplex.RemoteControl.Types
 import Test.Hspec hiding (fit, it)
 import UnliftIO
@@ -27,6 +37,9 @@ import Util
 remoteControlTests :: Spec
 remoteControlTests = do
   describe "preferred bindings should go first" testPreferAddress
+  describe "Invitation parsing" $ do
+    it "should parse bracketed IPv6 host with port" testInvitationBracketedIPv6Host
+    it "should reject bracketed non-IPv6 host" testInvitationBracketedNonIPv6HostRejected
   describe "New controller/host pairing" $ do
     it "should connect to new pairing" testNewPairing
     it "should connect to existing pairing" testExistingPairing
@@ -65,6 +78,57 @@ testPreferAddress = do
     addrsDups = "10.20.30.40" `on` "eth1" : addrs'
     ifaceDups = "10.20.30.41" `on` "eth0" : addrs'
 
+testInvitationBracketedIPv6Host :: IO ()
+testInvitationBracketedIPv6Host = do
+  invitation <- testIPv6Invitation
+  let bracketedUri =
+        B.pack . replaceFirst "@2001:db8::1:" "@[2001:db8::1]:" . B.unpack $
+          strEncode invitation
+      expectedHost = either error id (strDecode "2001:db8::1") :: TransportHost
+  case strDecode bracketedUri of
+    Left err -> expectationFailure err
+    Right RCInvitation {host, port} -> do
+      host `shouldBe` expectedHost
+      port `shouldBe` 5223
+
+testInvitationBracketedNonIPv6HostRejected :: IO ()
+testInvitationBracketedNonIPv6HostRejected = do
+  invitation <- testIPv6Invitation
+  let bracketedUri =
+        B.pack . replaceFirst "@2001:db8::1:" "@[simplex.chat]:" . B.unpack $
+          strEncode invitation
+  case strDecode bracketedUri :: Either String RCInvitation of
+    Left _ -> pure ()
+    Right _ -> expectationFailure "expected parse failure for bracketed non-IPv6 host"
+
+replaceFirst :: String -> String -> String -> String
+replaceFirst needle replacement = go
+  where
+    go [] = []
+    go input@(c : cs) =
+      case stripPrefix needle input of
+        Just rest -> replacement <> rest
+        Nothing -> c : go cs
+
+testIPv6Invitation :: IO RCInvitation
+testIPv6Invitation = do
+  drg <- C.newRandom
+  (skey, _) <- atomically $ C.generateKeyPair @'C.Ed25519 drg
+  (idkey, _) <- atomically $ C.generateKeyPair @'C.Ed25519 drg
+  (dh, _) <- atomically $ C.generateKeyPair @'C.X25519 drg
+  pure
+    RCInvitation
+      { ca = C.KeyHash "test-ca",
+        host = either error id $ strDecode "2001:db8::1",
+        port = 5223,
+        v = supportedRCPVRange,
+        app = J.String "app",
+        ts = MkSystemTime 0 0,
+        skey,
+        idkey,
+        dh
+      }
+
 testNewPairing :: IO ()
 testNewPairing = do
   drg <- C.newRandom

xftp-web/src/protocol/address.ts

@@ -35,6 +35,22 @@ export function parseXFTPServer(address: string): XFTPServer {
   const hostPart = m[2]
   // Take the first host (before any comma), then split port from that
   const firstHost = hostPart.split(',')[0]
+  return {keyHash, ...parseHostPort(firstHost)}
+}
+
+function parseHostPort(firstHost: string): Pick<XFTPServer, "host" | "port"> {
+  if (firstHost.length === 0) throw new Error("parseXFTPServer: missing host")
+  if (firstHost.startsWith('[')) {
+    const bracketEnd = firstHost.indexOf(']')
+    if (bracketEnd < 0) throw new Error("parseXFTPServer: invalid bracketed host")
+    const host = firstHost.substring(0, bracketEnd + 1)
+    const rest = firstHost.substring(bracketEnd + 1)
+    if (rest.length === 0) return {host, port: "443"}
+    if (!rest.startsWith(':')) throw new Error("parseXFTPServer: invalid bracketed host")
+    const port = rest.substring(1)
+    if (port.length === 0) throw new Error("parseXFTPServer: missing port")
+    return {host, port}
+  }
   const colonIdx = firstHost.lastIndexOf(':')
   let host: string
   let port: string
@@ -45,7 +61,7 @@ export function parseXFTPServer(address: string): XFTPServer {
     host = firstHost
     port = "443"
   }
-  return {keyHash, host, port}
+  return {host, port}
 }
 
 // Format an XFTPServer back to its URI string representation.

xftp-web/test/address.node.test.ts

@@ -0,0 +1,21 @@
+import {expect, test} from 'vitest'
+import {formatXFTPServer, parseXFTPServer, serverOrigin} from '../src/protocol/address.js'
+
+const keyHash = 'LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI='
+
+test('parseXFTPServer supports bracketed IPv6 hosts with ports', () => {
+  const server = parseXFTPServer(`xftp://${keyHash}@[2001:db8::1]:8443,example.com`)
+
+  expect(server.host).toBe('[2001:db8::1]')
+  expect(server.port).toBe('8443')
+  expect(serverOrigin(server)).toBe('https://[2001:db8::1]:8443')
+  expect(formatXFTPServer(server)).toBe(`xftp://${keyHash}@[2001:db8::1]:8443`)
+})
+
+test('parseXFTPServer uses the default port for bracketed IPv6 hosts', () => {
+  const server = parseXFTPServer(`xftp://${keyHash}@[2001:db8::1]`)
+
+  expect(server.host).toBe('[2001:db8::1]')
+  expect(server.port).toBe('443')
+  expect(serverOrigin(server)).toBe('https://[2001:db8::1]')
+})