addressbook/test/Test/Data/Email/Header.hs
Mats Rauhala 41c666fe93 Make the analysis parallel (#2)
Co-authored-by: Mats Rauhala <mats.rauhala@iki.fi>
Reviewed-on: #2
Co-authored-by: Mats Rauhala <masse@rauhala.info>
Co-committed-by: Mats Rauhala <masse@rauhala.info>
2021-10-29 22:41:46 +03:00

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