From f07d098403bb1c4402f6996bdfe3022e741dbf57 Mon Sep 17 00:00:00 2001 From: shum Date: Wed, 21 Oct 2026 22:45:49 +0000 Subject: [PATCH] store: check name link kinds and hosts --- .../src/StoreService/Names/Links.hs | 56 ++++++++++++ simplex-chat.cabal | 3 + tests/Bots/StoreService/NamesLinksTests.hs | 86 +++++++++++++++++++ tests/Test.hs | 2 + 4 files changed, 147 insertions(+) create mode 100644 apps/simplex-store-service/src/StoreService/Names/Links.hs create mode 100644 tests/Bots/StoreService/NamesLinksTests.hs diff --git a/apps/simplex-store-service/src/StoreService/Names/Links.hs b/apps/simplex-store-service/src/StoreService/Names/Links.hs new file mode 100644 index 0000000000..1c6703b588 --- /dev/null +++ b/apps/simplex-store-service/src/StoreService/Names/Links.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} + +module StoreService.Names.Links + ( LinkKind (..), + linkMaxBytes, + linkKindOf, + linkHosts, + ) +where + +import Control.Applicative (optional, (<|>)) +import Data.Attoparsec.Text (Parser) +import qualified Data.Attoparsec.Text as A +import qualified Data.ByteString as B +import Data.Char (isAsciiLower, isAsciiUpper, isDigit) +import qualified Data.List.NonEmpty as L +import Data.Text (Text) +import Data.Text.Encoding (encodeUtf8) +import Simplex.Messaging.Agent.Protocol (ConnShortLink (..), ConnectionMode (..)) +import Simplex.Messaging.Encoding.String (StrEncoding (..)) +import Simplex.Messaging.Protocol (ProtocolServer (..)) +import Simplex.Messaging.Transport.Client (TransportHost) + +data LinkKind = LKContact | LKChannel + deriving (Eq, Show) + +linkMaxBytes :: Int +linkMaxBytes = 4096 + +-- the page's rule for one short link, so both refuse the same links +linkKindOf :: Text -> Maybe LinkKind +linkKindOf link + | B.length (encodeUtf8 link) > linkMaxBytes = Nothing + | otherwise = either (const Nothing) Just $ A.parseOnly (shortLinkP <* A.endOfInput) link + +shortLinkP :: Parser LinkKind +shortLinkP = do + _ <- ("https://" *> A.takeWhile1 hostChar *> "/") <|> "simplex:/" + kind <- (LKContact <$ A.char 'a') <|> (LKChannel <$ A.char 'c') + _ <- A.char '#' *> A.takeWhile1 keyChar + _ <- optional $ A.char '?' *> A.takeWhile queryChar + pure kind + where + hostChar c = isAsciiLower c || isDigit c || c == '.' || c == '-' + keyChar c = isAsciiLower c || isAsciiUpper c || isDigit c || c == '_' || c == '-' + queryChar c = keyChar c || c == '=' || c == '&' || c == '.' + +-- the hosts as the chat core reads them, empty for a link it cannot read +linkHosts :: Text -> [TransportHost] +linkHosts = either (const []) hosts . strDecode . encodeUtf8 + where + hosts :: ConnShortLink 'CMContact -> [TransportHost] + hosts (CSLContact _ _ ProtocolServer {host} _) = L.toList host diff --git a/simplex-chat.cabal b/simplex-chat.cabal index b7d05448d7..58a906102d 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -446,6 +446,7 @@ executable simplex-store-service StoreService.Names.Chain StoreService.Names.Env StoreService.Names.Label + StoreService.Names.Links StoreService.Names.Phases StoreService.Names.Registration StoreService.Names.Signatures @@ -749,6 +750,7 @@ test-suite simplex-chat-test Bots.StoreService.GroupTests Bots.StoreService.NameRegistrationTests Bots.StoreService.NamesLabelTests + Bots.StoreService.NamesLinksTests Bots.StoreService.NamesSignatureTests Bots.StoreService.NamesWiringTests Bots.StoreService.StripeTests @@ -776,6 +778,7 @@ test-suite simplex-chat-test StoreService.Names.Chain StoreService.Names.Env StoreService.Names.Label + StoreService.Names.Links StoreService.Names.Phases StoreService.Names.Registration StoreService.Names.Signatures diff --git a/tests/Bots/StoreService/NamesLinksTests.hs b/tests/Bots/StoreService/NamesLinksTests.hs new file mode 100644 index 0000000000..25f02d46c6 --- /dev/null +++ b/tests/Bots/StoreService/NamesLinksTests.hs @@ -0,0 +1,86 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Bots.StoreService.NamesLinksTests (namesLinksTests) where + +import Data.ByteString (ByteString) +import Data.Text (Text) +import qualified Data.Text as T +import Simplex.Messaging.Transport.Client (TransportHost (..)) +import StoreService.Names.Links +import Test.Hspec + +namesLinksTests :: Spec +namesLinksTests = describe "StoreService names: links" $ do + describe "kinds" $ do + it "accepts the page's short links of each kind" $ do + linkKindOf pageContact `shouldBe` Just LKContact + linkKindOf pageChannel `shouldBe` Just LKChannel + linkKindOf "https://smp9.simplex.im/c#Rk27xN4pDe9Tz1Wb3Yc5Vd7Xf9Hg2Jk4Lm" `shouldBe` Just LKChannel + linkKindOf "https://smp8.simplex.im/a#x" `shouldBe` Just LKContact + linkKindOf "simplex:/a#lrdvu2d8A1GumSmoKb2krQmtKhWXq-tyGpHuM7aMwsw?h=smp6.simplex.im" `shouldBe` Just LKContact + linkKindOf "https://localhost/a#4AkRDmhf64tdRlN406g8lJRg5OCmhD6ynIhi6glOcCM?p=7001&c=LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI" `shouldBe` Just LKContact + linkKindOf "https://1.2.3.4/c#MDEyMzQ1Njc4OWFiY2RlZjAxMjM0NTY3ODlhYmNkZWY" `shouldBe` Just LKChannel + it "refuses full links, two links joined, other link types and anything else" $ do + mapM_ + refused + [ "https://simplex.chat/contact#/?v=2&smp=smp%3A%2F%2Fabc", + pageContact <> ";" <> pageContact, + "hello", + "", + "https://smp8.simplex.im/g#MDEyMzQ1Njc4OWFiY2RlZjAxMjM0NTY3ODlhYmNkZWY", + "https://smp8.simplex.im/i#MDEyMzQ1Njc4OWFiY2RlZjAxMjM0NTY3/MDEyMzQ1Njc4OWFiY2RlZjAxMjM0NTY3ODlhYmNkZWY", + "simplex:/g#MDEyMzQ1Njc4OWFiY2RlZjAxMjM0NTY3ODlhYmNkZWY?h=smp.simplex.im", + "http://smp8.simplex.im/a#Y8m3qT0vLw2Ab7cD9eF1gH3jK5mN7pQ9rS", + "https://SMP8.simplex.im/a#Y8m3qT0vLw2Ab7cD9eF1gH3jK5mN7pQ9rS", + "https://smp8.simplex.im/a/#Y8m3qT0vLw2Ab7cD9eF1gH3jK5mN7pQ9rS", + "https://smp8.simplex.im/a#", + "https:///a#Y8m3qT0vLw2Ab7cD9eF1gH3jK5mN7pQ9rS", + "simplex:/a#Y8m3qT0vLw2Ab7cD9eF1gH3jK5mN7pQ9rS=", + " " <> pageContact, + pageContact <> "\n", + pageContact <> " ", + pageContact <> "?x=é" + ] + it "refuses a link with several hosts, as the page does" $ + linkKindOf multiHostContact `shouldBe` Nothing + it "accepts a link of exactly the bound and refuses one byte over it" $ do + let atBound = padded linkMaxBytes + T.length atBound `shouldBe` linkMaxBytes + linkKindOf atBound `shouldBe` Just LKContact + linkKindOf (padded $ linkMaxBytes + 1) `shouldBe` Nothing + describe "hosts" $ do + it "reads the authority of an https link" $ + linkHosts presetContact `shouldBe` [THDomainName "smp6.simplex.im"] + it "reads an IP literal authority" $ + linkHosts "https://1.2.3.4/c#MDEyMzQ1Njc4OWFiY2RlZjAxMjM0NTY3ODlhYmNkZWY" `shouldBe` [THIPv4 (1, 2, 3, 4)] + it "reads the authority and the extra hosts of an https link" $ + linkHosts "https://smp.simplex.im/a#MDEyMzQ1Njc4OWFiY2RlZjAxMjM0NTY3ODlhYmNkZWY?h=jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion&p=5223&c=1234-w" + `shouldBe` [THDomainName "smp.simplex.im", THOnionHost onionHost] + it "reads the one server host of a simplex link" $ + linkHosts "simplex:/a#lrdvu2d8A1GumSmoKb2krQmtKhWXq-tyGpHuM7aMwsw?h=smp6.simplex.im" `shouldBe` [THDomainName "smp6.simplex.im"] + it "reads every server host of a simplex link" $ + linkHosts multiHostContact `shouldBe` [THDomainName "smp.simplex.im", THOnionHost onionHost] + it "reads the hosts of a channel link" $ + linkHosts "simplex:/c#AQIDBAUGBwgBAgMEBQYHCAECAwQFBgcIAQIDBAUGBwg?h=smp.simplex.im&p=5223&c=1234-w" `shouldBe` [THDomainName "smp.simplex.im"] + it "has no hosts for a link the chat core cannot read" $ do + linkHosts pageChannel `shouldBe` [] + linkHosts "https://simplex.chat/contact#/?v=2&smp=smp%3A%2F%2Fabc" `shouldBe` [] + linkHosts "hello" `shouldBe` [] + where + refused l = (l, linkKindOf l) `shouldBe` (l, Nothing) + padded n = let base = presetContact <> "?x=" in base <> T.replicate (n - T.length base) "a" + +pageContact :: Text +pageContact = "https://smp8.simplex.im/a#Y8m3qT0vLw2Ab7cD9eF1gH3jK5mN7pQ9rS" + +pageChannel :: Text +pageChannel = "simplex:/c#Rk27xN4pDe9Tz1Wb3Yc5Vd7Xf9Hg2Jk4Lm?v=1" + +presetContact :: Text +presetContact = "https://smp6.simplex.im/a#lrdvu2d8A1GumSmoKb2krQmtKhWXq-tyGpHuM7aMwsw" + +multiHostContact :: Text +multiHostContact = "simplex:/a#MDEyMzQ1Njc4OWFiY2RlZjAxMjM0NTY3ODlhYmNkZWY?h=smp.simplex.im%2Cjjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion&p=5223&c=1234-w" + +onionHost :: ByteString +onionHost = "jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion" diff --git a/tests/Test.hs b/tests/Test.hs index 0c511ed3ed..805e22a3c7 100644 --- a/tests/Test.hs +++ b/tests/Test.hs @@ -11,6 +11,7 @@ import Bots.StoreService.GroupIntegrationTests import Bots.StoreService.GroupTests import Bots.StoreService.NameRegistrationTests import Bots.StoreService.NamesLabelTests +import Bots.StoreService.NamesLinksTests import Bots.StoreService.NamesSignatureTests import Bots.StoreService.NamesWiringTests import Bots.StoreService.StripeTests @@ -91,6 +92,7 @@ main = do badgeNameRegistrationTests namesConfigTests namesLabelTests + namesLinksTests namesSignatureTests namesWiringTests describe "SimpleX chat markdown" markdownTests