74 lines
2.3 KiB
Haskell
74 lines
2.3 KiB
Haskell
{-# LANGUAGE OverloadedLists #-}
|
|
module Test.Data.Email.Header where
|
|
|
|
import Test.Tasty
|
|
import Test.Tasty.Hedgehog
|
|
import Test.Tasty.HUnit
|
|
|
|
import Hedgehog
|
|
import qualified Hedgehog.Corpus as Corpus
|
|
import qualified Hedgehog.Gen as Gen
|
|
import qualified Hedgehog.Range as Range
|
|
|
|
import Data.ByteString
|
|
import qualified Data.ByteString as T
|
|
import qualified Data.Vector as V
|
|
|
|
import Data.Email.Header
|
|
import qualified Data.ByteString.Char8 as BC
|
|
|
|
genHeader :: Gen Header
|
|
genHeader = Gen.choice
|
|
[ From <$> genEmail
|
|
, To . V.fromList <$> Gen.list (Range.linear 0 10) genEmail
|
|
]
|
|
|
|
genEmail :: Gen ByteString
|
|
genEmail = do
|
|
name <- Gen.element Corpus.simpsons
|
|
domain <- Gen.element Corpus.cooking
|
|
tld <- Gen.element ["com","fi","org"]
|
|
pure $ name <> "@" <> domain <> "." <> tld
|
|
|
|
wrapped :: Char -> ByteString -> Char -> ByteString
|
|
wrapped l x r = BC.singleton l <> x <> BC.singleton r
|
|
|
|
genComment :: Gen ByteString
|
|
genComment = do
|
|
x <- Gen.element Corpus.simpsons
|
|
Gen.element [x, wrapped '"' x '"']
|
|
|
|
prop_roundtrip_parse :: Property
|
|
prop_roundtrip_parse = property $ do
|
|
header <- forAll genHeader
|
|
tripping header encode decode
|
|
|
|
prop_parse_from :: Property
|
|
prop_parse_from = property $ do
|
|
email <- forAll genEmail
|
|
decode ("From: " <> email) === Right (From email)
|
|
|
|
prop_parse_from_and_comments :: Property
|
|
prop_parse_from_and_comments = property $ do
|
|
(email, comment) <- forAll $ (,) <$> genEmail <*> genComment
|
|
let line = "From: " <> comment <> " " <> wrapped '<' email '>'
|
|
annotateShow line
|
|
decode line === Right (From email)
|
|
|
|
prop_parse_to_and_comments :: Property
|
|
prop_parse_to_and_comments = property $ do
|
|
emails <- forAll $ Gen.list (Range.linear 1 10) ((,) <$> genEmail <*> genComment)
|
|
let wanted = V.fromList $ fmap fst emails
|
|
let line = "To: " <> T.intercalate ", " (fmap (\(e,c) -> c <> " " <> wrapped '<' e '>') emails)
|
|
annotateShow line
|
|
decode line === Right (To wanted)
|
|
|
|
tests :: TestTree
|
|
tests = testGroup "Data.Email.Header"
|
|
[ testProperty "roundtrip property" $ prop_roundtrip_parse
|
|
, testProperty "any email can be read as from" $ prop_parse_from
|
|
, testProperty "any email with comments can be parsed" $ prop_parse_from_and_comments
|
|
, testProperty "any list of emails with comments can be parsed" $ prop_parse_to_and_comments
|
|
, testCase "can parse sourcehut" $ decode "From: sourcehut <outgoing@sr.ht>" @?= Right (From "outgoing@sr.ht")
|
|
]
|