From 0ce58d6f9e5eb4c46d682ecf4c85804bbd1f1a0a Mon Sep 17 00:00:00 2001 From: Bram van den Heuvel Date: Wed, 10 Jan 2024 10:02:14 +0100 Subject: [PATCH 01/14] Add grammer definition --- elm.json | 1 + src/Internal/Tools/Grammar.elm | 74 ++++++++++++++++++++++++++++++++++ 2 files changed, 75 insertions(+) create mode 100644 src/Internal/Tools/Grammar.elm diff --git a/elm.json b/elm.json index 78baf2d..6b8e2db 100644 --- a/elm.json +++ b/elm.json @@ -13,6 +13,7 @@ "dependencies": { "elm/core": "1.0.0 <= v < 2.0.0", "elm/json": "1.0.0 <= v < 2.0.0", + "elm/parser": "1.0.0 <= v < 2.0.0", "elm/time": "1.0.0 <= v < 2.0.0", "miniBill/elm-fast-dict": "1.0.0 <= v < 2.0.0" }, diff --git a/src/Internal/Tools/Grammar.elm b/src/Internal/Tools/Grammar.elm new file mode 100644 index 0000000..85db0d4 --- /dev/null +++ b/src/Internal/Tools/Grammar.elm @@ -0,0 +1,74 @@ +module Internal.Tools.Grammar exposing (..) + +{-| + + +# Identifier Grammar + +The specification defines +[some identifiers](https://spec.matrix.org/v1.9/appendices/#identifier-grammar) +to use the Common Namespaced Identifier Grammar. This is a common grammar +intended for non-user-visible identifiers, with a defined mechanism for +implementations to create new identifiers. + +This module documents those identifiers, allowing the Elm SDK to use them. + +-} + +import Parser as P exposing (Parser) + + +{-| Parse an IPv6 address +-} +ipv6addressParser : Parser String +ipv6addressParser = + P.chompWhile validIPv6Char + |> P.getChompedString + |> P.andThen + (\out -> + if String.length out > 45 then + P.problem "an ipv6 address has no more than 45 digits" + + else if String.length out < 2 then + P.problem "an ipv6 address has at least 2 digits" + + else + -- TODO: ipv6 has more specific rules + -- https://datatracker.ietf.org/doc/html/rfc3513#section-2.2 + P.succeed out + ) + + +{-| Parse a port value +-} +portParser : Parser Int +portParser = + P.chompWhile Char.isDigit + |> P.getChompedString + |> P.andThen + (\out -> + if String.length out > 5 then + P.problem "a port has no more than 5 digits" + + else if String.length out < 1 then + P.problem "a port has at least 1 digit" + + else + case String.toInt out of + Nothing -> + P.problem "Expected port int" + + Just i -> + P.succeed i + ) + + +{-| Check whether a char is a valid IPv6char +-} +validIPv6char : Char -> Bool + + +validIPv6Char c = + "0123456789ABCDEFabcdef:." + |> String.toList + |> List.member c From 43f0ac5ef2cf38e0d0aaeec8aa24f07f8a7bdac3 Mon Sep 17 00:00:00 2001 From: Bram Date: Mon, 25 Mar 2024 10:07:47 +0100 Subject: [PATCH 02/14] Add server name specified fuzzers --- tests/Test/Values/Server.elm | 127 +++++++++++++++++++++++++++++++++++ 1 file changed, 127 insertions(+) create mode 100644 tests/Test/Values/Server.elm diff --git a/tests/Test/Values/Server.elm b/tests/Test/Values/Server.elm new file mode 100644 index 0000000..519f4e2 --- /dev/null +++ b/tests/Test/Values/Server.elm @@ -0,0 +1,127 @@ +module Test.Values.Server exposing (..) + +import Test exposing (..) +import Fuzz exposing (Fuzzer) +import Expect + +digits : String +digits = "0123456789" + +alpha : String +alpha = "abcdefghijklmnopqrstuvwxyz" + +hex : String +hex = "0123456789abcdef" + +dns : String +dns = + digits ++ alpha ++ (String.toUpper alpha) ++ "-." + +dnsCharFuzzer : Fuzzer Char +dnsCharFuzzer = + dns + |> String.toList + |> Fuzz.oneOfValues + +dnsNameFuzzer : Fuzzer String +dnsNameFuzzer = + dnsCharFuzzer + |> Fuzz.listOfLengthBetween 1 255 + |> Fuzz.map String.fromList + +byteNumFuzzer : Fuzzer String +byteNumFuzzer = + Fuzz.intRange 0 255 + |> Fuzz.map String.fromInt + +portFuzzer : Fuzzer String +portFuzzer = + Fuzz.intRange 0 (2^16 - 1) + |> Fuzz.map String.fromInt + +ipv4Fuzzer : Fuzzer String +ipv4Fuzzer = + Fuzz.map4 + (\a b c d -> + [ a, b, c, d ] + |> List.intersperse "." + |> String.concat + ) + byteNumFuzzer + byteNumFuzzer + byteNumFuzzer + byteNumFuzzer + +ipv6CharFuzzer : Fuzzer Char +ipv6CharFuzzer = + hex + |> String.toList + |> Fuzz.oneOfValues + +ipv6PartFuzzer : Fuzzer String +ipv6PartFuzzer = + ipv6CharFuzzer + |> Fuzz.listOfLengthBetween 1 4 + |> Fuzz.map String.fromList + +ipv6Sides : Fuzzer (Int, Int) +ipv6Sides = + Fuzz.intRange 0 7 + |> Fuzz.andThen + (\a -> + Fuzz.intRange 0 (7-a) + |> Fuzz.map (\b -> (a, b)) + ) + +ipv6Fuzzer : Fuzzer String +ipv6Fuzzer = + Fuzz.oneOf + [ ipv6PartFuzzer + |> Fuzz.listOfLength 8 + |> Fuzz.map (List.intersperse ":") + |> Fuzz.map String.concat + , ipv6Sides + |> Fuzz.andThen + (\(a, b) -> + Fuzz.pair + (Fuzz.listOfLength a ipv6PartFuzzer) + (Fuzz.listOfLength b ipv6PartFuzzer) + ) + |> Fuzz.map + (\(la, lb) -> + [ List.intersperse ":" la + , [ "::" ] + , List.intersperse ":" lb + ] + |> List.concat + |> String.concat + ) + ] + +hostnameFuzzer : Fuzzer String +hostnameFuzzer = + Fuzz.oneOf + [ ipv4Fuzzer + , Fuzz.map (\ip -> "[" ++ ip ++ "]") ipv6Fuzzer + , dnsNameFuzzer + ] + +serverNameFuzzer : Fuzzer String +serverNameFuzzer = + Fuzz.map2 (++) + hostnameFuzzer + ( Fuzz.oneOf + [ Fuzz.constant "" + , Fuzz.map (\p -> ":" ++ p) portFuzzer + ] + ) + |> Fuzz.map (Debug.log "Server") + +suite : Test +suite = + describe "Server name tester" + [ fuzz serverNameFuzzer "IPv6 test" + (\_ -> + Expect.pass + ) + ] \ No newline at end of file From d68de7f2fbecbfb3ff3c9a224b3fb13e43f5526e Mon Sep 17 00:00:00 2001 From: Bram Date: Fri, 29 Mar 2024 07:13:06 +0100 Subject: [PATCH 03/14] Add parser helper functions --- elm.json | 1 + src/Internal/Tools/ParserExtra.elm | 77 ++++++++++++++++++++++++++++++ 2 files changed, 78 insertions(+) create mode 100644 src/Internal/Tools/ParserExtra.elm diff --git a/elm.json b/elm.json index 66e87bf..1c32573 100644 --- a/elm.json +++ b/elm.json @@ -13,6 +13,7 @@ "dependencies": { "elm/core": "1.0.0 <= v < 2.0.0", "elm/json": "1.0.0 <= v < 2.0.0", + "elm/parser": "1.0.0 <= v < 2.0.0", "elm/time": "1.0.0 <= v < 2.0.0", "miniBill/elm-fast-dict": "1.0.0 <= v < 2.0.0" }, diff --git a/src/Internal/Tools/ParserExtra.elm b/src/Internal/Tools/ParserExtra.elm new file mode 100644 index 0000000..0148b3b --- /dev/null +++ b/src/Internal/Tools/ParserExtra.elm @@ -0,0 +1,77 @@ +module Internal.Tools.ParserExtra exposing (..) + +import Parser as P exposing (Parser, (|.), (|=)) + +zeroOrMore : Parser a -> Parser (List a) +zeroOrMore parser = + P.loop [] + (\tail -> + P.oneOf + [ P.succeed (\head -> P.Loop (head :: tail)) + |= parser + , P.succeed (P.Done (List.reverse tail)) + ] + ) + +oneOrMore : Parser a -> Parser (List a) +oneOrMore parser = + P.succeed (::) + |= parser + |= zeroOrMore parser + +atLeast : Int -> Parser a -> Parser (List a) +atLeast n parser = + P.loop [] + (\tail -> + if List.length tail < n then + P.succeed (\head -> P.Loop (head :: tail)) + |= parser + else + P.oneOf + [ P.succeed (\head -> P.Loop (head :: tail)) + |= parser + , P.succeed (P.Done (List.reverse tail)) + ] + ) + +atMost : Int -> Parser a -> Parser (List a) +atMost n parser = + P.loop [] + (\tail -> + if List.length tail < n then + P.oneOf + [ P.succeed (\head -> P.Loop (head :: tail)) + |= parser + , P.succeed (P.Done (List.reverse tail)) + ] + else + P.succeed (P.Done (List.reverse tail)) + ) + +times : Int -> Int -> Parser a -> Parser (List a) +times inf sup parser = + let + low : Int + low = max 0 (min inf sup) + + high : Int + high = max 0 sup + in + P.loop [] + (\tail -> + if List.length tail < low then + P.succeed (\head -> P.Loop (head :: tail)) + |= parser + else if List.length tail < high then + P.oneOf + [ P.succeed (\head -> P.Loop (head :: tail)) + |= parser + , P.succeed (P.Done (List.reverse tail)) + ] + else + P.succeed (P.Done (List.reverse tail)) + ) + +exactly : Int -> Parser a -> Parser (List a) +exactly n = + times n n From d1336a0e23cf4ed579caaeec66588c05e462d78a Mon Sep 17 00:00:00 2001 From: Bram Date: Fri, 29 Mar 2024 07:15:27 +0100 Subject: [PATCH 04/14] Add server name + user id parsers --- src/Internal/Grammar/ServerName.elm | 198 ++++++++++++++++++++++++++++ src/Internal/Grammar/UserId.elm | 68 ++++++++++ 2 files changed, 266 insertions(+) create mode 100644 src/Internal/Grammar/ServerName.elm create mode 100644 src/Internal/Grammar/UserId.elm diff --git a/src/Internal/Grammar/ServerName.elm b/src/Internal/Grammar/ServerName.elm new file mode 100644 index 0000000..8018617 --- /dev/null +++ b/src/Internal/Grammar/ServerName.elm @@ -0,0 +1,198 @@ +module Internal.Grammar.ServerName exposing (..) +{-| A homeserver is uniquely identified by its server name. The server name +represents the address at which the homeserver in question can be reached by +other homeservers. +-} + +import Internal.Tools.ParserExtra as PE +import Parser as P exposing (Parser, (|.), (|=)) +import Internal.Config.Log exposing (Log, log) +import Internal.Config.Text as Text + +{-| The hostname is the location where the server can be found. + +Notice how the Matrix spec specifies that the hostname can either be a DNS name, +an IPv4Address or an IPv6Address. Since the IPv4Address is compatible with the +specification of DNS names, however, and RFC1123 (section 2.1) does not require +a client to distinguish them, we treat IPv4Addresses like DNS names. +-} +type HostName + = DNS String + | IPv6 IPv6Address + +{-| The IPv6Address is represented by a list of items BEFORE and AFTER the +double colons (::). +-} +type alias IPv6Address = { front : List String, back : List String } + +{-| The server name is a combination of a hostname and an optional port. +-} +type ServerName = ServerName { host : HostName, port_ : Maybe Int } + +{-| Parser for the DNS name record. The Matrix spec bases its grammar on the +standard for internet host names, as specified by RFC1123, section 2.1, with an +extension IPv6 literals. + + [RFC-1123 §2.2] + + The syntax of a legal Internet host name was specified in RFC-952 + [DNS:4]. One aspect of host name syntax is hereby changed: the + restriction on the first character is relaxed to allow either a + letter or a digit. Host software MUST support this more liberal + syntax. + + Host software MUST handle host names of up to 63 characters and + SHOULD handle host names of up to 255 characters. + + [RFC-952 §Assumptions-1] + + A "name" (Net, Host, Gateway, or Domain name) is a text string up + to 24 characters drawn from the alphabet (A-Z), digits (0-9), minus + sign (-), and period (.). Note that periods are only allowed when + they serve to delimit components of "domain style names". (See + RFC-921, "Domain Name System Implementation Schedule", for + background). +-} +dnsNameParser : Parser String +dnsNameParser = + P.chompIf Char.isAlphaNum + |. P.chompWhile (\c -> Char.isAlphaNum c || c == '-' || c == '.') + |> P.getChompedString + +{-| Parse a Hostname. +-} +hostnameParser : Parser HostName +hostnameParser = + P.oneOf + [ P.succeed IPv6 + |. P.symbol "[" + |= ipv6Parser + |. P.symbol "]" + , P.succeed DNS + |= dnsNameParser + ] + +{-| Parse all values to the left of the double colon (::) +-} +ipv6LeftParser : Parser (List String) +ipv6LeftParser = + P.oneOf + [ P.succeed [] + |. P.symbol ":" + , P.succeed (|>) + |= PE.times 1 7 (ipv6NumParser |. P.symbol ":") + |= P.oneOf + [ P.succeed (\bottom tail -> tail ++ [bottom]) + |= ipv6NumParser + , P.succeed identity + ] + ] + +{-| Parse an ordinary IPv6 number +-} +ipv6NumParser : Parser String +ipv6NumParser = + P.chompIf Char.isHexDigit + |> P.getChompedString + |> PE.times 1 4 + |> P.map String.concat + +{-| Parse an IPv6 Address +-} +ipv6Parser : Parser IPv6Address +ipv6Parser = + ipv6LeftParser + |> P.andThen + (\front -> + P.succeed (IPv6Address front) + |= ipv6RightParser (8 - List.length front) + ) + +{-| Parse all values to the right of the double colon (::) +-} +ipv6RightParser : Int -> Parser (List String) +ipv6RightParser n = + P.succeed identity + |. P.symbol ":" + |= P.oneOf + [ P.succeed (::) + |= ipv6NumParser + |= PE.times 1 (n - 1) + ( P.succeed identity + |. P.symbol ":" + |= ipv6NumParser + ) + , P.succeed [] + ] + +{-| Convert an IPv6 address to a readable string format +-} +ipv6ToString : IPv6Address -> String +ipv6ToString { front, back } = + ( if List.length front == 8 then + front + else if List.length back == 8 then + back + else + List.concat [ front, [""], back ] + ) + |> List.intersperse ":" + |> String.concat + +portParser : Parser Int +portParser = + P.chompIf Char.isDigit + |. P.chompWhile Char.isDigit + |> P.getChompedString + |> P.andThen + (\v -> + case String.toInt v of + Just i -> + if 0 <= i && i <= 2^16 - 1 then + P.succeed i + else + P.problem ("Port out of range: " ++ v) + + Nothing -> + P.problem "Not a port number" + ) + +servernameParser : Parser ServerName +servernameParser = + P.succeed (\h p -> ServerName { host = h, port_ = p } ) + |= hostnameParser + |= P.oneOf + [ P.succeed Just + |. P.symbol ":" + |= portParser + , P.succeed Nothing + ] + +toString : ServerName -> String +toString (ServerName { host, port_ }) = + let + hostString : String + hostString = + case host of + DNS name -> + name + + IPv6 { front, back } -> + ( if List.length front == 8 then + front + else if List.length back == 8 then + back + else + List.concat [ front, [""], back ] + ) + |> List.intersperse ":" + |> String.concat + + portString : String + portString = + port_ + |> Maybe.map String.fromInt + |> Maybe.map ((++) ":") + |> Maybe.withDefault "" + in + hostString ++ portString diff --git a/src/Internal/Grammar/UserId.elm b/src/Internal/Grammar/UserId.elm new file mode 100644 index 0000000..d56ea9a --- /dev/null +++ b/src/Internal/Grammar/UserId.elm @@ -0,0 +1,68 @@ +module Internal.Grammar.UserId exposing (..) +{-| # User ids + +Users within Matrix are uniquely identified by their Matrix user ID. The user +ID is namespaced to the homeserver which allocated the account and has the form: + + @localpart:domain + +The localpart of a user ID is an opaque identifier for that user. It MUST NOT +be empty, and MUST contain only the characters a-z, 0-9, ., _, =, -, /, and +. + +The domain of a user ID is the server name of the homeserver which allocated +the account. + +The length of a user ID, including the @ sigil and the domain, MUST NOT exceed +255 characters. + +The complete grammar for a legal user ID is: + + user_id = "@" user_id_localpart ":" server_name + user_id_localpart = 1*user_id_char + user_id_char = DIGIT + / %x61-7A ; a-z + / "-" / "." / "=" / "_" / "/" / "+" + +Older versions of this specification were more tolerant of the characters +permitted in user ID localparts. There are currently active users whose user +IDs do not conform to the permitted character set, and a number of rooms whose +history includes events with a sender which does not conform. In order to +handle these rooms successfully, clients and servers MUST accept user IDs with +localparts from the expanded character set: + + extended_user_id_char = %x21-39 / %x3B-7E ; all ASCII printing chars except : + +-} + +import Internal.Grammar.ServerName as ServerName exposing (ServerName) +import Internal.Tools.ParserExtra as PE +import Parser as P exposing (Parser, (|.), (|=)) + +type UserID = UserID { localpart : String, domain : ServerName } + +localpartParser : Parser String +localpartParser = + P.chompIf validHistoricalUsernameChar + |> P.getChompedString + |> PE.times 1 255 + |> P.map String.concat + +toString : UserID -> String +toString (UserID { localpart, domain }) = + String.concat [ "@", localpart, ":", ServerName.toString domain ] + +userIdParser : Parser UserID +userIdParser = + P.succeed (\l d -> UserID { localpart = l, domain = d } ) + |. P.symbol "@" + |= localpartParser + |. P.symbol ":" + |= ServerName.servernameParser + +validHistoricalUsernameChar : Char -> Bool +validHistoricalUsernameChar c = + let + i : Int + i = Char.toCode c + in + (0x21 <= i && i <= 0x39) || (0x3B <= i && i <= 0x7E) From 56c978bcf3684f237d78ff2b00ec5028fa13676e Mon Sep 17 00:00:00 2001 From: Bram Date: Fri, 29 Mar 2024 07:16:36 +0100 Subject: [PATCH 05/14] Add custom text --- src/Internal/Config/Text.elm | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/src/Internal/Config/Text.elm b/src/Internal/Config/Text.elm index df063b5..a0209a5 100644 --- a/src/Internal/Config/Text.elm +++ b/src/Internal/Config/Text.elm @@ -4,6 +4,7 @@ module Internal.Config.Text exposing , versionsFoundLocally, versionsReceived, versionsFailedToDecode , unsupportedVersionForEndpoint , decodedDictSize, invalidHashInHashdict, invalidHashInMashdict, leakingValueFound + , parses ) {-| Throughout the Elm SDK, there are lots of pieces of text being used for @@ -347,6 +348,24 @@ leakingValueFound leaking_value = "Found leaking value : " ++ leaking_value +parses : + { reservedIPs : + { ipv6Toipv4 : String + , multicast : String + , futureUse : String + , unspecified : String + } + } +parses = + { reservedIPs = + { ipv6Toipv4 = "Detected a reserved ip address that is formerly used as an IPv6 to IPv4 relay. It is unlikely that this IP Address is real." + , multicast = "Detected a reserved ip address that is used for multicasting. It is unlikely that this IP Address is real." + , futureUse = "Detected a reserves ip address that is reserved for future use. It is unlikely that this IP Address is real if you're running a recent version of the Elm SDK." + , unspecified = "This is an unspecified ip address. It is unlikely that this IP Address is real and someone might try to break something." + } + } + + {-| The Matrix homeserver can specify how it wishes to communicate, and the Elm SDK aims to communicate accordingly. This may fail in some scenarios, however, in which case it will throw this error. From 077605bcbc7cc8ee4688631b54aaa7fd6c3cff82 Mon Sep 17 00:00:00 2001 From: Bram Date: Tue, 9 Apr 2024 20:37:01 +0200 Subject: [PATCH 06/14] Remove old file locations --- src/Internal/Tools/Grammar.elm | 74 ------------------- tests/Test/Values/Server.elm | 127 --------------------------------- 2 files changed, 201 deletions(-) delete mode 100644 src/Internal/Tools/Grammar.elm delete mode 100644 tests/Test/Values/Server.elm diff --git a/src/Internal/Tools/Grammar.elm b/src/Internal/Tools/Grammar.elm deleted file mode 100644 index 85db0d4..0000000 --- a/src/Internal/Tools/Grammar.elm +++ /dev/null @@ -1,74 +0,0 @@ -module Internal.Tools.Grammar exposing (..) - -{-| - - -# Identifier Grammar - -The specification defines -[some identifiers](https://spec.matrix.org/v1.9/appendices/#identifier-grammar) -to use the Common Namespaced Identifier Grammar. This is a common grammar -intended for non-user-visible identifiers, with a defined mechanism for -implementations to create new identifiers. - -This module documents those identifiers, allowing the Elm SDK to use them. - --} - -import Parser as P exposing (Parser) - - -{-| Parse an IPv6 address --} -ipv6addressParser : Parser String -ipv6addressParser = - P.chompWhile validIPv6Char - |> P.getChompedString - |> P.andThen - (\out -> - if String.length out > 45 then - P.problem "an ipv6 address has no more than 45 digits" - - else if String.length out < 2 then - P.problem "an ipv6 address has at least 2 digits" - - else - -- TODO: ipv6 has more specific rules - -- https://datatracker.ietf.org/doc/html/rfc3513#section-2.2 - P.succeed out - ) - - -{-| Parse a port value --} -portParser : Parser Int -portParser = - P.chompWhile Char.isDigit - |> P.getChompedString - |> P.andThen - (\out -> - if String.length out > 5 then - P.problem "a port has no more than 5 digits" - - else if String.length out < 1 then - P.problem "a port has at least 1 digit" - - else - case String.toInt out of - Nothing -> - P.problem "Expected port int" - - Just i -> - P.succeed i - ) - - -{-| Check whether a char is a valid IPv6char --} -validIPv6char : Char -> Bool - - -validIPv6Char c = - "0123456789ABCDEFabcdef:." - |> String.toList - |> List.member c diff --git a/tests/Test/Values/Server.elm b/tests/Test/Values/Server.elm deleted file mode 100644 index 519f4e2..0000000 --- a/tests/Test/Values/Server.elm +++ /dev/null @@ -1,127 +0,0 @@ -module Test.Values.Server exposing (..) - -import Test exposing (..) -import Fuzz exposing (Fuzzer) -import Expect - -digits : String -digits = "0123456789" - -alpha : String -alpha = "abcdefghijklmnopqrstuvwxyz" - -hex : String -hex = "0123456789abcdef" - -dns : String -dns = - digits ++ alpha ++ (String.toUpper alpha) ++ "-." - -dnsCharFuzzer : Fuzzer Char -dnsCharFuzzer = - dns - |> String.toList - |> Fuzz.oneOfValues - -dnsNameFuzzer : Fuzzer String -dnsNameFuzzer = - dnsCharFuzzer - |> Fuzz.listOfLengthBetween 1 255 - |> Fuzz.map String.fromList - -byteNumFuzzer : Fuzzer String -byteNumFuzzer = - Fuzz.intRange 0 255 - |> Fuzz.map String.fromInt - -portFuzzer : Fuzzer String -portFuzzer = - Fuzz.intRange 0 (2^16 - 1) - |> Fuzz.map String.fromInt - -ipv4Fuzzer : Fuzzer String -ipv4Fuzzer = - Fuzz.map4 - (\a b c d -> - [ a, b, c, d ] - |> List.intersperse "." - |> String.concat - ) - byteNumFuzzer - byteNumFuzzer - byteNumFuzzer - byteNumFuzzer - -ipv6CharFuzzer : Fuzzer Char -ipv6CharFuzzer = - hex - |> String.toList - |> Fuzz.oneOfValues - -ipv6PartFuzzer : Fuzzer String -ipv6PartFuzzer = - ipv6CharFuzzer - |> Fuzz.listOfLengthBetween 1 4 - |> Fuzz.map String.fromList - -ipv6Sides : Fuzzer (Int, Int) -ipv6Sides = - Fuzz.intRange 0 7 - |> Fuzz.andThen - (\a -> - Fuzz.intRange 0 (7-a) - |> Fuzz.map (\b -> (a, b)) - ) - -ipv6Fuzzer : Fuzzer String -ipv6Fuzzer = - Fuzz.oneOf - [ ipv6PartFuzzer - |> Fuzz.listOfLength 8 - |> Fuzz.map (List.intersperse ":") - |> Fuzz.map String.concat - , ipv6Sides - |> Fuzz.andThen - (\(a, b) -> - Fuzz.pair - (Fuzz.listOfLength a ipv6PartFuzzer) - (Fuzz.listOfLength b ipv6PartFuzzer) - ) - |> Fuzz.map - (\(la, lb) -> - [ List.intersperse ":" la - , [ "::" ] - , List.intersperse ":" lb - ] - |> List.concat - |> String.concat - ) - ] - -hostnameFuzzer : Fuzzer String -hostnameFuzzer = - Fuzz.oneOf - [ ipv4Fuzzer - , Fuzz.map (\ip -> "[" ++ ip ++ "]") ipv6Fuzzer - , dnsNameFuzzer - ] - -serverNameFuzzer : Fuzzer String -serverNameFuzzer = - Fuzz.map2 (++) - hostnameFuzzer - ( Fuzz.oneOf - [ Fuzz.constant "" - , Fuzz.map (\p -> ":" ++ p) portFuzzer - ] - ) - |> Fuzz.map (Debug.log "Server") - -suite : Test -suite = - describe "Server name tester" - [ fuzz serverNameFuzzer "IPv6 test" - (\_ -> - Expect.pass - ) - ] \ No newline at end of file From cd0c6873077fc90d6240fb46d014c59443650a95 Mon Sep 17 00:00:00 2001 From: Bram Date: Tue, 9 Apr 2024 20:38:35 +0200 Subject: [PATCH 07/14] Add server name module --- src/Internal/Config/Text.elm | 2 +- src/Internal/Grammar/ServerName.elm | 136 ++++++++++++++++++++-------- src/Internal/Grammar/UserId.elm | 30 ++++-- tests/Test/Grammar/ServerName.elm | 127 ++++++++++++++++++++++++++ 4 files changed, 250 insertions(+), 45 deletions(-) create mode 100644 tests/Test/Grammar/ServerName.elm diff --git a/src/Internal/Config/Text.elm b/src/Internal/Config/Text.elm index a0209a5..596aa01 100644 --- a/src/Internal/Config/Text.elm +++ b/src/Internal/Config/Text.elm @@ -349,7 +349,7 @@ leakingValueFound leaking_value = parses : - { reservedIPs : + { reservedIPs : { ipv6Toipv4 : String , multicast : String , futureUse : String diff --git a/src/Internal/Grammar/ServerName.elm b/src/Internal/Grammar/ServerName.elm index 8018617..1ee3cff 100644 --- a/src/Internal/Grammar/ServerName.elm +++ b/src/Internal/Grammar/ServerName.elm @@ -1,13 +1,29 @@ -module Internal.Grammar.ServerName exposing (..) -{-| A homeserver is uniquely identified by its server name. The server name +module Internal.Grammar.ServerName exposing + ( ServerName, toString, fromString + , servernameParser + ) + +{-| + + +# Server name + +A homeserver is uniquely identified by its server name. The server name represents the address at which the homeserver in question can be reached by other homeservers. + +@docs ServerName, toString, fromString + + +## Parser + +@docs serverNameParser + -} import Internal.Tools.ParserExtra as PE -import Parser as P exposing (Parser, (|.), (|=)) -import Internal.Config.Log exposing (Log, log) -import Internal.Config.Text as Text +import Parser as P exposing ((|.), (|=), Parser) + {-| The hostname is the location where the server can be found. @@ -15,19 +31,25 @@ Notice how the Matrix spec specifies that the hostname can either be a DNS name, an IPv4Address or an IPv6Address. Since the IPv4Address is compatible with the specification of DNS names, however, and RFC1123 (section 2.1) does not require a client to distinguish them, we treat IPv4Addresses like DNS names. + -} type HostName = DNS String | IPv6 IPv6Address + {-| The IPv6Address is represented by a list of items BEFORE and AFTER the double colons (::). -} -type alias IPv6Address = { front : List String, back : List String } +type alias IPv6Address = + { front : List String, back : List String } + {-| The server name is a combination of a hostname and an optional port. -} -type ServerName = ServerName { host : HostName, port_ : Maybe Int } +type ServerName + = ServerName { host : HostName, port_ : Maybe Int } + {-| Parser for the DNS name record. The Matrix spec bases its grammar on the standard for internet host names, as specified by RFC1123, section 2.1, with an @@ -43,7 +65,7 @@ extension IPv6 literals. Host software MUST handle host names of up to 63 characters and SHOULD handle host names of up to 255 characters. - + [RFC-952 §Assumptions-1] A "name" (Net, Host, Gateway, or Domain name) is a text string up @@ -52,6 +74,7 @@ extension IPv6 literals. they serve to delimit components of "domain style names". (See RFC-921, "Domain Name System Implementation Schedule", for background). + -} dnsNameParser : Parser String dnsNameParser = @@ -59,6 +82,23 @@ dnsNameParser = |. P.chompWhile (\c -> Char.isAlphaNum c || c == '-' || c == '.') |> P.getChompedString + +fromString : String -> Maybe ServerName +fromString s = + P.run (servernameParser |. P.end) s + |> (\out -> + case out of + Ok _ -> + out + + Err e -> + Debug.log "No parse" e + |> always (Debug.log "original" s) + |> always out + ) + |> Result.toMaybe + + {-| Parse a Hostname. -} hostnameParser : Parser HostName @@ -72,6 +112,7 @@ hostnameParser = |= dnsNameParser ] + {-| Parse all values to the left of the double colon (::) -} ipv6LeftParser : Parser (List String) @@ -82,12 +123,13 @@ ipv6LeftParser = , P.succeed (|>) |= PE.times 1 7 (ipv6NumParser |. P.symbol ":") |= P.oneOf - [ P.succeed (\bottom tail -> tail ++ [bottom]) + [ P.succeed (\bottom tail -> tail ++ [ bottom ]) |= ipv6NumParser , P.succeed identity ] ] + {-| Parse an ordinary IPv6 number -} ipv6NumParser : Parser String @@ -97,6 +139,7 @@ ipv6NumParser = |> PE.times 1 4 |> P.map String.concat + {-| Parse an IPv6 Address -} ipv6Parser : Parser IPv6Address @@ -108,37 +151,47 @@ ipv6Parser = |= ipv6RightParser (8 - List.length front) ) + {-| Parse all values to the right of the double colon (::) -} ipv6RightParser : Int -> Parser (List String) ipv6RightParser n = - P.succeed identity - |. P.symbol ":" - |= P.oneOf - [ P.succeed (::) - |= ipv6NumParser - |= PE.times 1 (n - 1) - ( P.succeed identity - |. P.symbol ":" - |= ipv6NumParser - ) - , P.succeed [] - ] + if n > 0 then + P.succeed identity + |. P.symbol ":" + |= P.oneOf + [ P.succeed (::) + |= ipv6NumParser + |= PE.times 0 + (n - 1) + (P.succeed identity + |. P.symbol ":" + |= ipv6NumParser + ) + , P.succeed [] + ] + + else + P.succeed [] + {-| Convert an IPv6 address to a readable string format -} ipv6ToString : IPv6Address -> String ipv6ToString { front, back } = - ( if List.length front == 8 then + (if List.length front == 8 then front - else if List.length back == 8 then + + else if List.length back == 8 then back - else - List.concat [ front, [""], back ] + + else + List.concat [ front, [ "" ], back ] ) |> List.intersperse ":" |> String.concat + portParser : Parser Int portParser = P.chompIf Char.isDigit @@ -148,18 +201,20 @@ portParser = (\v -> case String.toInt v of Just i -> - if 0 <= i && i <= 2^16 - 1 then + if 0 <= i && i <= 2 ^ 16 - 1 then P.succeed i + else P.problem ("Port out of range: " ++ v) - + Nothing -> P.problem "Not a port number" ) + servernameParser : Parser ServerName servernameParser = - P.succeed (\h p -> ServerName { host = h, port_ = p } ) + P.succeed (\h p -> ServerName { host = h, port_ = p }) |= hostnameParser |= P.oneOf [ P.succeed Just @@ -168,6 +223,7 @@ servernameParser = , P.succeed Nothing ] + toString : ServerName -> String toString (ServerName { host, port_ }) = let @@ -176,17 +232,23 @@ toString (ServerName { host, port_ }) = case host of DNS name -> name - + IPv6 { front, back } -> - ( if List.length front == 8 then - front - else if List.length back == 8 then - back - else - List.concat [ front, [""], back ] + (if List.length front == 8 then + List.intersperse ":" front + + else if List.length back == 8 then + List.intersperse ":" back + + else + List.concat + [ List.intersperse ":" front + , [ "::" ] + , List.intersperse ":" back + ] ) - |> List.intersperse ":" |> String.concat + |> (\i -> "[" ++ i ++ "]") portString : String portString = @@ -195,4 +257,4 @@ toString (ServerName { host, port_ }) = |> Maybe.map ((++) ":") |> Maybe.withDefault "" in - hostString ++ portString + hostString ++ portString diff --git a/src/Internal/Grammar/UserId.elm b/src/Internal/Grammar/UserId.elm index d56ea9a..be433ba 100644 --- a/src/Internal/Grammar/UserId.elm +++ b/src/Internal/Grammar/UserId.elm @@ -1,5 +1,9 @@ module Internal.Grammar.UserId exposing (..) -{-| # User ids + +{-| + + +# User ids Users within Matrix are uniquely identified by their Matrix user ID. The user ID is namespaced to the homeserver which allocated the account and has the form: @@ -7,7 +11,7 @@ ID is namespaced to the homeserver which allocated the account and has the form: @localpart:domain The localpart of a user ID is an opaque identifier for that user. It MUST NOT -be empty, and MUST contain only the characters a-z, 0-9, ., _, =, -, /, and +. +be empty, and MUST contain only the characters a-z, 0-9, ., \_, =, -, /, and +. The domain of a user ID is the server name of the homeserver which allocated the account. @@ -36,9 +40,17 @@ localparts from the expanded character set: import Internal.Grammar.ServerName as ServerName exposing (ServerName) import Internal.Tools.ParserExtra as PE -import Parser as P exposing (Parser, (|.), (|=)) +import Parser as P exposing ((|.), (|=), Parser) + + +type UserID + = UserID { localpart : String, domain : ServerName } + + +fromString : String -> Maybe UserID +fromString = + P.run userIdParser >> Result.toMaybe -type UserID = UserID { localpart : String, domain : ServerName } localpartParser : Parser String localpartParser = @@ -47,22 +59,26 @@ localpartParser = |> PE.times 1 255 |> P.map String.concat + toString : UserID -> String toString (UserID { localpart, domain }) = String.concat [ "@", localpart, ":", ServerName.toString domain ] + userIdParser : Parser UserID userIdParser = - P.succeed (\l d -> UserID { localpart = l, domain = d } ) + P.succeed (\l d -> UserID { localpart = l, domain = d }) |. P.symbol "@" |= localpartParser |. P.symbol ":" |= ServerName.servernameParser + validHistoricalUsernameChar : Char -> Bool validHistoricalUsernameChar c = let i : Int - i = Char.toCode c + i = + Char.toCode c in - (0x21 <= i && i <= 0x39) || (0x3B <= i && i <= 0x7E) + (0x21 <= i && i <= 0x39) || (0x3B <= i && i <= 0x7E) diff --git a/tests/Test/Grammar/ServerName.elm b/tests/Test/Grammar/ServerName.elm new file mode 100644 index 0000000..02ac97a --- /dev/null +++ b/tests/Test/Grammar/ServerName.elm @@ -0,0 +1,127 @@ +module Test.Grammar.ServerName exposing (..) + +import Expect +import Fuzz exposing (Fuzzer) +import Internal.Grammar.ServerName as SN +import Test exposing (..) + + +dnsFuzzer : Fuzzer String +dnsFuzzer = + Fuzz.map2 + (\head tail -> + String.fromList (head :: tail) + ) + ("abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789" + |> String.toList + |> Fuzz.oneOfValues + ) + ("abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789-." + |> String.toList + |> Fuzz.oneOfValues + |> Fuzz.listOfLengthBetween 0 (255 - 1) + ) + + +hostnameFuzzer : Fuzzer String +hostnameFuzzer = + Fuzz.oneOf + [ dnsFuzzer + , ipv4Fuzzer + , Fuzz.map (\x -> "[" ++ x ++ "]") ipv6Fuzzer + ] + + +ipv4Fuzzer : Fuzzer String +ipv4Fuzzer = + Fuzz.intRange 0 255 + |> Fuzz.listOfLength 4 + |> Fuzz.map + (List.map String.fromInt + >> List.intersperse "." + >> String.concat + ) + + +ipv6Fuzzer : Fuzzer String +ipv6Fuzzer = + let + num : Fuzzer String + num = + "0123456789abcdefABCDEF" + |> String.toList + |> Fuzz.oneOfValues + |> Fuzz.listOfLength 4 + |> Fuzz.map String.fromList + in + Fuzz.oneOf + [ Fuzz.listOfLength 8 num + |> Fuzz.map (List.intersperse ":") + |> Fuzz.map String.concat + , Fuzz.listOfLengthBetween 0 7 num + |> Fuzz.andThen + (\front -> + num + |> Fuzz.listOfLengthBetween 0 (8 - List.length front) + |> Fuzz.map + (\back -> + [ front + |> List.intersperse ":" + , [ "::" ] + , back + |> List.intersperse ":" + ] + |> List.concat + |> String.concat + ) + ) + ] + + +portFuzzer : Fuzzer String +portFuzzer = + Fuzz.oneOf + [ Fuzz.constant "" + , Fuzz.intRange 0 65535 + |> Fuzz.map (\p -> ":" ++ String.fromInt p) + ] + + +serverNameFuzzer : Fuzzer String +serverNameFuzzer = + Fuzz.map2 (++) hostnameFuzzer portFuzzer + + +suite : Test +suite = + describe "Server name tests" + [ describe "Checking correct values" + [ fuzz serverNameFuzzer + "Correct server names validate" + (\server -> + SN.fromString server + |> Maybe.map SN.toString + |> Maybe.map (String.replace "::" ":") + |> Expect.equal (Just <| String.replace "::" ":" server) + ) + , test "Checking spec examples" + (\() -> + let + examples : List String + examples = + [ "matrix.org" + , "matrix.org:8888" + , "1.2.3.4" + , "1.2.3.4:1234" + , "[1234:5678::abcd]" + , "[1234:5678::abcd]:5678" + ] + in + examples + |> List.map SN.fromString + |> List.map ((/=) Nothing) + |> Expect.equalLists + (List.repeat (List.length examples) True) + ) + ] + ] From 78794ef59b6520850a057673583b5bfa355b66fc Mon Sep 17 00:00:00 2001 From: Bram Date: Tue, 9 Apr 2024 20:43:18 +0200 Subject: [PATCH 08/14] Add exposed modules + elm-format --- elm.json | 2 ++ src/Internal/Tools/ParserExtra.elm | 44 +++++++++++++++++++----------- 2 files changed, 30 insertions(+), 16 deletions(-) diff --git a/elm.json b/elm.json index 1c32573..84e3a0e 100644 --- a/elm.json +++ b/elm.json @@ -5,6 +5,8 @@ "license": "EUPL-1.1", "version": "2.1.2", "exposed-modules": [ + "Internal.Grammar.ServerName", + "Internal.Grammar.UserId", "Matrix", "Matrix.Event", "Matrix.Settings" diff --git a/src/Internal/Tools/ParserExtra.elm b/src/Internal/Tools/ParserExtra.elm index 0148b3b..376563f 100644 --- a/src/Internal/Tools/ParserExtra.elm +++ b/src/Internal/Tools/ParserExtra.elm @@ -1,6 +1,7 @@ module Internal.Tools.ParserExtra exposing (..) -import Parser as P exposing (Parser, (|.), (|=)) +import Parser as P exposing ((|.), (|=), Parser) + zeroOrMore : Parser a -> Parser (List a) zeroOrMore parser = @@ -13,12 +14,14 @@ zeroOrMore parser = ] ) + oneOrMore : Parser a -> Parser (List a) oneOrMore parser = P.succeed (::) |= parser |= zeroOrMore parser + atLeast : Int -> Parser a -> Parser (List a) atLeast n parser = P.loop [] @@ -26,6 +29,7 @@ atLeast n parser = if List.length tail < n then P.succeed (\head -> P.Loop (head :: tail)) |= parser + else P.oneOf [ P.succeed (\head -> P.Loop (head :: tail)) @@ -34,6 +38,7 @@ atLeast n parser = ] ) + atMost : Int -> Parser a -> Parser (List a) atMost n parser = P.loop [] @@ -44,33 +49,40 @@ atMost n parser = |= parser , P.succeed (P.Done (List.reverse tail)) ] + else P.succeed (P.Done (List.reverse tail)) ) + times : Int -> Int -> Parser a -> Parser (List a) times inf sup parser = let low : Int - low = max 0 (min inf sup) + low = + max 0 (min inf sup) high : Int - high = max 0 sup + high = + max 0 sup in - P.loop [] - (\tail -> - if List.length tail < low then - P.succeed (\head -> P.Loop (head :: tail)) + P.loop [] + (\tail -> + if List.length tail < low then + P.succeed (\head -> P.Loop (head :: tail)) + |= parser + + else if List.length tail < high then + P.oneOf + [ P.succeed (\head -> P.Loop (head :: tail)) |= parser - else if List.length tail < high then - P.oneOf - [ P.succeed (\head -> P.Loop (head :: tail)) - |= parser - , P.succeed (P.Done (List.reverse tail)) - ] - else - P.succeed (P.Done (List.reverse tail)) - ) + , P.succeed (P.Done (List.reverse tail)) + ] + + else + P.succeed (P.Done (List.reverse tail)) + ) + exactly : Int -> Parser a -> Parser (List a) exactly n = From 203205f53cafff6844b881b95f016b5aac8c9bd8 Mon Sep 17 00:00:00 2001 From: Bram Date: Wed, 10 Apr 2024 08:28:52 +0200 Subject: [PATCH 09/14] Expose Elm types As a general rule of thumb, internal values need no opaque types to hide their implementation --- src/Internal/Grammar/ServerName.elm | 8 ++++---- src/Internal/Grammar/UserId.elm | 8 ++++---- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/src/Internal/Grammar/ServerName.elm b/src/Internal/Grammar/ServerName.elm index 1ee3cff..b61e913 100644 --- a/src/Internal/Grammar/ServerName.elm +++ b/src/Internal/Grammar/ServerName.elm @@ -47,8 +47,8 @@ type alias IPv6Address = {-| The server name is a combination of a hostname and an optional port. -} -type ServerName - = ServerName { host : HostName, port_ : Maybe Int } +type alias ServerName = + { host : HostName, port_ : Maybe Int } {-| Parser for the DNS name record. The Matrix spec bases its grammar on the @@ -214,7 +214,7 @@ portParser = servernameParser : Parser ServerName servernameParser = - P.succeed (\h p -> ServerName { host = h, port_ = p }) + P.succeed ServerName |= hostnameParser |= P.oneOf [ P.succeed Just @@ -225,7 +225,7 @@ servernameParser = toString : ServerName -> String -toString (ServerName { host, port_ }) = +toString { host, port_ } = let hostString : String hostString = diff --git a/src/Internal/Grammar/UserId.elm b/src/Internal/Grammar/UserId.elm index be433ba..2a2327f 100644 --- a/src/Internal/Grammar/UserId.elm +++ b/src/Internal/Grammar/UserId.elm @@ -43,8 +43,8 @@ import Internal.Tools.ParserExtra as PE import Parser as P exposing ((|.), (|=), Parser) -type UserID - = UserID { localpart : String, domain : ServerName } +type alias UserID = + { localpart : String, domain : ServerName } fromString : String -> Maybe UserID @@ -61,13 +61,13 @@ localpartParser = toString : UserID -> String -toString (UserID { localpart, domain }) = +toString { localpart, domain } = String.concat [ "@", localpart, ":", ServerName.toString domain ] userIdParser : Parser UserID userIdParser = - P.succeed (\l d -> UserID { localpart = l, domain = d }) + P.succeed UserID |. P.symbol "@" |= localpartParser |. P.symbol ":" From b3e103a5d9506111d7e752227454cd2c4cf56a67 Mon Sep 17 00:00:00 2001 From: Bram Date: Wed, 10 Apr 2024 18:14:32 +0200 Subject: [PATCH 10/14] Write Grammar tests --- src/Internal/Grammar/ServerName.elm | 15 ++- src/Internal/Grammar/UserId.elm | 50 +++++++++- tests/Test/Grammar/ServerName.elm | 3 +- tests/Test/Grammar/UserId.elm | 145 ++++++++++++++++++++++++++++ 4 files changed, 204 insertions(+), 9 deletions(-) create mode 100644 tests/Test/Grammar/UserId.elm diff --git a/src/Internal/Grammar/ServerName.elm b/src/Internal/Grammar/ServerName.elm index b61e913..5146bcc 100644 --- a/src/Internal/Grammar/ServerName.elm +++ b/src/Internal/Grammar/ServerName.elm @@ -1,6 +1,6 @@ module Internal.Grammar.ServerName exposing ( ServerName, toString, fromString - , servernameParser + , serverNameParser ) {-| @@ -83,9 +83,11 @@ dnsNameParser = |> P.getChompedString +{-| Convert a string to a server name. +-} fromString : String -> Maybe ServerName fromString s = - P.run (servernameParser |. P.end) s + P.run (serverNameParser |. P.end) s |> (\out -> case out of Ok _ -> @@ -212,8 +214,11 @@ portParser = ) -servernameParser : Parser ServerName -servernameParser = +{-| Parse a server name. Generally used by other identifiers that have a server +name as one of its parts. +-} +serverNameParser : Parser ServerName +serverNameParser = P.succeed ServerName |= hostnameParser |= P.oneOf @@ -224,6 +229,8 @@ servernameParser = ] +{-| Convert a parsed server name back to a string. +-} toString : ServerName -> String toString { host, port_ } = let diff --git a/src/Internal/Grammar/UserId.elm b/src/Internal/Grammar/UserId.elm index 2a2327f..24baf06 100644 --- a/src/Internal/Grammar/UserId.elm +++ b/src/Internal/Grammar/UserId.elm @@ -1,4 +1,7 @@ -module Internal.Grammar.UserId exposing (..) +module Internal.Grammar.UserId exposing + ( UserID, toString, fromString + , userIdParser, isHistorical + ) {-| @@ -36,6 +39,16 @@ localparts from the expanded character set: extended_user_id_char = %x21-39 / %x3B-7E ; all ASCII printing chars except : + +## User ID + +@docs UserID, toString, fromString + + +## Extra + +@docs userIdParser, isHistorical + -} import Internal.Grammar.ServerName as ServerName exposing (ServerName) @@ -43,13 +56,39 @@ import Internal.Tools.ParserExtra as PE import Parser as P exposing ((|.), (|=), Parser) +{-| The User ID type defining a user. +-} type alias UserID = { localpart : String, domain : ServerName } +{-| Convert a Matrix User ID back into its uniquely identifying string. +-} fromString : String -> Maybe UserID fromString = - P.run userIdParser >> Result.toMaybe + P.run (userIdParser |. P.end) >> Result.toMaybe + + +{-| Return a boolean on whether a Matrix user has a historical user ID. +Since this user ID is not SUPPOSED to be legal but clients are nevertheless +forced to support them due to backwards compatibility, clients may occasionally +attempt to break the rules in an attempt to find undefined behaviour. + +As a result, an explicit method to spot historical users is added to the SDK. + +-} +isHistorical : UserID -> Bool +isHistorical { localpart } = + String.any + (\c -> + let + i : Int + i = + Char.toCode c + in + not ((0x61 <= i && i <= 0x7A) || Char.isAlpha c) + ) + localpart localpartParser : Parser String @@ -60,18 +99,23 @@ localpartParser = |> P.map String.concat +{-| Convert a parsed User ID to a string. +-} toString : UserID -> String toString { localpart, domain } = String.concat [ "@", localpart, ":", ServerName.toString domain ] +{-| Parse a UserID from a string. +-} userIdParser : Parser UserID userIdParser = P.succeed UserID |. P.symbol "@" |= localpartParser |. P.symbol ":" - |= ServerName.servernameParser + |= ServerName.serverNameParser + |> PE.maxLength 255 validHistoricalUsernameChar : Char -> Bool diff --git a/tests/Test/Grammar/ServerName.elm b/tests/Test/Grammar/ServerName.elm index 02ac97a..e3e1a38 100644 --- a/tests/Test/Grammar/ServerName.elm +++ b/tests/Test/Grammar/ServerName.elm @@ -101,8 +101,7 @@ suite = (\server -> SN.fromString server |> Maybe.map SN.toString - |> Maybe.map (String.replace "::" ":") - |> Expect.equal (Just <| String.replace "::" ":" server) + |> Expect.equal (Just server) ) , test "Checking spec examples" (\() -> diff --git a/tests/Test/Grammar/UserId.elm b/tests/Test/Grammar/UserId.elm new file mode 100644 index 0000000..8e1100a --- /dev/null +++ b/tests/Test/Grammar/UserId.elm @@ -0,0 +1,145 @@ +module Test.Grammar.UserId exposing (..) + +import Expect +import Fuzz exposing (Fuzzer) +import Internal.Grammar.UserId as U +import Test exposing (..) +import Test.Grammar.ServerName as ServerName + + +modernUserCharFuzzer : Fuzzer Char +modernUserCharFuzzer = + Fuzz.oneOf + [ Fuzz.intRange 0x61 0x7A + |> Fuzz.map Char.fromCode + , "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" + |> String.toList + |> Fuzz.oneOfValues + ] + + +historicalUserCharFuzzer : Fuzzer Char +historicalUserCharFuzzer = + [ ( 0x21, 0x39 ), ( 0x3B, 0x7E ) ] + |> List.map (\( low, high ) -> Fuzz.intRange low high) + |> Fuzz.oneOf + |> Fuzz.map Char.fromCode + + +modernUserFuzzer : Fuzzer String +modernUserFuzzer = + Fuzz.map2 + (\localpart domain -> + let + maxLocalSize : Int + maxLocalSize = + 255 - String.length domain - 2 + in + localpart + |> List.take maxLocalSize + |> String.fromList + |> (\l -> "@" ++ l ++ ":" ++ domain) + ) + (Fuzz.listOfLengthBetween 1 255 modernUserCharFuzzer) + (ServerName.serverNameFuzzer + |> Fuzz.filter + (\name -> + String.length name < 255 - 2 + ) + ) + + +historicalUserFuzzer : Fuzzer String +historicalUserFuzzer = + Fuzz.map2 + (\localpart domain -> + let + maxLocalSize : Int + maxLocalSize = + 255 - String.length domain - 2 + in + localpart + |> List.take maxLocalSize + |> String.fromList + |> (\l -> "@" ++ l ++ ":" ++ domain) + ) + (Fuzz.listOfLengthBetween 1 255 historicalUserCharFuzzer) + (ServerName.serverNameFuzzer + |> Fuzz.filter + (\name -> + String.length name < 255 - 2 + ) + ) + + +userFuzzer : Fuzzer String +userFuzzer = + Fuzz.oneOf [ modernUserFuzzer, historicalUserFuzzer ] + + +suite : Test +suite = + describe "UserId" + [ describe "Size" + [ fuzz ServerName.serverNameFuzzer + "Username cannot be length 0" + (\domain -> + "@" + ++ ":" + ++ domain + |> U.fromString + |> Expect.equal Nothing + ) + , fuzz2 (Fuzz.listOfLengthBetween 1 255 historicalUserCharFuzzer) + ServerName.serverNameFuzzer + "Username length cannot exceed 255" + (\localpart domain -> + let + username : String + username = + "@" + ++ String.fromList localpart + ++ ":" + ++ domain + in + Expect.equal + (U.fromString username == Nothing) + (String.length username > 255) + ) + , fuzz modernUserFuzzer + "Modern fuzzer has appropriate size" + (String.length >> Expect.lessThan 256) + , fuzz historicalUserFuzzer + "Historical fuzzer has appropriate size" + (String.length >> Expect.lessThan 256) + ] + , describe "From string evaluation" + [ fuzz userFuzzer + "fromString always returns a value on fuzzer" + (U.fromString >> Expect.notEqual Nothing) + , fuzz userFuzzer + "fromString -> toString returns the same value" + (\username -> + username + |> U.fromString + |> Maybe.map U.toString + |> Expect.equal (Just username) + ) + , fuzz historicalUserFuzzer + "Historical users are historical" + (\username -> + username + |> U.fromString + |> Maybe.map U.isHistorical + |> Expect.equal (Just True) + ) + , fuzz modernUserFuzzer + "Modern users are not historical" + (\username -> + username + |> U.fromString + |> Maybe.map U.isHistorical + |> Expect.equal (Just False) + ) + ] + ] From ae19884a18f639525ee19bdef84df180e089390c Mon Sep 17 00:00:00 2001 From: Bram Date: Fri, 12 Apr 2024 13:14:50 +0200 Subject: [PATCH 11/14] Correct IPv6 Parser --- src/Internal/Grammar/ServerName.elm | 10 ++++++++-- src/Internal/Tools/Json.elm | 23 +++++++++++++++++++++++ src/Internal/Tools/ParserExtra.elm | 16 ++++++++++++++++ tests/Test/Grammar/ServerName.elm | 2 +- tests/Test/Grammar/UserId.elm | 22 ++++++++++++++-------- 5 files changed, 62 insertions(+), 11 deletions(-) diff --git a/src/Internal/Grammar/ServerName.elm b/src/Internal/Grammar/ServerName.elm index 5146bcc..ac77f4f 100644 --- a/src/Internal/Grammar/ServerName.elm +++ b/src/Internal/Grammar/ServerName.elm @@ -149,8 +149,13 @@ ipv6Parser = ipv6LeftParser |> P.andThen (\front -> - P.succeed (IPv6Address front) - |= ipv6RightParser (8 - List.length front) + if List.length front < 8 then + P.succeed (IPv6Address front) + |= ipv6RightParser (8 - 1 - List.length front) + -- The -1 is because :: implies one or more zeroes + + else + P.succeed (IPv6Address front []) ) @@ -175,6 +180,7 @@ ipv6RightParser n = else P.succeed [] + |. P.symbol ":" {-| Convert an IPv6 address to a readable string format diff --git a/src/Internal/Tools/Json.elm b/src/Internal/Tools/Json.elm index a0653bc..4608965 100644 --- a/src/Internal/Tools/Json.elm +++ b/src/Internal/Tools/Json.elm @@ -74,6 +74,7 @@ import Internal.Tools.DecodeExtra as D import Internal.Tools.EncodeExtra as E import Json.Decode as D import Json.Encode as E +import Parser as P import Set exposing (Set) @@ -158,6 +159,7 @@ type Docs } ) | DocsOptional Docs + | DocsParser String | DocsRiskyMap (Descriptive { content : Docs, failure : List String }) | DocsSet Docs | DocsString @@ -1152,6 +1154,27 @@ object11 { name, description, init } fa fb fc fd fe ff fg fh fi fj fk = } +{-| Define a parser that converts a string into a custom Elm type. +-} +parser : { name : String, p : P.Parser ( a, List Log ), toString : a -> String } -> Coder a +parser { name, p, toString } = + Coder + { encoder = toString >> E.string + , decoder = + D.string + |> D.andThen + (\v -> + case P.run p v of + Err _ -> + D.fail ("Failed to parse " ++ name ++ "!") + + Ok o -> + D.succeed o + ) + , docs = DocsParser name + } + + {-| Define a set. -} set : Coder comparable -> Coder (Set comparable) diff --git a/src/Internal/Tools/ParserExtra.elm b/src/Internal/Tools/ParserExtra.elm index 376563f..2c456c7 100644 --- a/src/Internal/Tools/ParserExtra.elm +++ b/src/Internal/Tools/ParserExtra.elm @@ -87,3 +87,19 @@ times inf sup parser = exactly : Int -> Parser a -> Parser (List a) exactly n = times n n + + +maxLength : Int -> Parser a -> Parser a +maxLength n parser = + P.succeed + (\start value end -> + if abs (end - start) > n then + P.problem "Parsed too much text!" + + else + P.succeed value + ) + |= P.getOffset + |= parser + |= P.getOffset + |> P.andThen identity diff --git a/tests/Test/Grammar/ServerName.elm b/tests/Test/Grammar/ServerName.elm index e3e1a38..5a74871 100644 --- a/tests/Test/Grammar/ServerName.elm +++ b/tests/Test/Grammar/ServerName.elm @@ -62,7 +62,7 @@ ipv6Fuzzer = |> Fuzz.andThen (\front -> num - |> Fuzz.listOfLengthBetween 0 (8 - List.length front) + |> Fuzz.listOfLengthBetween 0 (8 - 1 - List.length front) |> Fuzz.map (\back -> [ front diff --git a/tests/Test/Grammar/UserId.elm b/tests/Test/Grammar/UserId.elm index 8e1100a..f613902 100644 --- a/tests/Test/Grammar/UserId.elm +++ b/tests/Test/Grammar/UserId.elm @@ -112,6 +112,9 @@ suite = , fuzz historicalUserFuzzer "Historical fuzzer has appropriate size" (String.length >> Expect.lessThan 256) + , fuzz userFuzzer + "User fuzzers have appropriate size" + (String.length >> Expect.lessThan 256) ] , describe "From string evaluation" [ fuzz userFuzzer @@ -125,14 +128,17 @@ suite = |> Maybe.map U.toString |> Expect.equal (Just username) ) - , fuzz historicalUserFuzzer - "Historical users are historical" - (\username -> - username - |> U.fromString - |> Maybe.map U.isHistorical - |> Expect.equal (Just True) - ) + + -- Not always True + -- TODO: Define a fitting fuzzer for this test + -- , fuzz historicalUserFuzzer + -- "Historical users are historical" + -- (\username -> + -- username + -- |> U.fromString + -- |> Maybe.map U.isHistorical + -- |> Expect.equal (Just True) + -- ) , fuzz modernUserFuzzer "Modern users are not historical" (\username -> From 259f695b74d7c2b77873422325a5ded067c77a53 Mon Sep 17 00:00:00 2001 From: Bram Date: Fri, 12 Apr 2024 13:15:26 +0200 Subject: [PATCH 12/14] Expose Matrix.User module --- elm.json | 2 + src/Internal/Config/Text.elm | 44 ++++++----- src/Internal/Values/User.elm | 73 +++++++++++++++++ src/Matrix/User.elm | 147 +++++++++++++++++++++++++++++++++++ src/Types.elm | 11 ++- 5 files changed, 255 insertions(+), 22 deletions(-) create mode 100644 src/Internal/Values/User.elm create mode 100644 src/Matrix/User.elm diff --git a/elm.json b/elm.json index b911374..a16af88 100644 --- a/elm.json +++ b/elm.json @@ -27,10 +27,12 @@ "Internal.Values.Settings", "Internal.Values.StateManager", "Internal.Values.Timeline", + "Internal.Values.User", "Internal.Values.Vault", "Matrix", "Matrix.Event", "Matrix.Settings", + "Matrix.User", "Types" ], "elm-version": "0.19.0 <= v < 0.20.0", diff --git a/src/Internal/Config/Text.elm b/src/Internal/Config/Text.elm index 1d128cc..bb6e933 100644 --- a/src/Internal/Config/Text.elm +++ b/src/Internal/Config/Text.elm @@ -1,10 +1,9 @@ module Internal.Config.Text exposing - ( docs, failures, fields, mappings, logs + ( docs, failures, fields, mappings, logs, parses , accessTokenFoundLocally, accessTokenExpired, accessTokenInvalid , versionsFoundLocally, versionsReceived, versionsFailedToDecode , unsupportedVersionForEndpoint , decodedDictSize, invalidHashInHashdict, invalidHashInMashdict, leakingValueFound - , parses ) {-| Throughout the Elm SDK, there are lots of pieces of text being used for @@ -28,7 +27,7 @@ You should only do this if you know what you're doing. ## Type documentation -@docs docs, failures, fields, mappings, logs +@docs docs, failures, fields, mappings, logs, parses ## API Authentication @@ -487,23 +486,6 @@ leakingValueFound leaking_value = "Found leaking value : " ++ leaking_value -parses : - { reservedIPs : - { ipv6Toipv4 : String - , multicast : String - , futureUse : String - , unspecified : String - } - } -parses = - { reservedIPs = - { ipv6Toipv4 = "Detected a reserved ip address that is formerly used as an IPv6 to IPv4 relay. It is unlikely that this IP Address is real." - , multicast = "Detected a reserved ip address that is used for multicasting. It is unlikely that this IP Address is real." - , futureUse = "Detected a reserves ip address that is reserved for future use. It is unlikely that this IP Address is real if you're running a recent version of the Elm SDK." - , unspecified = "This is an unspecified ip address. It is unlikely that this IP Address is real and someone might try to break something." - } - } - {-| These logs might appear during a process where something unexpected has happened. Most of these unexpected results, are taken account of by the Elm SDK, but logged so that the programmer can do something about it. @@ -533,6 +515,28 @@ mappings = } +{-| Logs for issues that might be found while parsing strings into meaningful data. +-} +parses : + { historicalUserId : String -> String + , reservedIPs : + { ipv6Toipv4 : String + , multicast : String + , futureUse : String + , unspecified : String + } + } +parses = + { historicalUserId = \name -> "Found a historical username `" ++ name ++ "`." + , reservedIPs = + { ipv6Toipv4 = "Detected a reserved ip address that is formerly used as an IPv6 to IPv4 relay. It is unlikely that this IP Address is real." + , multicast = "Detected a reserved ip address that is used for multicasting. It is unlikely that this IP Address is real." + , futureUse = "Detected a reserves ip address that is reserved for future use. It is unlikely that this IP Address is real if you're running a recent version of the Elm SDK." + , unspecified = "This is an unspecified ip address. It is unlikely that this IP Address is real and someone might try to break something." + } + } + + {-| The Matrix homeserver can specify how it wishes to communicate, and the Elm SDK aims to communicate accordingly. This may fail in some scenarios, however, in which case it will throw this error. diff --git a/src/Internal/Values/User.elm b/src/Internal/Values/User.elm new file mode 100644 index 0000000..c39ebfc --- /dev/null +++ b/src/Internal/Values/User.elm @@ -0,0 +1,73 @@ +module Internal.Values.User exposing + ( User, toString, fromString + , localpart, domain + ) + +{-| The Matrix user is uniquely identified by their identifier. This User type +helps identify and safely handle these strings to transform them into meaningful +data types. + + +## User + +@docs User, toString, fromString + + +## Divide + +Matrix users are identified by their unique ID. In the Matrix API, this is a +string that looks as follows: + + @alice:example.org + \---/ \---------/ + | | + | | + localpart domain + +Since the username is safely parsed, one can get these parts of the username. + +@docs localpart, domain + +-} + +import Internal.Grammar.ServerName as ServerName +import Internal.Grammar.UserId as UserId + + +{-| The Matrix user represents a user across multiple Matrix rooms. +-} +type alias User = + UserId.UserID + + +{-| The domain represents the Matrix homeserver controlling this user. It also +offers other Matrix homeservers an indication of where to look if you wish to +send a message to this user. +-} +domain : User -> String +domain = + .domain >> ServerName.toString + + +{-| Parse a string and convert it into a User, if formatted properly. +-} +fromString : String -> Maybe User +fromString = + UserId.fromString + + +{-| The localpart is similar to a username, in the sense that every user has +their own localpart. The localpart is not unique across multiple servers, +however! There can be a user @alice:example.com and a user @alice:example.org in +a room at the same time. +-} +localpart : User -> String +localpart = + .localpart + + +{-| Convert a user into its unique identifier string value. +-} +toString : User -> String +toString = + UserId.toString diff --git a/src/Matrix/User.elm b/src/Matrix/User.elm new file mode 100644 index 0000000..595e1a9 --- /dev/null +++ b/src/Matrix/User.elm @@ -0,0 +1,147 @@ +module Matrix.User exposing + ( User, toString + , localpart, domain + , get + ) + +{-| Matrix users are identified by their unique ID. In the Matrix API, this is a +string that looks as follows: + + @alice:example.org + \---/ \---------/ + | | + | | + localpart domain + +Since it is very easy to abuse Matrix user IDs to sneak in arbitrary values, +the Elm SDK parses them and makes sure they are safe. As a result, you might +need this module to get the right information from a user! + + +## User + +@docs User, toString + + +## Info + +Sometimes, you are more interested in the username itself. These functions can +help you decipher, disambiguate and categorize users based on their username. + +@docs localpart, domain + + +## Manipulate + +@docs get + +-} + +import Internal.Values.Envelope as Envelope +import Internal.Values.User as Internal +import Types exposing (User(..)) + + +{-| The User type represents a Matrix user. + +It contains information like: + + - Their username on Matrix + - The server that hosts their account + - Access tokens needed to talk to the server + +It does **NOT** contain information like: + + - Their nickname + - Their profile picture + - Your private room with them + +You can get all that information by looking it up in the [Vault](Matrix#Vault). + +**Note:** Please do not store this user type as a variable in your model! You +should always maintain a single source of truth in Elm, and the User type +contains various credentials and API tokens that might expire if you don't +update them from the Vault. + +If you need to remember specific users, you can best compare their identifying +string using [toString](Matrix-User#toString) or you can use +[get](Matrix-User#get) with the Vault to get the user type. + +-} +type alias User = + Types.User + + +{-| The domain is the name of the server that the user connects to. Server names +are case-sensitive, so if the strings are equal, the users are on the same +server! + +As a result, you can use the user domain for: + + - When multiple users in a room have the same localpart on different servers + - Finding other users from a potentially malicious homeserver + - Counting homeservers in a room + +See the following examples: + + domain (get vault "@alice:example.org") -- "example.org" + + domain (get vault "@bob:127.0.0.1") -- "127.0.0.1" + + domain (get vault "@charlie:[2001:db8::]") -- "[2001:db8::]" + +-} +domain : User -> String +domain (User user) = + Envelope.extract Internal.domain user + + +{-| Get a specific user by their unique identifier. + +The Vault is needed as an input because the `User` type also stores various +credentials needed to talk to the Matrix API. + + get vault "@alice:example.org" -- Just (User "alice" "example.org") + + get vault "@bob:127.0.0.1" -- Just (User "bob" "127.0.0.1") + + get vault "@charlie:[2001:db8::]" -- Just (User "charlie" "2001:db8::") + + get vault "@evil:#mp#ss#bl#.c#m" -- Nothing + + get vault "" -- Nothing + +-} +get : Types.Vault -> String -> Maybe User +get (Types.Vault vault) username = + Envelope.mapMaybe (\_ -> Internal.fromString username) vault + |> Maybe.map Types.User + + +{-| The localpart is the user's unique username. Every homeserver has their own +username registry, so you might occasionally find distinct users with the same +localpart. + +The localpart is often used as a user's name in a room if they haven't set up +a custom name. + +See the following examples: + + localpart (get vault "@alice:example.org") -- "alice" + + localpart (get vault "@bob:127.0.0.1") -- "bob" + + localpart (get vault "@charlie:[2001:db8::]") -- "charlie" + +-} +localpart : User -> String +localpart (User user) = + Envelope.extract Internal.localpart user + + +{-| Get the uniquely identifying string for this user. Since the strings are +case-sensitive, you can run a simple string comparison to compare usernames. +-} +toString : User -> String +toString (User user) = + Envelope.extract Internal.toString user diff --git a/src/Types.elm b/src/Types.elm index 242bea7..aef9df0 100644 --- a/src/Types.elm +++ b/src/Types.elm @@ -1,4 +1,4 @@ -module Types exposing (Vault(..), Event(..)) +module Types exposing (Vault(..), Event(..), User(..)) {-| The Elm SDK uses a lot of records and values that are easy to manipulate. Yet, the [Elm design guidelines](https://package.elm-lang.org/help/design-guidelines#keep-tags-and-record-constructors-secret) @@ -12,12 +12,13 @@ access their content directly. The opaque types are placed in a central module so all exposed modules can safely access all exposed data types without risking to create circular imports. -@docs Vault, Event +@docs Vault, Event, User -} import Internal.Values.Envelope as Envelope import Internal.Values.Event as Event +import Internal.Values.User as User import Internal.Values.Vault as Vault @@ -27,6 +28,12 @@ type Event = Event (Envelope.Envelope Event.Event) +{-| Opaque type for Matrix User +-} +type User + = User (Envelope.Envelope User.User) + + {-| Opaque type for Matrix Vault -} type Vault From 0ef298a28e036a8532243910f3cb53e9225eed36 Mon Sep 17 00:00:00 2001 From: Bram Date: Fri, 12 Apr 2024 13:57:38 +0200 Subject: [PATCH 13/14] Connect User to Event type --- src/Internal/Filter/Timeline.elm | 5 +++-- src/Internal/Grammar/ServerName.elm | 6 ++++++ src/Internal/Tools/Json.elm | 4 ++-- src/Internal/Values/Event.elm | 5 +++-- src/Internal/Values/User.elm | 33 +++++++++++++++++++++++++++++ src/Matrix/Event.elm | 5 +++-- tests/Test/Filter/Timeline.elm | 19 +++++++++-------- tests/Test/Grammar/UserId.elm | 8 +++++++ tests/Test/Tools/Hashdict.elm | 4 ++-- tests/Test/Values/Event.elm | 3 ++- 10 files changed, 72 insertions(+), 20 deletions(-) diff --git a/src/Internal/Filter/Timeline.elm b/src/Internal/Filter/Timeline.elm index a4231bf..e43ecce 100644 --- a/src/Internal/Filter/Timeline.elm +++ b/src/Internal/Filter/Timeline.elm @@ -48,6 +48,7 @@ for interacting with the Matrix API. -} import Internal.Config.Text as Text +import Internal.Grammar.UserId as U import Internal.Tools.Json as Json import Json.Decode as D import Json.Encode as E @@ -57,7 +58,7 @@ import Set exposing (Set) {-| Placeholder Event type so the real Event doesn't need to be imported. -} type alias Event a = - { a | eventType : String, sender : String } + { a | eventType : String, sender : U.UserID } {-| The Timeline Filter filters events out of a timeline, guaranteeing that only @@ -246,7 +247,7 @@ match (Filter f) { eventType, sender } = let mentionedSender : Bool mentionedSender = - Set.member sender f.senders + Set.member (U.toString sender) f.senders mentionedType : Bool mentionedType = diff --git a/src/Internal/Grammar/ServerName.elm b/src/Internal/Grammar/ServerName.elm index ac77f4f..4b9f1b6 100644 --- a/src/Internal/Grammar/ServerName.elm +++ b/src/Internal/Grammar/ServerName.elm @@ -1,6 +1,7 @@ module Internal.Grammar.ServerName exposing ( ServerName, toString, fromString , serverNameParser + , HostName(..) ) {-| @@ -19,6 +20,11 @@ other homeservers. @docs serverNameParser + +## Debug + +@docs HostName + -} import Internal.Tools.ParserExtra as PE diff --git a/src/Internal/Tools/Json.elm b/src/Internal/Tools/Json.elm index 4608965..cf31b4f 100644 --- a/src/Internal/Tools/Json.elm +++ b/src/Internal/Tools/Json.elm @@ -4,7 +4,7 @@ module Internal.Tools.Json exposing , succeed, fail, andThen, lazy, map , Docs(..), RequiredField(..), toDocs , list, listWithOne, slowDict, fastDict, fastIntDict, set, maybe - , Field, field + , Field, field, parser , object2, object3, object4, object5, object6, object7, object8, object9, object10, object11 ) @@ -58,7 +58,7 @@ This section creates objects that can be (re)used in the library's JSON specification. For this, the user needs to construct fields for the object first. -@docs Field, field +@docs Field, field, parser Once all fields are constructed, the user can create JSON objects. diff --git a/src/Internal/Values/Event.elm b/src/Internal/Values/Event.elm index 71e18e6..2ee528a 100644 --- a/src/Internal/Values/Event.elm +++ b/src/Internal/Values/Event.elm @@ -35,6 +35,7 @@ of a room. import Internal.Config.Text as Text import Internal.Tools.Json as Json import Internal.Tools.Timestamp as Timestamp exposing (Timestamp) +import Internal.Values.User as User exposing (User) import Json.Encode as E @@ -45,7 +46,7 @@ type alias Event = , eventId : String , originServerTs : Timestamp , roomId : String - , sender : String + , sender : User , stateKey : Maybe String , eventType : String , unsigned : Maybe UnsignedData @@ -112,7 +113,7 @@ coder = { fieldName = "sender" , toField = .sender , description = Text.fields.event.sender - , coder = Json.string + , coder = User.coder } ) (Json.field.optional.value diff --git a/src/Internal/Values/User.elm b/src/Internal/Values/User.elm index c39ebfc..806207d 100644 --- a/src/Internal/Values/User.elm +++ b/src/Internal/Values/User.elm @@ -1,6 +1,7 @@ module Internal.Values.User exposing ( User, toString, fromString , localpart, domain + , coder ) {-| The Matrix user is uniquely identified by their identifier. This User type @@ -28,10 +29,18 @@ Since the username is safely parsed, one can get these parts of the username. @docs localpart, domain + +## JSON + +@docs coder + -} +import Internal.Config.Log as Log exposing (log) import Internal.Grammar.ServerName as ServerName import Internal.Grammar.UserId as UserId +import Internal.Tools.Json as Json +import Parser as P {-| The Matrix user represents a user across multiple Matrix rooms. @@ -40,6 +49,30 @@ type alias User = UserId.UserID +{-| Define a method to encode/decode Matrix users. +-} +coder : Json.Coder User +coder = + Json.parser + { name = "Username" + , p = + P.andThen + (\name -> + P.succeed + ( name + , if UserId.isHistorical name then + [ log.warn "Historical user found" + ] + + else + [] + ) + ) + UserId.userIdParser + , toString = UserId.toString + } + + {-| The domain represents the Matrix homeserver controlling this user. It also offers other Matrix homeservers an indication of where to look if you wish to send a message to this user. diff --git a/src/Matrix/Event.elm b/src/Matrix/Event.elm index da6e114..c234555 100644 --- a/src/Matrix/Event.elm +++ b/src/Matrix/Event.elm @@ -122,9 +122,10 @@ roomId (Event event) = {-| Determine the fully-qualified ID of the user who sent an event. -} -sender : Event -> String +sender : Event -> Types.User sender (Event event) = - Envelope.extract .sender event + Envelope.map .sender event + |> Types.User {-| Determine an event's state key. diff --git a/tests/Test/Filter/Timeline.elm b/tests/Test/Filter/Timeline.elm index 6e880e7..a9f7813 100644 --- a/tests/Test/Filter/Timeline.elm +++ b/tests/Test/Filter/Timeline.elm @@ -3,6 +3,7 @@ module Test.Filter.Timeline exposing (..) import Expect import Fuzz exposing (Fuzzer) import Internal.Filter.Timeline as Filter exposing (Filter) +import Internal.Grammar.UserId as U import Internal.Values.Event as Event import Json.Decode as D import Json.Encode as E @@ -86,7 +87,7 @@ suite = "Only event sender filter matches" (\event -> event - |> Filter.match (Filter.onlySenders [ event.sender ]) + |> Filter.match (Filter.onlySenders [ U.toString event.sender ]) |> Expect.equal True ) , fuzz TestEvent.fuzzer @@ -100,7 +101,7 @@ suite = "Not event sender filter doesn't match" (\event -> event - |> Filter.match (Filter.allSendersExcept [ event.sender ]) + |> Filter.match (Filter.allSendersExcept [ U.toString event.sender ]) |> Expect.equal False ) , fuzz2 TestEvent.fuzzer @@ -109,7 +110,7 @@ suite = (\event senders -> event |> Filter.match (Filter.onlySenders senders) - |> Expect.equal (List.member event.sender senders) + |> Expect.equal (List.member (U.toString event.sender) senders) ) , fuzz2 TestEvent.fuzzer (Fuzz.list Fuzz.string) @@ -125,7 +126,7 @@ suite = (\event senders -> event |> Filter.match (Filter.allSendersExcept senders) - |> Expect.notEqual (List.member event.sender senders) + |> Expect.notEqual (List.member (U.toString event.sender) senders) ) , fuzz2 TestEvent.fuzzer (Fuzz.list Fuzz.string) @@ -302,7 +303,7 @@ suite = l2 = List.filter (\e -> - List.member e.sender senders + List.member (U.toString e.sender) senders && List.member e.eventType types ) events @@ -336,8 +337,8 @@ suite = l2 = List.filter (\e -> - List.member e.sender senders - && (not <| List.member e.eventType types) + List.member (U.toString e.sender) senders + && (not <| List.member (U.toString e.sender) types) ) events in @@ -370,7 +371,7 @@ suite = l2 = List.filter (\e -> - (not <| List.member e.sender senders) + (not <| List.member (U.toString e.sender) senders) && List.member e.eventType types ) events @@ -404,7 +405,7 @@ suite = l2 = List.filter (\e -> - (not <| List.member e.sender senders) + (not <| List.member (U.toString e.sender) senders) && (not <| List.member e.eventType types) ) events diff --git a/tests/Test/Grammar/UserId.elm b/tests/Test/Grammar/UserId.elm index f613902..99ece77 100644 --- a/tests/Test/Grammar/UserId.elm +++ b/tests/Test/Grammar/UserId.elm @@ -2,6 +2,7 @@ module Test.Grammar.UserId exposing (..) import Expect import Fuzz exposing (Fuzzer) +import Internal.Grammar.ServerName as SN import Internal.Grammar.UserId as U import Test exposing (..) import Test.Grammar.ServerName as ServerName @@ -77,6 +78,13 @@ userFuzzer = Fuzz.oneOf [ modernUserFuzzer, historicalUserFuzzer ] +fullUserFuzzer : Fuzzer U.UserID +fullUserFuzzer = + userFuzzer + |> Fuzz.map U.fromString + |> Fuzz.map (Maybe.withDefault { localpart = "a", domain = { host = SN.DNS "a", port_ = Nothing } }) + + suite : Test suite = describe "UserId" diff --git a/tests/Test/Tools/Hashdict.elm b/tests/Test/Tools/Hashdict.elm index cdfdf43..7eb3bbf 100644 --- a/tests/Test/Tools/Hashdict.elm +++ b/tests/Test/Tools/Hashdict.elm @@ -115,7 +115,7 @@ suite = (\event -> Hashdict.singleton .eventId event |> Hashdict.remove event - |> Hashdict.isEqual (Hashdict.empty .sender) + |> Hashdict.isEqual (Hashdict.empty .roomId) |> Expect.equal True ) , fuzz TestEvent.fuzzer @@ -123,7 +123,7 @@ suite = (\event -> Hashdict.singleton .eventId event |> Hashdict.removeKey event.eventId - |> Hashdict.isEqual (Hashdict.empty .sender) + |> Hashdict.isEqual (Hashdict.empty .roomId) |> Expect.equal True ) , fuzz TestEvent.fuzzer diff --git a/tests/Test/Values/Event.elm b/tests/Test/Values/Event.elm index bee07ba..35ba18e 100644 --- a/tests/Test/Values/Event.elm +++ b/tests/Test/Values/Event.elm @@ -5,6 +5,7 @@ import Fuzz exposing (Fuzzer) import Internal.Values.Event as Event exposing (Event) import Json.Encode as E import Test exposing (..) +import Test.Grammar.UserId as UserId import Test.Tools.Timestamp as TestTimestamp @@ -15,7 +16,7 @@ fuzzer = Fuzz.string TestTimestamp.fuzzer Fuzz.string - Fuzz.string + UserId.fullUserFuzzer (Fuzz.maybe Fuzz.string) Fuzz.string (Fuzz.maybe unsignedDataFuzzer) From 086e491b06a6b52a82fecb98d96f89e8b8c6202d Mon Sep 17 00:00:00 2001 From: Bram Date: Fri, 12 Apr 2024 14:30:33 +0200 Subject: [PATCH 14/14] Ignore decoder logs Specifically on Hashdict/Mashdict as they variate based on JSON input --- tests/Test/Tools/Hashdict.elm | 4 ++-- tests/Test/Tools/Mashdict.elm | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/tests/Test/Tools/Hashdict.elm b/tests/Test/Tools/Hashdict.elm index 7eb3bbf..2243bf0 100644 --- a/tests/Test/Tools/Hashdict.elm +++ b/tests/Test/Tools/Hashdict.elm @@ -168,8 +168,8 @@ suite = |> Json.encode (Hashdict.coder .eventId Event.coder) |> E.encode indent |> D.decodeString (Json.decode <| Hashdict.coder .eventId Event.coder) - |> Result.map (Tuple.mapFirst Hashdict.toList) - |> Expect.equal (Ok ( Hashdict.toList hashdict, [] )) + |> Result.map (Tuple.first >> Hashdict.toList) + |> Expect.equal (Ok (Hashdict.toList hashdict)) ) ] ] diff --git a/tests/Test/Tools/Mashdict.elm b/tests/Test/Tools/Mashdict.elm index 0425dc0..ee93b99 100644 --- a/tests/Test/Tools/Mashdict.elm +++ b/tests/Test/Tools/Mashdict.elm @@ -198,8 +198,8 @@ suite = |> Json.encode (Mashdict.coder .stateKey Event.coder) |> E.encode indent |> D.decodeString (Json.decode <| Mashdict.coder .stateKey Event.coder) - |> Result.map (Tuple.mapFirst Mashdict.toList) - |> Expect.equal (Ok ( Mashdict.toList hashdict, [] )) + |> Result.map (Tuple.first >> Mashdict.toList) + |> Expect.equal (Ok (Mashdict.toList hashdict)) ) ] ]