138 lines
5.4 KiB
Plaintext
138 lines
5.4 KiB
Plaintext
module Test.Main where
|
|
|
|
import Prelude (Unit, discard, show, ($), (<>), (==))
|
|
import Data.Either (Either(..))
|
|
import Data.Maybe (Maybe(..), maybe)
|
|
import Data.String.CodeUnits (fromCharArray)
|
|
import Effect.Console (log)
|
|
import Effect (Effect, foreachE)
|
|
|
|
import GenericParser.Parser (Parser(..))
|
|
import GenericParser.Parser as P
|
|
import GenericParser.DomainParser.Common (ldh_str, DomainError(..))
|
|
import GenericParser.DomainParserRFC1035 as RFC1035
|
|
import GenericParser.DomainParser as ModernDomains
|
|
import GenericParser.IPAddress (IPv4Error(..))
|
|
import GenericParser.IPAddress as IP
|
|
import GenericParser.EmailAddress as EA
|
|
import GenericParser.RFC5322 as E
|
|
import Test.TestValues as T
|
|
|
|
run :: forall e v. Parser e v -> String -> P.Result e v
|
|
run (Parser p) str = p { string: str, position: 0 }
|
|
|
|
data COMPARISON = SAME | DIFFERENT | FAILED
|
|
compare_results :: forall e v. Parser e v -> Parser e v -> String -> COMPARISON
|
|
compare_results p1 p2 str
|
|
= let e1 = run p1 str
|
|
e2 = run p2 str
|
|
in case e1, e2 of
|
|
Right r1, Right r2 -> if r1.suffix == r2.suffix
|
|
then SAME
|
|
else DIFFERENT
|
|
_, _ -> FAILED
|
|
|
|
compare_parsers :: forall e v. String -> Parser e v -> Parser e v -> String -> Effect Unit
|
|
compare_parsers s p1 p2 str
|
|
= log $ s <> " "
|
|
<> case compare_results p1 p2 str of
|
|
SAME -> "SAME"
|
|
DIFFERENT -> "DIFFERENT"
|
|
FAILED -> "FAILED"
|
|
<> " [" <> str <>"] "
|
|
|
|
logtest :: forall e v. String -> Parser e v -> String -> (v -> String) -> (e -> String) -> Effect Unit
|
|
logtest fname (Parser p) str r e = do
|
|
log $ "(" <> fname <> ") parsing '" <> str <> "': "
|
|
<> case p { string: str, position: 0 } of
|
|
Left { position, error } -> "failed at position " <> show position <> case error of
|
|
Nothing -> " -> no error reported"
|
|
Just err -> " -> error: " <> e err
|
|
Right { suffix, result } -> ">[" <> (r result) <> "]< '" <> suffix.string <> "'"
|
|
|
|
id :: forall a. a -> a
|
|
id a = a
|
|
|
|
showerror :: DomainError -> String
|
|
showerror (LabelTooLarge size) = "LabelTooLarge (size: " <> show size <> ")"
|
|
showerror (DomainTooLarge size) = "DomainTooLarge (size: " <> show size <> ")"
|
|
showerror (InvalidCharacter) = "InvalidCharacter"
|
|
showerror (EOFExpected) = "EOFExpected"
|
|
|
|
test_series :: forall e v
|
|
. String
|
|
-> Parser e v
|
|
-> (v -> String)
|
|
-> (e -> String)
|
|
-> Array String
|
|
-> Effect Unit
|
|
test_series l p v e a = foreachE a (\s -> logtest l p s v e)
|
|
|
|
showerror_ipv6 :: IP.IPv6Error -> String
|
|
showerror_ipv6 (IP.IP6TooManyHexaDecimalCharacters) = "TooManyHexaDecimalCharacters"
|
|
showerror_ipv6 (IP.IP6NotEnoughChunks) = "NotEnoughChunks"
|
|
showerror_ipv6 (IP.IP6TooManyChunks) = "TooManyChunks"
|
|
showerror_ipv6 IP.IP6IrrelevantShortRepresentation = "useless double dots"
|
|
showerror_ipv6 IP.IP6InvalidRange = "invalid IPv6 range"
|
|
|
|
showerror_ipv4 :: IP.IPv4Error -> String
|
|
showerror_ipv4 (IP4NumberTooBig x) = "value '" <> show x <> "' is > 255"
|
|
showerror_ipv4 IP4IrrelevantShortRepresentation = "useless double dots"
|
|
showerror_ipv4 IP4InvalidRange = "invalid IPv4 range"
|
|
|
|
showerror_email :: EA.EmailError -> String
|
|
showerror_email EA.InvalidCharacter = "InvalidCharacter"
|
|
showerror_email (EA.InvalidDomain e) = "invalid domain: " <> maybe "no domain error provided, weird" showerror e
|
|
|
|
main :: Effect Unit
|
|
main = do
|
|
test_series "ldh_str" ldh_str fromCharArray showerror T.domains
|
|
log ""
|
|
test_series "RFC1035.label" RFC1035.label id showerror T.domains
|
|
log ""
|
|
test_series "RFC1035.subdomain" RFC1035.subdomain id showerror T.domains
|
|
log ""
|
|
test_series "RFC1035.sub_eof" RFC1035.sub_eof id showerror T.domains
|
|
log ""
|
|
test_series "RFC1035.domain" RFC1035.domain id showerror T.domains
|
|
log ""
|
|
test_series "ModernDomains.domain" ModernDomains.domain id showerror T.domains
|
|
|
|
log ""
|
|
test_series "IP.ipv4" IP.ipv4 id showerror_ipv4 T.ipv4_addresses
|
|
|
|
log ""
|
|
test_series "IP.ipv6" IP.ipv6 id showerror_ipv6 T.ipv6_addresses
|
|
|
|
log ""
|
|
test_series "EA.email" EA.email id showerror_email T.valid_email_addresses
|
|
|
|
log ""
|
|
test_series "E.address (short)" E.address id showerror_email T.valid_email_addresses_short
|
|
|
|
log ""
|
|
let spaces = [ """" """", """ " """" ]
|
|
lreturns = [ """" \r\nx"""", """ "\r\n"""", """ "\r\n """" ]
|
|
characters = [ "\r", "\n", "\"" ]
|
|
test_series "E.quoted_string (short)" E.quoted_string id showerror_email spaces
|
|
test_series "E.qcontent (short)" E.qcontent id showerror_email spaces
|
|
|
|
test_series "E.quoted_string (lreturns)" E.quoted_string id showerror_email lreturns
|
|
test_series "E.qcontent (characters)" E.qcontent id showerror_email characters
|
|
|
|
log ""
|
|
let quotedstrings = [ """" "spaces?""", """ " " """ ]
|
|
test_series "E.quoted_string---------------" E.quoted_string id showerror_email quotedstrings
|
|
test_series "P.read_input (E.quoted_string)" (P.read_input E.quoted_string) id showerror_email quotedstrings
|
|
|
|
log "Does parsers behave correctly (give the exact same input)?"
|
|
foreachE T.valid_email_addresses_short (\s -> compare_parsers "E.address" (P.read_input E.address) E.address s)
|
|
|
|
log ""
|
|
let ip4ranges = [ "10.0.0.1/24", "192.168.0.1/32", "1.2.3.4/0", "192.168.0.1/33" ]
|
|
test_series "IP.ipv4_range" IP.ipv4_range id showerror_ipv4 ip4ranges
|
|
|
|
log ""
|
|
let ip6ranges = [ "2001::1/56", "2001:1:1::1/0", "::1/128", "::1/129" ]
|
|
test_series "IP.ipv6_range" IP.ipv6_range id showerror_ipv6 ip6ranges
|