Add server name module

parser
Bram 2024-04-09 20:38:35 +02:00
parent 077605bcbc
commit cd0c687307
4 changed files with 250 additions and 45 deletions

View File

@ -1,13 +1,29 @@
module Internal.Grammar.ServerName exposing (..) module Internal.Grammar.ServerName exposing
{-| A homeserver is uniquely identified by its server name. The server name ( 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 represents the address at which the homeserver in question can be reached by
other homeservers. other homeservers.
@docs ServerName, toString, fromString
## Parser
@docs serverNameParser
-} -}
import Internal.Tools.ParserExtra as PE import Internal.Tools.ParserExtra as PE
import Parser as P exposing (Parser, (|.), (|=)) 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. {-| 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 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 specification of DNS names, however, and RFC1123 (section 2.1) does not require
a client to distinguish them, we treat IPv4Addresses like DNS names. a client to distinguish them, we treat IPv4Addresses like DNS names.
-} -}
type HostName type HostName
= DNS String = DNS String
| IPv6 IPv6Address | IPv6 IPv6Address
{-| The IPv6Address is represented by a list of items BEFORE and AFTER the {-| The IPv6Address is represented by a list of items BEFORE and AFTER the
double colons (::). 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. {-| 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 {-| 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 standard for internet host names, as specified by RFC1123, section 2.1, with an
@ -52,6 +74,7 @@ extension IPv6 literals.
they serve to delimit components of "domain style names". (See they serve to delimit components of "domain style names". (See
RFC-921, "Domain Name System Implementation Schedule", for RFC-921, "Domain Name System Implementation Schedule", for
background). background).
-} -}
dnsNameParser : Parser String dnsNameParser : Parser String
dnsNameParser = dnsNameParser =
@ -59,6 +82,23 @@ dnsNameParser =
|. P.chompWhile (\c -> Char.isAlphaNum c || c == '-' || c == '.') |. P.chompWhile (\c -> Char.isAlphaNum c || c == '-' || c == '.')
|> P.getChompedString |> 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. {-| Parse a Hostname.
-} -}
hostnameParser : Parser HostName hostnameParser : Parser HostName
@ -72,6 +112,7 @@ hostnameParser =
|= dnsNameParser |= dnsNameParser
] ]
{-| Parse all values to the left of the double colon (::) {-| Parse all values to the left of the double colon (::)
-} -}
ipv6LeftParser : Parser (List String) ipv6LeftParser : Parser (List String)
@ -82,12 +123,13 @@ ipv6LeftParser =
, P.succeed (|>) , P.succeed (|>)
|= PE.times 1 7 (ipv6NumParser |. P.symbol ":") |= PE.times 1 7 (ipv6NumParser |. P.symbol ":")
|= P.oneOf |= P.oneOf
[ P.succeed (\bottom tail -> tail ++ [bottom]) [ P.succeed (\bottom tail -> tail ++ [ bottom ])
|= ipv6NumParser |= ipv6NumParser
, P.succeed identity , P.succeed identity
] ]
] ]
{-| Parse an ordinary IPv6 number {-| Parse an ordinary IPv6 number
-} -}
ipv6NumParser : Parser String ipv6NumParser : Parser String
@ -97,6 +139,7 @@ ipv6NumParser =
|> PE.times 1 4 |> PE.times 1 4
|> P.map String.concat |> P.map String.concat
{-| Parse an IPv6 Address {-| Parse an IPv6 Address
-} -}
ipv6Parser : Parser IPv6Address ipv6Parser : Parser IPv6Address
@ -108,37 +151,47 @@ ipv6Parser =
|= ipv6RightParser (8 - List.length front) |= ipv6RightParser (8 - List.length front)
) )
{-| Parse all values to the right of the double colon (::) {-| Parse all values to the right of the double colon (::)
-} -}
ipv6RightParser : Int -> Parser (List String) ipv6RightParser : Int -> Parser (List String)
ipv6RightParser n = ipv6RightParser n =
if n > 0 then
P.succeed identity P.succeed identity
|. P.symbol ":" |. P.symbol ":"
|= P.oneOf |= P.oneOf
[ P.succeed (::) [ P.succeed (::)
|= ipv6NumParser |= ipv6NumParser
|= PE.times 1 (n - 1) |= PE.times 0
( P.succeed identity (n - 1)
(P.succeed identity
|. P.symbol ":" |. P.symbol ":"
|= ipv6NumParser |= ipv6NumParser
) )
, P.succeed [] , P.succeed []
] ]
else
P.succeed []
{-| Convert an IPv6 address to a readable string format {-| Convert an IPv6 address to a readable string format
-} -}
ipv6ToString : IPv6Address -> String ipv6ToString : IPv6Address -> String
ipv6ToString { front, back } = ipv6ToString { front, back } =
( if List.length front == 8 then (if List.length front == 8 then
front front
else if List.length back == 8 then else if List.length back == 8 then
back back
else else
List.concat [ front, [""], back ] List.concat [ front, [ "" ], back ]
) )
|> List.intersperse ":" |> List.intersperse ":"
|> String.concat |> String.concat
portParser : Parser Int portParser : Parser Int
portParser = portParser =
P.chompIf Char.isDigit P.chompIf Char.isDigit
@ -148,8 +201,9 @@ portParser =
(\v -> (\v ->
case String.toInt v of case String.toInt v of
Just i -> Just i ->
if 0 <= i && i <= 2^16 - 1 then if 0 <= i && i <= 2 ^ 16 - 1 then
P.succeed i P.succeed i
else else
P.problem ("Port out of range: " ++ v) P.problem ("Port out of range: " ++ v)
@ -157,9 +211,10 @@ portParser =
P.problem "Not a port number" P.problem "Not a port number"
) )
servernameParser : Parser ServerName servernameParser : Parser ServerName
servernameParser = servernameParser =
P.succeed (\h p -> ServerName { host = h, port_ = p } ) P.succeed (\h p -> ServerName { host = h, port_ = p })
|= hostnameParser |= hostnameParser
|= P.oneOf |= P.oneOf
[ P.succeed Just [ P.succeed Just
@ -168,6 +223,7 @@ servernameParser =
, P.succeed Nothing , P.succeed Nothing
] ]
toString : ServerName -> String toString : ServerName -> String
toString (ServerName { host, port_ }) = toString (ServerName { host, port_ }) =
let let
@ -178,15 +234,21 @@ toString (ServerName { host, port_ }) =
name name
IPv6 { front, back } -> IPv6 { front, back } ->
( if List.length front == 8 then (if List.length front == 8 then
front List.intersperse ":" front
else if List.length back == 8 then else if List.length back == 8 then
back List.intersperse ":" back
else else
List.concat [ front, [""], back ] List.concat
[ List.intersperse ":" front
, [ "::" ]
, List.intersperse ":" back
]
) )
|> List.intersperse ":"
|> String.concat |> String.concat
|> (\i -> "[" ++ i ++ "]")
portString : String portString : String
portString = portString =

View File

@ -1,5 +1,9 @@
module Internal.Grammar.UserId exposing (..) module Internal.Grammar.UserId exposing (..)
{-| # User ids
{-|
# User ids
Users within Matrix are uniquely identified by their Matrix user ID. The user 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: 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 @localpart:domain
The localpart of a user ID is an opaque identifier for that user. It MUST NOT 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 domain of a user ID is the server name of the homeserver which allocated
the account. the account.
@ -36,9 +40,17 @@ localparts from the expanded character set:
import Internal.Grammar.ServerName as ServerName exposing (ServerName) import Internal.Grammar.ServerName as ServerName exposing (ServerName)
import Internal.Tools.ParserExtra as PE 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 : Parser String
localpartParser = localpartParser =
@ -47,22 +59,26 @@ localpartParser =
|> PE.times 1 255 |> PE.times 1 255
|> P.map String.concat |> P.map String.concat
toString : UserID -> String toString : UserID -> String
toString (UserID { localpart, domain }) = toString (UserID { localpart, domain }) =
String.concat [ "@", localpart, ":", ServerName.toString domain ] String.concat [ "@", localpart, ":", ServerName.toString domain ]
userIdParser : Parser UserID userIdParser : Parser UserID
userIdParser = userIdParser =
P.succeed (\l d -> UserID { localpart = l, domain = d } ) P.succeed (\l d -> UserID { localpart = l, domain = d })
|. P.symbol "@" |. P.symbol "@"
|= localpartParser |= localpartParser
|. P.symbol ":" |. P.symbol ":"
|= ServerName.servernameParser |= ServerName.servernameParser
validHistoricalUsernameChar : Char -> Bool validHistoricalUsernameChar : Char -> Bool
validHistoricalUsernameChar c = validHistoricalUsernameChar c =
let let
i : Int i : Int
i = Char.toCode c i =
Char.toCode c
in in
(0x21 <= i && i <= 0x39) || (0x3B <= i && i <= 0x7E) (0x21 <= i && i <= 0x39) || (0x3B <= i && i <= 0x7E)

View File

@ -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)
)
]
]