email-validate 0.2.8 → 0.3.1
raw patch · 46 files changed
+835/−359 lines, 46 filessetup-changedbinary-addedPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Text.Email.Validate: addrSpec :: Parsec String () Int
Files
- .git/HEAD +1/−0
- .git/config +14/−0
- .git/description +1/−0
- .git/hooks/applypatch-msg.sample +15/−0
- .git/hooks/commit-msg.sample +24/−0
- .git/hooks/post-update.sample +8/−0
- .git/hooks/pre-applypatch.sample +14/−0
- .git/hooks/pre-commit.sample +50/−0
- .git/hooks/pre-rebase.sample +169/−0
- .git/hooks/prepare-commit-msg.sample +36/−0
- .git/hooks/update.sample +128/−0
- .git/index binary
- .git/info/exclude +6/−0
- .git/logs/HEAD +1/−0
- .git/logs/refs/heads/master +1/−0
- .git/logs/refs/remotes/origin/HEAD +1/−0
- .git/objects/15/b5b61cf94c1a3f745d249cb27c277506e6b163 binary
- .git/objects/21/2b997b8e6ea14f49212506a6f24add7af4a497 binary
- .git/objects/23/53b6eaeee1c824371c12bad78d4053ec52041d binary
- .git/objects/24/d18fba10dee5c4ce4aa2af9d83aec2514b3fe8 binary
- .git/objects/2d/9f07a20bc1f037e1729cef6419adb04e31cb6a +2/−0
- .git/objects/30/795b93e4270a5a2a3df24d1e41b7e10a24614a binary
- .git/objects/3f/7084c8c996d45e41dd9ddcb0d1e03c6d4693f0 +1/−0
- .git/objects/59/a24bf0dd1195866e5f971ac6d70abdb34a29d3 binary
- .git/objects/5b/de0de962274e26328ecffabb4e9f6430a10cc9 binary
- .git/objects/6b/7e3d59554eef8f09a0fe8699732541b92536dd binary
- .git/objects/79/14ad75ef8004bc68244408f494abb69913f35c binary
- .git/objects/79/4e34c8dcac0093b4b669bf4847ce4fd4b1fd4c +1/−0
- .git/objects/7c/cafa1430896619ca670cc5849ba034b871972b binary
- .git/objects/83/a5e0534a073a57d8bf04c7957cb88be1a3f675 binary
- .git/objects/8c/e32485dfe28fdbee865fe42cb2e9992110d022 binary
- .git/objects/a3/62c7ee447b16dedc823854165c0178c1d37d12 binary
- .git/objects/ab/98b6067c8dea629a6d423255d8f6eca4d9addd binary
- .git/objects/ce/21b8e64947926b006ca76fe444f5536c355703 binary
- .git/objects/d5/3be38fca3a8e4e1a736800e156f0e8be0c0d74 binary
- .git/objects/dc/d45a039547b065e629b98f3a069216070a4032 binary
- .git/objects/e2/b34424ef1cefd7197309a466e1c98bc940215b binary
- .git/objects/e8/9c8a1a38fe8ad397e3dcc9b0eeb30bbfb78433 binary
- .git/objects/f4/d0360b79923043eee16f821b2073b866c56fec binary
- .git/packed-refs +2/−0
- .git/refs/heads/master +1/−0
- .git/refs/remotes/origin/HEAD +1/−0
- LICENSE +30/−30
- Setup.lhs +3/−3
- Text/Email/Validate.hs +323/−324
- email-validate.cabal +2/−2
+ .git/HEAD view
@@ -0,0 +1,1 @@+ref: refs/heads/master
+ .git/config view
@@ -0,0 +1,14 @@+[core]+ repositoryformatversion = 0+ filemode = false+ bare = false+ logallrefupdates = true+ symlinks = false+ ignorecase = true+ hideDotFiles = dotGitOnly+[remote "origin"]+ fetch = +refs/heads/*:refs/remotes/origin/*+ url = https://github.com/Porges/email-validate-hs.git+[branch "master"]+ remote = origin+ merge = refs/heads/master
+ .git/description view
@@ -0,0 +1,1 @@+Unnamed repository; edit this file 'description' to name the repository.
+ .git/hooks/applypatch-msg.sample view
@@ -0,0 +1,15 @@+#!/bin/sh+#+# An example hook script to check the commit log message taken by+# applypatch from an e-mail message.+#+# The hook should exit with non-zero status after issuing an+# appropriate message if it wants to stop the commit. The hook is+# allowed to edit the commit message file.+#+# To enable this hook, rename this file to "applypatch-msg".++. git-sh-setup+test -x "$GIT_DIR/hooks/commit-msg" &&+ exec "$GIT_DIR/hooks/commit-msg" ${1+"$@"}+:
+ .git/hooks/commit-msg.sample view
@@ -0,0 +1,24 @@+#!/bin/sh+#+# An example hook script to check the commit log message.+# Called by "git commit" with one argument, the name of the file+# that has the commit message. The hook should exit with non-zero+# status after issuing an appropriate message if it wants to stop the+# commit. The hook is allowed to edit the commit message file.+#+# To enable this hook, rename this file to "commit-msg".++# Uncomment the below to add a Signed-off-by line to the message.+# Doing this in a hook is a bad idea in general, but the prepare-commit-msg+# hook is more suited to it.+#+# SOB=$(git var GIT_AUTHOR_IDENT | sed -n 's/^\(.*>\).*$/Signed-off-by: \1/p')+# grep -qs "^$SOB" "$1" || echo "$SOB" >> "$1"++# This example catches duplicate Signed-off-by lines.++test "" = "$(grep '^Signed-off-by: ' "$1" |+ sort | uniq -c | sed -e '/^[ ]*1[ ]/d')" || {+ echo >&2 Duplicate Signed-off-by lines.+ exit 1+}
+ .git/hooks/post-update.sample view
@@ -0,0 +1,8 @@+#!/bin/sh+#+# An example hook script to prepare a packed repository for use over+# dumb transports.+#+# To enable this hook, rename this file to "post-update".++exec git update-server-info
+ .git/hooks/pre-applypatch.sample view
@@ -0,0 +1,14 @@+#!/bin/sh+#+# An example hook script to verify what is about to be committed+# by applypatch from an e-mail message.+#+# The hook should exit with non-zero status after issuing an+# appropriate message if it wants to stop the commit.+#+# To enable this hook, rename this file to "pre-applypatch".++. git-sh-setup+test -x "$GIT_DIR/hooks/pre-commit" &&+ exec "$GIT_DIR/hooks/pre-commit" ${1+"$@"}+:
+ .git/hooks/pre-commit.sample view
@@ -0,0 +1,50 @@+#!/bin/sh+#+# An example hook script to verify what is about to be committed.+# Called by "git commit" with no arguments. The hook should+# exit with non-zero status after issuing an appropriate message if+# it wants to stop the commit.+#+# To enable this hook, rename this file to "pre-commit".++if git rev-parse --verify HEAD >/dev/null 2>&1+then+ against=HEAD+else+ # Initial commit: diff against an empty tree object+ against=4b825dc642cb6eb9a060e54bf8d69288fbee4904+fi++# If you want to allow non-ascii filenames set this variable to true.+allownonascii=$(git config hooks.allownonascii)++# Redirect output to stderr.+exec 1>&2++# Cross platform projects tend to avoid non-ascii filenames; prevent+# them from being added to the repository. We exploit the fact that the+# printable range starts at the space character and ends with tilde.+if [ "$allownonascii" != "true" ] &&+ # Note that the use of brackets around a tr range is ok here, (it's+ # even required, for portability to Solaris 10's /usr/bin/tr), since+ # the square bracket bytes happen to fall in the designated range.+ test $(git diff --cached --name-only --diff-filter=A -z $against |+ LC_ALL=C tr -d '[ -~]\0' | wc -c) != 0+then+ echo "Error: Attempt to add a non-ascii file name."+ echo+ echo "This can cause problems if you want to work"+ echo "with people on other platforms."+ echo+ echo "To be portable it is advisable to rename the file ..."+ echo+ echo "If you know what you are doing you can disable this"+ echo "check using:"+ echo+ echo " git config hooks.allownonascii true"+ echo+ exit 1+fi++# If there are whitespace errors, print the offending file names and fail.+exec git diff-index --check --cached $against --
+ .git/hooks/pre-rebase.sample view
@@ -0,0 +1,169 @@+#!/bin/sh+#+# Copyright (c) 2006, 2008 Junio C Hamano+#+# The "pre-rebase" hook is run just before "git rebase" starts doing+# its job, and can prevent the command from running by exiting with+# non-zero status.+#+# The hook is called with the following parameters:+#+# $1 -- the upstream the series was forked from.+# $2 -- the branch being rebased (or empty when rebasing the current branch).+#+# This sample shows how to prevent topic branches that are already+# merged to 'next' branch from getting rebased, because allowing it+# would result in rebasing already published history.++publish=next+basebranch="$1"+if test "$#" = 2+then+ topic="refs/heads/$2"+else+ topic=`git symbolic-ref HEAD` ||+ exit 0 ;# we do not interrupt rebasing detached HEAD+fi++case "$topic" in+refs/heads/??/*)+ ;;+*)+ exit 0 ;# we do not interrupt others.+ ;;+esac++# Now we are dealing with a topic branch being rebased+# on top of master. Is it OK to rebase it?++# Does the topic really exist?+git show-ref -q "$topic" || {+ echo >&2 "No such branch $topic"+ exit 1+}++# Is topic fully merged to master?+not_in_master=`git rev-list --pretty=oneline ^master "$topic"`+if test -z "$not_in_master"+then+ echo >&2 "$topic is fully merged to master; better remove it."+ exit 1 ;# we could allow it, but there is no point.+fi++# Is topic ever merged to next? If so you should not be rebasing it.+only_next_1=`git rev-list ^master "^$topic" ${publish} | sort`+only_next_2=`git rev-list ^master ${publish} | sort`+if test "$only_next_1" = "$only_next_2"+then+ not_in_topic=`git rev-list "^$topic" master`+ if test -z "$not_in_topic"+ then+ echo >&2 "$topic is already up-to-date with master"+ exit 1 ;# we could allow it, but there is no point.+ else+ exit 0+ fi+else+ not_in_next=`git rev-list --pretty=oneline ^${publish} "$topic"`+ /usr/bin/perl -e '+ my $topic = $ARGV[0];+ my $msg = "* $topic has commits already merged to public branch:\n";+ my (%not_in_next) = map {+ /^([0-9a-f]+) /;+ ($1 => 1);+ } split(/\n/, $ARGV[1]);+ for my $elem (map {+ /^([0-9a-f]+) (.*)$/;+ [$1 => $2];+ } split(/\n/, $ARGV[2])) {+ if (!exists $not_in_next{$elem->[0]}) {+ if ($msg) {+ print STDERR $msg;+ undef $msg;+ }+ print STDERR " $elem->[1]\n";+ }+ }+ ' "$topic" "$not_in_next" "$not_in_master"+ exit 1+fi++exit 0++################################################################++This sample hook safeguards topic branches that have been+published from being rewound.++The workflow assumed here is:++ * Once a topic branch forks from "master", "master" is never+ merged into it again (either directly or indirectly).++ * Once a topic branch is fully cooked and merged into "master",+ it is deleted. If you need to build on top of it to correct+ earlier mistakes, a new topic branch is created by forking at+ the tip of the "master". This is not strictly necessary, but+ it makes it easier to keep your history simple.++ * Whenever you need to test or publish your changes to topic+ branches, merge them into "next" branch.++The script, being an example, hardcodes the publish branch name+to be "next", but it is trivial to make it configurable via+$GIT_DIR/config mechanism.++With this workflow, you would want to know:++(1) ... if a topic branch has ever been merged to "next". Young+ topic branches can have stupid mistakes you would rather+ clean up before publishing, and things that have not been+ merged into other branches can be easily rebased without+ affecting other people. But once it is published, you would+ not want to rewind it.++(2) ... if a topic branch has been fully merged to "master".+ Then you can delete it. More importantly, you should not+ build on top of it -- other people may already want to+ change things related to the topic as patches against your+ "master", so if you need further changes, it is better to+ fork the topic (perhaps with the same name) afresh from the+ tip of "master".++Let's look at this example:++ o---o---o---o---o---o---o---o---o---o "next"+ / / / /+ / a---a---b A / /+ / / / /+ / / c---c---c---c B /+ / / / \ /+ / / / b---b C \ /+ / / / / \ /+ ---o---o---o---o---o---o---o---o---o---o---o "master"+++A, B and C are topic branches.++ * A has one fix since it was merged up to "next".++ * B has finished. It has been fully merged up to "master" and "next",+ and is ready to be deleted.++ * C has not merged to "next" at all.++We would want to allow C to be rebased, refuse A, and encourage+B to be deleted.++To compute (1):++ git rev-list ^master ^topic next+ git rev-list ^master next++ if these match, topic has not merged in next at all.++To compute (2):++ git rev-list master..topic++ if this is empty, it is fully merged to "master".
+ .git/hooks/prepare-commit-msg.sample view
@@ -0,0 +1,36 @@+#!/bin/sh+#+# An example hook script to prepare the commit log message.+# Called by "git commit" with the name of the file that has the+# commit message, followed by the description of the commit+# message's source. The hook's purpose is to edit the commit+# message file. If the hook fails with a non-zero status,+# the commit is aborted.+#+# To enable this hook, rename this file to "prepare-commit-msg".++# This hook includes three examples. The first comments out the+# "Conflicts:" part of a merge commit.+#+# The second includes the output of "git diff --name-status -r"+# into the message, just before the "git status" output. It is+# commented because it doesn't cope with --amend or with squashed+# commits.+#+# The third example adds a Signed-off-by line to the message, that can+# still be edited. This is rarely a good idea.++case "$2,$3" in+ merge,)+ /usr/bin/perl -i.bak -ne 's/^/# /, s/^# #/#/ if /^Conflicts/ .. /#/; print' "$1" ;;++# ,|template,)+# /usr/bin/perl -i.bak -pe '+# print "\n" . `git diff --cached --name-status -r`+# if /^#/ && $first++ == 0' "$1" ;;++ *) ;;+esac++# SOB=$(git var GIT_AUTHOR_IDENT | sed -n 's/^\(.*>\).*$/Signed-off-by: \1/p')+# grep -qs "^$SOB" "$1" || echo "$SOB" >> "$1"
+ .git/hooks/update.sample view
@@ -0,0 +1,128 @@+#!/bin/sh+#+# An example hook script to blocks unannotated tags from entering.+# Called by "git receive-pack" with arguments: refname sha1-old sha1-new+#+# To enable this hook, rename this file to "update".+#+# Config+# ------+# hooks.allowunannotated+# This boolean sets whether unannotated tags will be allowed into the+# repository. By default they won't be.+# hooks.allowdeletetag+# This boolean sets whether deleting tags will be allowed in the+# repository. By default they won't be.+# hooks.allowmodifytag+# This boolean sets whether a tag may be modified after creation. By default+# it won't be.+# hooks.allowdeletebranch+# This boolean sets whether deleting branches will be allowed in the+# repository. By default they won't be.+# hooks.denycreatebranch+# This boolean sets whether remotely creating branches will be denied+# in the repository. By default this is allowed.+#++# --- Command line+refname="$1"+oldrev="$2"+newrev="$3"++# --- Safety check+if [ -z "$GIT_DIR" ]; then+ echo "Don't run this script from the command line." >&2+ echo " (if you want, you could supply GIT_DIR then run" >&2+ echo " $0 <ref> <oldrev> <newrev>)" >&2+ exit 1+fi++if [ -z "$refname" -o -z "$oldrev" -o -z "$newrev" ]; then+ echo "Usage: $0 <ref> <oldrev> <newrev>" >&2+ exit 1+fi++# --- Config+allowunannotated=$(git config --bool hooks.allowunannotated)+allowdeletebranch=$(git config --bool hooks.allowdeletebranch)+denycreatebranch=$(git config --bool hooks.denycreatebranch)+allowdeletetag=$(git config --bool hooks.allowdeletetag)+allowmodifytag=$(git config --bool hooks.allowmodifytag)++# check for no description+projectdesc=$(sed -e '1q' "$GIT_DIR/description")+case "$projectdesc" in+"Unnamed repository"* | "")+ echo "*** Project description file hasn't been set" >&2+ exit 1+ ;;+esac++# --- Check types+# if $newrev is 0000...0000, it's a commit to delete a ref.+zero="0000000000000000000000000000000000000000"+if [ "$newrev" = "$zero" ]; then+ newrev_type=delete+else+ newrev_type=$(git cat-file -t $newrev)+fi++case "$refname","$newrev_type" in+ refs/tags/*,commit)+ # un-annotated tag+ short_refname=${refname##refs/tags/}+ if [ "$allowunannotated" != "true" ]; then+ echo "*** The un-annotated tag, $short_refname, is not allowed in this repository" >&2+ echo "*** Use 'git tag [ -a | -s ]' for tags you want to propagate." >&2+ exit 1+ fi+ ;;+ refs/tags/*,delete)+ # delete tag+ if [ "$allowdeletetag" != "true" ]; then+ echo "*** Deleting a tag is not allowed in this repository" >&2+ exit 1+ fi+ ;;+ refs/tags/*,tag)+ # annotated tag+ if [ "$allowmodifytag" != "true" ] && git rev-parse $refname > /dev/null 2>&1+ then+ echo "*** Tag '$refname' already exists." >&2+ echo "*** Modifying a tag is not allowed in this repository." >&2+ exit 1+ fi+ ;;+ refs/heads/*,commit)+ # branch+ if [ "$oldrev" = "$zero" -a "$denycreatebranch" = "true" ]; then+ echo "*** Creating a branch is not allowed in this repository" >&2+ exit 1+ fi+ ;;+ refs/heads/*,delete)+ # delete branch+ if [ "$allowdeletebranch" != "true" ]; then+ echo "*** Deleting a branch is not allowed in this repository" >&2+ exit 1+ fi+ ;;+ refs/remotes/*,commit)+ # tracking branch+ ;;+ refs/remotes/*,delete)+ # delete tracking branch+ if [ "$allowdeletebranch" != "true" ]; then+ echo "*** Deleting a tracking branch is not allowed in this repository" >&2+ exit 1+ fi+ ;;+ *)+ # Anything else (is there anything else?)+ echo "*** Update hook: unknown type of update to ref $refname of type $newrev_type" >&2+ exit 1+ ;;+esac++# --- Finished+exit 0
+ .git/index view
binary file changed (absent → 352 bytes)
+ .git/info/exclude view
@@ -0,0 +1,6 @@+# git ls-files --others --exclude-from=.git/info/exclude+# Lines that start with '#' are comments.+# For a project mostly in C, the following would be a good set of+# exclude patterns (uncomment them if you want to use them):+# *.[oa]+# *~
+ .git/logs/HEAD view
@@ -0,0 +1,1 @@+0000000000000000000000000000000000000000 2353b6eaeee1c824371c12bad78d4053ec52041d George Pollard <porges@porg.es> 1353548294 +1300 clone: from https://github.com/Porges/email-validate-hs.git
+ .git/logs/refs/heads/master view
@@ -0,0 +1,1 @@+0000000000000000000000000000000000000000 2353b6eaeee1c824371c12bad78d4053ec52041d George Pollard <porges@porg.es> 1353548294 +1300 clone: from https://github.com/Porges/email-validate-hs.git
+ .git/logs/refs/remotes/origin/HEAD view
@@ -0,0 +1,1 @@+0000000000000000000000000000000000000000 2353b6eaeee1c824371c12bad78d4053ec52041d George Pollard <porges@porg.es> 1353548294 +1300 clone: from https://github.com/Porges/email-validate-hs.git
+ .git/objects/15/b5b61cf94c1a3f745d249cb27c277506e6b163 view
binary file changed (absent → 47 bytes)
+ .git/objects/21/2b997b8e6ea14f49212506a6f24add7af4a497 view
binary file changed (absent → 178 bytes)
+ .git/objects/23/53b6eaeee1c824371c12bad78d4053ec52041d view
binary file changed (absent → 235 bytes)
+ .git/objects/24/d18fba10dee5c4ce4aa2af9d83aec2514b3fe8 view
binary file changed (absent → 160 bytes)
+ .git/objects/2d/9f07a20bc1f037e1729cef6419adb04e31cb6a view
@@ -0,0 +1,2 @@+xRÁjÜ0í5ú9åP"9ñ²MYPºÝBIné]¶&¶@¶FYÈÇw¤µ7ôZ-üf43ï½ioàövýnÔnàíÁA['µ³F'ÏÉúñqjõQ8ÛâHo÷>¾¬P>YW"?¾owÐSê}<Woèc°÷Îéh÷¿8§ü»³éS>ÒèýAwçæ}JaSUs¼jïª mLD¢ Ódà0Ê'MÁGÛ$ZæÛùx\&ý/IÐqô,-à0vì@PúÀÜ(ÅwÌüúº õª® Aj£ iÑñj4uF¦cy+AI7ÖÙ´/£uL¨ÑlåÙÁ{¸Qä§Ø¢<ÙÄ¡GmÄÅ©|g¸på(ó/ËËß~jTëj_5^Eö¤òEÞ&êxy£NC8V°ÑÀCÔpy w°¾ #a±º×W¸ç¨ºQï¯ êmÏ¡¼ru©×õôEG®&Ö¢ l/#ÏÊàv¿1¦ 6CÚpYòl¬Úå=W³(þ,eö
+ .git/objects/30/795b93e4270a5a2a3df24d1e41b7e10a24614a view
binary file changed (absent → 56 bytes)
+ .git/objects/3f/7084c8c996d45e41dd9ddcb0d1e03c6d4693f0 view
@@ -0,0 +1,1 @@+x+)JMU0¶d040031QKÌÉLI,IÕË(fÈ®³õ{ßϹà_ÛÌbUǪfwceï
+ .git/objects/59/a24bf0dd1195866e5f971ac6d70abdb34a29d3 view
binary file changed (absent → 47 bytes)
+ .git/objects/5b/de0de962274e26328ecffabb4e9f6430a10cc9 view
binary file changed (absent → 88 bytes)
+ .git/objects/6b/7e3d59554eef8f09a0fe8699732541b92536dd view
binary file changed (absent → 5283 bytes)
+ .git/objects/79/14ad75ef8004bc68244408f494abb69913f35c view
binary file changed (absent → 161 bytes)
+ .git/objects/79/4e34c8dcac0093b4b669bf4847ce4fd4b1fd4c view
@@ -0,0 +1,1 @@+xRÁjÜ0íY_1§J$g½¤ KJ·ÛR(ÍÒ ¹KÖÄÈÐÈ!ùøµö^k° ßfæ½7ÆoVÝãÞìµóòE{guFñ\ÎWªV7»z¿÷õðm½òÙùùõs»û}Ø =æ.¤sø!µûà½NVp¿!ósÊ¿a¸S6} t/ºÐcÔí¹ysÜTÕ¯mu"¡MH´a\=&ù¬)óѲ )aEÃ|ÛˤøÉÑ>qCzÒæ>@9¼e6áÏ÷-\¯ëZX¤&¹ÿ§·2ãÌûPÊÚ8ïò24¾FL®GVÔ3!£Ùʳ÷w°RÆÔ L¹Ì¡CmÅ´§ËåÏ¥ÍÌßn4ª }µ/¶ÌJ/ë";RÓ]Þt:"§Ñ-F,ëh4!ð(5\\À-\_BÔ°°µº·7¸ã¨Z©ôÀæO¡iñêR¯í\M>Ô¢ l¯$ÏÊàv¿1&m¶£GÚpYõÉ^µ¶]Í øI÷
+ .git/objects/7c/cafa1430896619ca670cc5849ba034b871972b view
binary file changed (absent → 809 bytes)
+ .git/objects/83/a5e0534a073a57d8bf04c7957cb88be1a3f675 view
binary file changed (absent → 160 bytes)
+ .git/objects/8c/e32485dfe28fdbee865fe42cb2e9992110d022 view
binary file changed (absent → 5277 bytes)
+ .git/objects/a3/62c7ee447b16dedc823854165c0178c1d37d12 view
binary file changed (absent → 136 bytes)
+ .git/objects/ab/98b6067c8dea629a6d423255d8f6eca4d9addd view
binary file changed (absent → 161 bytes)
+ .git/objects/ce/21b8e64947926b006ca76fe444f5536c355703 view
binary file changed (absent → 182 bytes)
+ .git/objects/d5/3be38fca3a8e4e1a736800e156f0e8be0c0d74 view
binary file changed (absent → 56 bytes)
+ .git/objects/dc/d45a039547b065e629b98f3a069216070a4032 view
binary file changed (absent → 440 bytes)
+ .git/objects/e2/b34424ef1cefd7197309a466e1c98bc940215b view
binary file changed (absent → 48 bytes)
+ .git/objects/e8/9c8a1a38fe8ad397e3dcc9b0eeb30bbfb78433 view
binary file changed (absent → 167 bytes)
+ .git/objects/f4/d0360b79923043eee16f821b2073b866c56fec view
binary file changed (absent → 5281 bytes)
+ .git/packed-refs view
@@ -0,0 +1,2 @@+# pack-refs with: peeled +2353b6eaeee1c824371c12bad78d4053ec52041d refs/remotes/origin/master
+ .git/refs/heads/master view
@@ -0,0 +1,1 @@+2353b6eaeee1c824371c12bad78d4053ec52041d
+ .git/refs/remotes/origin/HEAD view
@@ -0,0 +1,1 @@+ref: refs/remotes/origin/master
LICENSE view
@@ -1,30 +1,30 @@-Copyright (c) 2009 George Pollard--All rights reserved.--Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions-are met:--1. Redistributions of source code must retain the above copyright- notice, this list of conditions and the following disclaimer.--2. Redistributions in binary form must reproduce the above copyright- notice, this list of conditions and the following disclaimer in the- documentation and/or other materials provided with the distribution.--3. Neither the name of the author nor the names of his contributors- may be used to endorse or promote products derived from this software- without specific prior written permission.--THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR-IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE-DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR-ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS-OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)-HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,-STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN-ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE-POSSIBILITY OF SUCH DAMAGE.+Copyright (c) 2009 George Pollard + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: + +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR +IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR +ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, +STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN +ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE.
Setup.lhs view
@@ -1,3 +1,3 @@-#!/usr/bin/env runhaskell-> import Distribution.Simple-> main = defaultMain+#!/usr/bin/env runhaskell +> import Distribution.Simple +> main = defaultMain
Text/Email/Validate.hs view
@@ -1,324 +1,323 @@-{-# LANGUAGE CPP #-}-module Text.Email.Validate (isValid,validate,EmailAddress(..))-where--import Control.Arrow ((***))-import qualified Data.Ranges as Range-import Data.Char (chr)--#if MIN_VERSION_parsec(3,0,0)-import Text.Parsec-import Text.Parsec.Char-#else -import Text.ParserCombinators.Parsec-#endif---- | Constructor does no checking for invalid emails, so use at own risk.-data EmailAddress = EmailAddress- {- localPart :: String,- domainPart :: String- }--instance Show EmailAddress where- show (EmailAddress l d) = l ++ ('@' : d)---- | Validates whether a particular string is an email address--- according to RFC5322.-isValid :: String -> Bool-isValid x = let result = validate x in- either (const False) (const True) result--simply = (>> return ())---- | If you want to find out why a particular string is not--- an email address, use this!-validate :: String -> Either ParseError EmailAddress-validate x = case parse addrSpec "" x of- Right n -> Right $ EmailAddress local domain- where (local,at:domain) = splitAt (length x - n) x- Left e -> Left e--#if MIN_VERSION_parsec(3,0,0)-addrSpec :: Parsec String () Int-#else-addrSpec :: CharParser () Int-#endif-addrSpec = do- localPartParser- s1 <- getInput- char '@'- domain- eof- return (length s1)--localPartParser = dottedAtoms-domain = dottedAtoms <|> domainLiteral --dottedAtoms = simply $ (optional cfws >> (atom <|> quotedString) >> optional cfws)- `sepBy1` (char '.')-atom = simply $ many1 atomText-atomText = simply $ alphaNum <|> oneOf "!#$%&'*+-/=?^_`{|}~"--domainLiteral = between (optional cfws >> char '[') (char ']' >> optional cfws) $- many (optional fws >> domainText) >> optional fws-domainText = ranges [(33,90),(94,126)] <|> obsNoWsCtl---quotedString = between (char '"') (char '"') $- many (optional fws >> quotedContent) >> optional fws-quotedContent = quotedText <|> quotedPair-quotedText = ranges [(33,33),(35,91),(93,126)] <|> obsNoWsCtl-quotedPair = char '\\' >> (vchar <|> wsp <|> lf <|> cr <|> obsNoWsCtl <|> nullChar)--fws = (many1 wsp >> optional (crlf >> many1 wsp))- <|> (many1 (crlf >> many1 wsp) >> return ())--cfws = simply $ many (comment <|> fws)-comment = simply $ between (char '(') (char ')') $- many (commentContent <|> fws)--commentContent = commentText <|> quotedPair <|> comment-commentText = ranges [(33,39),(42,91),(93,126)] <|> obsNoWsCtl--nullChar = simply $ char '\0'-wsp = simply $ oneOf " \t"-cr = simply $ char '\r'-lf = simply $ char '\n'-crlf = simply $ cr >> lf-vchar = ranges [(0x21,0x7e)]-obsNoWsCtl = ranges [(1,8),(11,12),(14,31),(127,127)]-ranges xs = simply $ satisfy (\c -> Range.inRanges c $ Range.ranges $ map (uncurry Range.range . (chr***chr)) $ xs)--unitTest (x, y, z) = if isValid x == y then "" else (x ++": Should be "++show y ++", got "++show (not y)++"\n\t"++z++"\n")--doSomeTests = do- putStr$unitTest("first.last@example.com", True, "")- putStr$unitTest("1234567890123456789012345678901234567890123456789012345678901234@example.com", True, "")- putStr$unitTest("\"first last\"@example.com", True, "")- putStr$unitTest("\"first\\\"last\"@example.com", True, "")- putStr$unitTest("first\\@last@example.com", False, "Escaping can only happen within a quoted string")- putStr$unitTest("\"first@last\"@example.com", True, "")- putStr$unitTest("\"first\\\\last\"@example.com", True, "")- putStr$unitTest("x@x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x234", True, "")- putStr$unitTest("123456789012345678901234567890123456789012345678901234567890@12345678901234567890123456789012345678901234567890123456789.12345678901234567890123456789012345678901234567890123456789.123456789012345678901234567890123456789012345678901234567890123.example.com", True, "")- putStr$unitTest("first.last@[12.34.56.78]", True, "")- putStr$unitTest("first.last@[IPv6:::12.34.56.78]", True, "")- putStr$unitTest("first.last@[IPv6:1111:2222:3333::4444:12.34.56.78]", True, "")- putStr$unitTest("first.last@[IPv6:1111:2222:3333:4444:5555:6666:12.34.56.78]", True, "")- putStr$unitTest("first.last@[IPv6:::1111:2222:3333:4444:5555:6666]", True, "")- putStr$unitTest("first.last@[IPv6:1111:2222:3333::4444:5555:6666]", True, "")- putStr$unitTest("first.last@[IPv6:1111:2222:3333:4444:5555:6666::]", True, "")- putStr$unitTest("first.last@[IPv6:1111:2222:3333:4444:5555:6666:7777:8888]", True, "")- putStr$unitTest("first.last@x23456789012345678901234567890123456789012345678901234567890123.example.com", True, "")- putStr$unitTest("first.last@1xample.com", True, "")- putStr$unitTest("first.last@123.example.com", True, "")- putStr$unitTest("123456789012345678901234567890123456789012345678901234567890@12345678901234567890123456789012345678901234567890123456789.12345678901234567890123456789012345678901234567890123456789.12345678901234567890123456789012345678901234567890123456789.1234.example.com", False, "Entire address is longer than 256 characters")- putStr$unitTest("first.last", False, "No @")- putStr$unitTest("12345678901234567890123456789012345678901234567890123456789012345@example.com", False, "Local part more than 64 characters")- putStr$unitTest(".first.last@example.com", False, "Local part starts with a dot")- putStr$unitTest("first.last.@example.com", False, "Local part ends with a dot")- putStr$unitTest("first..last@example.com", False, "Local part has consecutive dots")- putStr$unitTest("\"first\"last\"@example.com", False, "Local part contains unescaped excluded characters")- putStr$unitTest("\"first\\last\"@example.com", True, "Any character can be escaped in a quoted string")- putStr$unitTest("\"\"\"@example.com", False, "Local part contains unescaped excluded characters")- putStr$unitTest("\"\\\"@example.com", False, "Local part cannot end with a backslash")- putStr$unitTest("\"\"@example.com", False, "Local part is effectively empty")- putStr$unitTest("first\\\\@last@example.com", False, "Local part contains unescaped excluded characters")- putStr$unitTest("first.last@", False, "No domain")- putStr$unitTest("x@x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456", False, "Domain exceeds 255 chars")- putStr$unitTest("first.last@[.12.34.56.78]", False, "Only char that can precede IPv4 address is \':\'")- putStr$unitTest("first.last@[12.34.56.789]", False, "Can\'t be interpreted as IPv4 so IPv6 tag is missing")- putStr$unitTest("first.last@[::12.34.56.78]", False, "IPv6 tag is missing")- putStr$unitTest("first.last@[IPv5:::12.34.56.78]", False, "IPv6 tag is wrong")- putStr$unitTest("first.last@[IPv6:1111:2222:3333::4444:5555:12.34.56.78]", False, "Too many IPv6 groups (4 max)")- putStr$unitTest("first.last@[IPv6:1111:2222:3333:4444:5555:12.34.56.78]", False, "Not enough IPv6 groups")- putStr$unitTest("first.last@[IPv6:1111:2222:3333:4444:5555:6666:7777:12.34.56.78]", False, "Too many IPv6 groups (6 max)")- putStr$unitTest("first.last@[IPv6:1111:2222:3333:4444:5555:6666:7777]", False, "Not enough IPv6 groups")- putStr$unitTest("first.last@[IPv6:1111:2222:3333:4444:5555:6666:7777:8888:9999]", False, "Too many IPv6 groups (8 max)")- putStr$unitTest("first.last@[IPv6:1111:2222::3333::4444:5555:6666]", False, "Too many \'::\' (can be none or one)")- putStr$unitTest("first.last@[IPv6:1111:2222:3333::4444:5555:6666:7777]", False, "Too many IPv6 groups (6 max)")- putStr$unitTest("first.last@[IPv6:1111:2222:333x::4444:5555]", False, "x is not valid in an IPv6 address")- putStr$unitTest("first.last@[IPv6:1111:2222:33333::4444:5555]", False, "33333 is not a valid group in an IPv6 address")- putStr$unitTest("first.last@example.123", False, "TLD can\'t be all digits")- putStr$unitTest("first.last@com", False, "Mail host must be second- or lower level")- putStr$unitTest("first.last@-xample.com", False, "Label can\'t begin with a hyphen")- putStr$unitTest("first.last@exampl-.com", False, "Label can\'t end with a hyphen")- putStr$unitTest("first.last@x234567890123456789012345678901234567890123456789012345678901234.example.com", False, "Label can\'t be longer than 63 octets")- putStr$unitTest("\"Abc\\@def\"@example.com", True, "")- putStr$unitTest("\"Fred\\ Bloggs\"@example.com", True, "")- putStr$unitTest("\"Joe.\\\\Blow\"@example.com", True, "")- putStr$unitTest("\"Abc@def\"@example.com", True, "")- putStr$unitTest("\"Fred Bloggs\"@example.com", True, "")- putStr$unitTest("user+mailbox@example.com", True, "")- putStr$unitTest("customer/department=shipping@example.com", True, "")- putStr$unitTest("$A12345@example.com", True, "")- putStr$unitTest("!def!xyz%abc@example.com", True, "")- putStr$unitTest("_somename@example.com", True, "")- putStr$unitTest("dclo@us.ibm.com", True, "")- putStr$unitTest("abc\\@def@example.com", False, "This example from RFC3696 was corrected in an erratum")- putStr$unitTest("abc\\\\@example.com", False, "This example from RFC3696 was corrected in an erratum")- putStr$unitTest("peter.piper@example.com", True, "")- putStr$unitTest("Doug\\ \\\"Ace\\\"\\ Lovell@example.com", False, "Escaping can only happen in a quoted string")- putStr$unitTest("\"Doug \\\"Ace\\\" L.\"@example.com", True, "")- putStr$unitTest("abc@def@example.com", False, "Doug Lovell says this should fail")- putStr$unitTest("abc\\\\@def@example.com", False, "Doug Lovell says this should fail")- putStr$unitTest("abc\\@example.com", False, "Doug Lovell says this should fail")- putStr$unitTest("@example.com", False, "No local part")- putStr$unitTest("doug@", False, "Doug Lovell says this should fail")- putStr$unitTest("\"qu@example.com", False, "Doug Lovell says this should fail")- putStr$unitTest("ote\"@example.com", False, "Doug Lovell says this should fail")- putStr$unitTest(".dot@example.com", False, "Doug Lovell says this should fail")- putStr$unitTest("dot.@example.com", False, "Doug Lovell says this should fail")- putStr$unitTest("two..dot@example.com", False, "Doug Lovell says this should fail")- putStr$unitTest("\"Doug \"Ace\" L.\"@example.com", False, "Doug Lovell says this should fail")- putStr$unitTest("Doug\\ \\\"Ace\\\"\\ L\\.@example.com", False, "Doug Lovell says this should fail")- putStr$unitTest("hello world@example.com", False, "Doug Lovell says this should fail")- putStr$unitTest("gatsby@f.sc.ot.t.f.i.tzg.era.l.d.", False, "Doug Lovell says this should fail")- putStr$unitTest("test@example.com", True, "")- putStr$unitTest("TEST@example.com", True, "")- putStr$unitTest("1234567890@example.com", True, "")- putStr$unitTest("test+test@example.com", True, "")- putStr$unitTest("test-test@example.com", True, "")- putStr$unitTest("t*est@example.com", True, "")- putStr$unitTest("+1~1+@example.com", True, "")- putStr$unitTest("{_test_}@example.com", True, "")- putStr$unitTest("\"[[ test ]]\"@example.com", True, "")- putStr$unitTest("test.test@example.com", True, "")- putStr$unitTest("\"test.test\"@example.com", True, "")- putStr$unitTest("test.\"test\"@example.com", True, "Obsolete form, but documented in RFC2822")- putStr$unitTest("\"test@test\"@example.com", True, "")- putStr$unitTest("test@123.123.123.x123", True, "")- putStr$unitTest("test@123.123.123.123", False, "Top Level Domain won\'t be all-numeric (see RFC3696 Section 2). I disagree with Dave Child on this one.")- putStr$unitTest("test@[123.123.123.123]", True, "")- putStr$unitTest("test@example.example.com", True, "")- putStr$unitTest("test@example.example.example.com", True, "")- putStr$unitTest("test.example.com", False, "")- putStr$unitTest("test.@example.com", False, "")- putStr$unitTest("test..test@example.com", False, "")- putStr$unitTest(".test@example.com", False, "")- putStr$unitTest("test@test@example.com", False, "")- putStr$unitTest("test@@example.com", False, "")- putStr$unitTest("-- test --@example.com", False, "No spaces allowed in local part")- putStr$unitTest("[test]@example.com", False, "Square brackets only allowed within quotes")- putStr$unitTest("\"test\\test\"@example.com", True, "Any character can be escaped in a quoted string")- putStr$unitTest("\"test\"test\"@example.com", False, "Quotes cannot be nested")- putStr$unitTest("()[]\\;:,><@example.com", False, "Disallowed Characters")- putStr$unitTest("test@.", False, "Dave Child says so")- putStr$unitTest("test@example.", False, "Dave Child says so")- putStr$unitTest("test@.org", False, "Dave Child says so")- putStr$unitTest("test@123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012.com", False, "255 characters is maximum length for domain. This is 256.")- putStr$unitTest("test@example", False, "Dave Child says so")- putStr$unitTest("test@[123.123.123.123", False, "Dave Child says so")- putStr$unitTest("test@123.123.123.123]", False, "Dave Child says so")- putStr$unitTest("NotAnEmail", False, "Phil Haack says so")- putStr$unitTest("@NotAnEmail", False, "Phil Haack says so")- putStr$unitTest("\"test\\\\blah\"@example.com", True, "")- putStr$unitTest("\"test\\blah\"@example.com", True, "Any character can be escaped in a quoted string")- putStr$unitTest("\"test\\\rblah\"@example.com", True, "Quoted string specifically excludes carriage returns unless escaped")- putStr$unitTest("\"test\rblah\"@example.com", False, "Quoted string specifically excludes carriage returns")- putStr$unitTest("\"test\\\"blah\"@example.com", True, "")- putStr$unitTest("\"test\"blah\"@example.com", False, "Phil Haack says so")- putStr$unitTest("customer/department@example.com", True, "")- putStr$unitTest("_Yosemite.Sam@example.com", True, "")- putStr$unitTest("~@example.com", True, "")- putStr$unitTest(".wooly@example.com", False, "Phil Haack says so")- putStr$unitTest("wo..oly@example.com", False, "Phil Haack says so")- putStr$unitTest("pootietang.@example.com", False, "Phil Haack says so")- putStr$unitTest(".@example.com", False, "Phil Haack says so")- putStr$unitTest("\"Austin@Powers\"@example.com", True, "")- putStr$unitTest("Ima.Fool@example.com", True, "")- putStr$unitTest("\"Ima.Fool\"@example.com", True, "")- putStr$unitTest("\"Ima Fool\"@example.com", True, "")- putStr$unitTest("Ima Fool@example.com", False, "Phil Haack says so")- putStr$unitTest("phil.h\\@\\@ck@haacked.com", False, "Escaping can only happen in a quoted string")- putStr$unitTest("\"first\".\"last\"@example.com", True, "")- putStr$unitTest("\"first\".middle.\"last\"@example.com", True, "")- putStr$unitTest("\"first\\\\\"last\"@example.com", False, "Contains an unescaped quote")- putStr$unitTest("\"first\".last@example.com", True, "obs-local-part form as described in RFC 2822")- putStr$unitTest("first.\"last\"@example.com", True, "obs-local-part form as described in RFC 2822")- putStr$unitTest("\"first\".\"middle\".\"last\"@example.com", True, "obs-local-part form as described in RFC 2822")- putStr$unitTest("\"first.middle\".\"last\"@example.com", True, "obs-local-part form as described in RFC 2822")- putStr$unitTest("\"first.middle.last\"@example.com", True, "obs-local-part form as described in RFC 2822")- putStr$unitTest("\"first..last\"@example.com", True, "obs-local-part form as described in RFC 2822")- putStr$unitTest("foo@[\\1.2.3.4]", False, "RFC 5321 specifies the syntax for address-literal and does not allow escaping")- putStr$unitTest("\"first\\\\\\\"last\"@example.com", True, "")- putStr$unitTest("first.\"mid\\dle\".\"last\"@example.com", True, "Backslash can escape anything but must escape something")- putStr$unitTest("Test.\r\n Folding.\r\n Whitespace@example.com", True, "")- putStr$unitTest("first.\"\".last@example.com", False, "Contains a zero-length element")- putStr$unitTest("first\\last@example.com", False, "Unquoted string must be an atom")- putStr$unitTest("Abc\\@def@example.com", False, "Was incorrectly given as a valid address in the original RFC3696")- putStr$unitTest("Fred\\ Bloggs@example.com", False, "Was incorrectly given as a valid address in the original RFC3696")- putStr$unitTest("Joe.\\\\Blow@example.com", False, "Was incorrectly given as a valid address in the original RFC3696")- putStr$unitTest("first.last@[IPv6:1111:2222:3333:4444:5555:6666:12.34.567.89]", False, "IPv4 part contains an invalid octet")- putStr$unitTest("\"test\\\r\n blah\"@example.com", False, "Folding white space can\'t appear within a quoted pair")- putStr$unitTest("\"test\r\n blah\"@example.com", True, "This is a valid quoted string with folding white space")- putStr$unitTest("{^c\\@**Dog^}@cartoon.com", False, "This is a throwaway example from Doug Lovell\'s article. Actually it\'s not a valid address.")- putStr$unitTest("(foo)cal(bar)@(baz)iamcal.com(quux)", True, "A valid address containing comments")- putStr$unitTest("cal@iamcal(woo).(yay)com", True, "A valid address containing comments")- putStr$unitTest("\"foo\"(yay)@(hoopla)[1.2.3.4]", False, "Address literal can\'t be commented (RFC5321)")- putStr$unitTest("cal(woo(yay)hoopla)@iamcal.com", True, "A valid address containing comments")- putStr$unitTest("cal(foo\\@bar)@iamcal.com", True, "A valid address containing comments")- putStr$unitTest("cal(foo\\)bar)@iamcal.com", True, "A valid address containing comments and an escaped parenthesis")- putStr$unitTest("cal(foo(bar)@iamcal.com", False, "Unclosed parenthesis in comment")- putStr$unitTest("cal(foo)bar)@iamcal.com", False, "Too many closing parentheses")- putStr$unitTest("cal(foo\\)@iamcal.com", False, "Backslash at end of comment has nothing to escape")- putStr$unitTest("first().last@example.com", True, "A valid address containing an empty comment")- putStr$unitTest("first.(\r\n middle\r\n )last@example.com", True, "Comment with folding white space")- putStr$unitTest("first(12345678901234567890123456789012345678901234567890)last@(1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890)example.com", False, "Too long with comments, not too long without")- putStr$unitTest("first(Welcome to\r\n the (\"wonderful\" (!)) world\r\n of email)@example.com", True, "Silly example from my blog post")- putStr$unitTest("pete(his account)@silly.test(his host)", True, "Canonical example from RFC5322")- putStr$unitTest("c@(Chris\'s host.)public.example", True, "Canonical example from RFC5322")- putStr$unitTest("jdoe@machine(comment). example", True, "Canonical example from RFC5322")- putStr$unitTest("1234 @ local(blah) .machine .example", True, "Canonical example from RFC5322")- putStr$unitTest("first(middle)last@example.com", False, "Can\'t have a comment or white space except at an element boundary")- putStr$unitTest("first(abc.def).last@example.com", True, "Comment can contain a dot")- putStr$unitTest("first(a\"bc.def).last@example.com", True, "Comment can contain double quote")- putStr$unitTest("first.(\")middle.last(\")@example.com", True, "Comment can contain a quote")- putStr$unitTest("first(abc(\"def\".ghi).mno)middle(abc(\"def\".ghi).mno).last@(abc(\"def\".ghi).mno)example(abc(\"def\".ghi).mno).(abc(\"def\".ghi).mno)com(abc(\"def\".ghi).mno)", False, "Can\'t have comments or white space except at an element boundary")- putStr$unitTest("first(abc\\(def)@example.com", True, "Comment can contain quoted-pair")- putStr$unitTest("first.last@x(1234567890123456789012345678901234567890123456789012345678901234567890).com", True, "Label is longer than 63 octets, but not with comment removed")- putStr$unitTest("a(a(b(c)d(e(f))g)h(i)j)@example.com", True, "")- putStr$unitTest("a(a(b(c)d(e(f))g)(h(i)j)@example.com", False, "Braces are not properly matched")- putStr$unitTest("name.lastname@domain.com", True, "")- putStr$unitTest(".@", False, "")- putStr$unitTest("a@b", False, "")- putStr$unitTest("@bar.com", False, "")- putStr$unitTest("@@bar.com", False, "")- putStr$unitTest("a@bar.com", True, "")- putStr$unitTest("aaa.com", False, "")- putStr$unitTest("aaa@.com", False, "")- putStr$unitTest("aaa@.123", False, "")- putStr$unitTest("aaa@[123.123.123.123]", True, "")- putStr$unitTest("aaa@[123.123.123.123]a", False, "extra data outside ip")- putStr$unitTest("aaa@[123.123.123.333]", False, "not a valid IP")- putStr$unitTest("a@bar.com.", False, "")- putStr$unitTest("a@bar", False, "")- putStr$unitTest("a-b@bar.com", True, "")- putStr$unitTest("+@b.c", True, "TLDs can be any length")- putStr$unitTest("+@b.com", True, "")- putStr$unitTest("a@-b.com", False, "")- putStr$unitTest("a@b-.com", False, "")- putStr$unitTest("-@..com", False, "")- putStr$unitTest("-@a..com", False, "")- putStr$unitTest("a@b.co-foo.uk", True, "")- putStr$unitTest("\"hello my name is\"@stutter.com", True, "")- putStr$unitTest("\"Test \\\"Fail\\\" Ing\"@example.com", True, "")- putStr$unitTest("valid@special.museum", True, "")- putStr$unitTest("invalid@special.museum-", False, "")- putStr$unitTest("shaitan@my-domain.thisisminekthx", True, "Disagree with Paul Gregg here")- putStr$unitTest("test@...........com", False, "......")- putStr$unitTest("foobar@192.168.0.1", False, "ip need to be []")- putStr$unitTest("\"Joe\\\\Blow\"@example.com", True, "")- putStr$unitTest("Invalid \\\n Folding \\\n Whitespace@example.com", False, "This isn\'t FWS so Dominic Sayers says it\'s invalid")- putStr$unitTest("HM2Kinsists@(that comments are allowed)this.is.ok", True, "")- putStr$unitTest("user%uucp!path@somehost.edu", True, "")- putStr$unitTest("\"first(last)\"@example.com", True, "")- putStr$unitTest(" \r\n (\r\n x \r\n ) \r\n first\r\n ( \r\n x\r\n ) \r\n .\r\n ( \r\n x) \r\n last \r\n ( x \r\n ) \r\n @example.com", True, "")- putStr$unitTest("test.\r\n \r\n obs@syntax.com", True, "obs-fws allows multiple lines")- putStr$unitTest("test. \r\n \r\n obs@syntax.com", True, "obs-fws allows multiple lines (test 2: space before break)")- putStr$unitTest("test.\r\n\r\n obs@syntax.com", False, "obs-fws must have at least one WSP per line")- putStr$unitTest("\"null \\\0\"@char.com", True, "can have escaped null character")- putStr$unitTest("\"null \0\"@char.com", False, "cannot have unescaped null character")- -+{-# LANGUAGE CPP #-} +module Text.Email.Validate (addrSpec,isValid,validate,EmailAddress(..)) +where + +import Control.Arrow ((***)) +import qualified Data.Ranges as Range +import Data.Char (chr) + +#if MIN_VERSION_parsec(3,0,0) +import Text.Parsec +import Text.Parsec.Char +#else +import Text.ParserCombinators.Parsec +#endif + +-- | Constructor does no checking for invalid emails, so use at own risk. +data EmailAddress = EmailAddress + { + localPart :: String, + domainPart :: String + } + +instance Show EmailAddress where + show (EmailAddress l d) = l ++ ('@' : d) + +-- | Validates whether a particular string is an email address +-- according to RFC5322. +isValid :: String -> Bool +isValid x = let result = validate x in + either (const False) (const True) result + +simply = (>> return ()) + +-- | If you want to find out why a particular string is not +-- an email address, use this! +validate :: String -> Either ParseError EmailAddress +validate x = case parse addrSpec "" x of + Right n -> Right $ EmailAddress local domain + where (local,at:domain) = splitAt (length x - n) x + Left e -> Left e + +#if MIN_VERSION_parsec(3,0,0) +addrSpec :: Parsec String () Int +#else +addrSpec :: CharParser () Int +#endif +addrSpec = do + localPartParser + s1 <- getInput + char '@' + domain + return (length s1) + +localPartParser = dottedAtoms +domain = dottedAtoms <|> domainLiteral + +dottedAtoms = simply $ (optional cfws >> (atom <|> quotedString) >> optional cfws) + `sepBy1` (char '.') +atom = simply $ many1 atomText +atomText = simply $ alphaNum <|> oneOf "!#$%&'*+-/=?^_`{|}~" + +domainLiteral = between (optional cfws >> char '[') (char ']' >> optional cfws) $ + many (optional fws >> domainText) >> optional fws +domainText = ranges [(33,90),(94,126)] <|> obsNoWsCtl + + +quotedString = between (char '"') (char '"') $ + many (optional fws >> quotedContent) >> optional fws +quotedContent = quotedText <|> quotedPair +quotedText = ranges [(33,33),(35,91),(93,126)] <|> obsNoWsCtl +quotedPair = char '\\' >> (vchar <|> wsp <|> lf <|> cr <|> obsNoWsCtl <|> nullChar) + +fws = (many1 wsp >> optional (crlf >> many1 wsp)) + <|> (many1 (crlf >> many1 wsp) >> return ()) + +cfws = simply $ many (comment <|> fws) +comment = simply $ between (char '(') (char ')') $ + many (commentContent <|> fws) + +commentContent = commentText <|> quotedPair <|> comment +commentText = ranges [(33,39),(42,91),(93,126)] <|> obsNoWsCtl + +nullChar = simply $ char '\0' +wsp = simply $ oneOf " \t" +cr = simply $ char '\r' +lf = simply $ char '\n' +crlf = simply $ cr >> lf +vchar = ranges [(0x21,0x7e)] +obsNoWsCtl = ranges [(1,8),(11,12),(14,31),(127,127)] +ranges xs = simply $ satisfy (\c -> Range.inRanges c $ Range.ranges $ map (uncurry Range.range . (chr***chr)) $ xs) + +unitTest (x, y, z) = if isValid x == y then "" else (x ++": Should be "++show y ++", got "++show (not y)++"\n\t"++z++"\n") + +doSomeTests = do + putStr$unitTest("first.last@example.com", True, "") + putStr$unitTest("1234567890123456789012345678901234567890123456789012345678901234@example.com", True, "") + putStr$unitTest("\"first last\"@example.com", True, "") + putStr$unitTest("\"first\\\"last\"@example.com", True, "") + putStr$unitTest("first\\@last@example.com", False, "Escaping can only happen within a quoted string") + putStr$unitTest("\"first@last\"@example.com", True, "") + putStr$unitTest("\"first\\\\last\"@example.com", True, "") + putStr$unitTest("x@x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x234", True, "") + putStr$unitTest("123456789012345678901234567890123456789012345678901234567890@12345678901234567890123456789012345678901234567890123456789.12345678901234567890123456789012345678901234567890123456789.123456789012345678901234567890123456789012345678901234567890123.example.com", True, "") + putStr$unitTest("first.last@[12.34.56.78]", True, "") + putStr$unitTest("first.last@[IPv6:::12.34.56.78]", True, "") + putStr$unitTest("first.last@[IPv6:1111:2222:3333::4444:12.34.56.78]", True, "") + putStr$unitTest("first.last@[IPv6:1111:2222:3333:4444:5555:6666:12.34.56.78]", True, "") + putStr$unitTest("first.last@[IPv6:::1111:2222:3333:4444:5555:6666]", True, "") + putStr$unitTest("first.last@[IPv6:1111:2222:3333::4444:5555:6666]", True, "") + putStr$unitTest("first.last@[IPv6:1111:2222:3333:4444:5555:6666::]", True, "") + putStr$unitTest("first.last@[IPv6:1111:2222:3333:4444:5555:6666:7777:8888]", True, "") + putStr$unitTest("first.last@x23456789012345678901234567890123456789012345678901234567890123.example.com", True, "") + putStr$unitTest("first.last@1xample.com", True, "") + putStr$unitTest("first.last@123.example.com", True, "") + putStr$unitTest("123456789012345678901234567890123456789012345678901234567890@12345678901234567890123456789012345678901234567890123456789.12345678901234567890123456789012345678901234567890123456789.12345678901234567890123456789012345678901234567890123456789.1234.example.com", False, "Entire address is longer than 256 characters") + putStr$unitTest("first.last", False, "No @") + putStr$unitTest("12345678901234567890123456789012345678901234567890123456789012345@example.com", False, "Local part more than 64 characters") + putStr$unitTest(".first.last@example.com", False, "Local part starts with a dot") + putStr$unitTest("first.last.@example.com", False, "Local part ends with a dot") + putStr$unitTest("first..last@example.com", False, "Local part has consecutive dots") + putStr$unitTest("\"first\"last\"@example.com", False, "Local part contains unescaped excluded characters") + putStr$unitTest("\"first\\last\"@example.com", True, "Any character can be escaped in a quoted string") + putStr$unitTest("\"\"\"@example.com", False, "Local part contains unescaped excluded characters") + putStr$unitTest("\"\\\"@example.com", False, "Local part cannot end with a backslash") + putStr$unitTest("\"\"@example.com", False, "Local part is effectively empty") + putStr$unitTest("first\\\\@last@example.com", False, "Local part contains unescaped excluded characters") + putStr$unitTest("first.last@", False, "No domain") + putStr$unitTest("x@x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456789.x23456", False, "Domain exceeds 255 chars") + putStr$unitTest("first.last@[.12.34.56.78]", False, "Only char that can precede IPv4 address is \':\'") + putStr$unitTest("first.last@[12.34.56.789]", False, "Can\'t be interpreted as IPv4 so IPv6 tag is missing") + putStr$unitTest("first.last@[::12.34.56.78]", False, "IPv6 tag is missing") + putStr$unitTest("first.last@[IPv5:::12.34.56.78]", False, "IPv6 tag is wrong") + putStr$unitTest("first.last@[IPv6:1111:2222:3333::4444:5555:12.34.56.78]", False, "Too many IPv6 groups (4 max)") + putStr$unitTest("first.last@[IPv6:1111:2222:3333:4444:5555:12.34.56.78]", False, "Not enough IPv6 groups") + putStr$unitTest("first.last@[IPv6:1111:2222:3333:4444:5555:6666:7777:12.34.56.78]", False, "Too many IPv6 groups (6 max)") + putStr$unitTest("first.last@[IPv6:1111:2222:3333:4444:5555:6666:7777]", False, "Not enough IPv6 groups") + putStr$unitTest("first.last@[IPv6:1111:2222:3333:4444:5555:6666:7777:8888:9999]", False, "Too many IPv6 groups (8 max)") + putStr$unitTest("first.last@[IPv6:1111:2222::3333::4444:5555:6666]", False, "Too many \'::\' (can be none or one)") + putStr$unitTest("first.last@[IPv6:1111:2222:3333::4444:5555:6666:7777]", False, "Too many IPv6 groups (6 max)") + putStr$unitTest("first.last@[IPv6:1111:2222:333x::4444:5555]", False, "x is not valid in an IPv6 address") + putStr$unitTest("first.last@[IPv6:1111:2222:33333::4444:5555]", False, "33333 is not a valid group in an IPv6 address") + putStr$unitTest("first.last@example.123", False, "TLD can\'t be all digits") + putStr$unitTest("first.last@com", False, "Mail host must be second- or lower level") + putStr$unitTest("first.last@-xample.com", False, "Label can\'t begin with a hyphen") + putStr$unitTest("first.last@exampl-.com", False, "Label can\'t end with a hyphen") + putStr$unitTest("first.last@x234567890123456789012345678901234567890123456789012345678901234.example.com", False, "Label can\'t be longer than 63 octets") + putStr$unitTest("\"Abc\\@def\"@example.com", True, "") + putStr$unitTest("\"Fred\\ Bloggs\"@example.com", True, "") + putStr$unitTest("\"Joe.\\\\Blow\"@example.com", True, "") + putStr$unitTest("\"Abc@def\"@example.com", True, "") + putStr$unitTest("\"Fred Bloggs\"@example.com", True, "") + putStr$unitTest("user+mailbox@example.com", True, "") + putStr$unitTest("customer/department=shipping@example.com", True, "") + putStr$unitTest("$A12345@example.com", True, "") + putStr$unitTest("!def!xyz%abc@example.com", True, "") + putStr$unitTest("_somename@example.com", True, "") + putStr$unitTest("dclo@us.ibm.com", True, "") + putStr$unitTest("abc\\@def@example.com", False, "This example from RFC3696 was corrected in an erratum") + putStr$unitTest("abc\\\\@example.com", False, "This example from RFC3696 was corrected in an erratum") + putStr$unitTest("peter.piper@example.com", True, "") + putStr$unitTest("Doug\\ \\\"Ace\\\"\\ Lovell@example.com", False, "Escaping can only happen in a quoted string") + putStr$unitTest("\"Doug \\\"Ace\\\" L.\"@example.com", True, "") + putStr$unitTest("abc@def@example.com", False, "Doug Lovell says this should fail") + putStr$unitTest("abc\\\\@def@example.com", False, "Doug Lovell says this should fail") + putStr$unitTest("abc\\@example.com", False, "Doug Lovell says this should fail") + putStr$unitTest("@example.com", False, "No local part") + putStr$unitTest("doug@", False, "Doug Lovell says this should fail") + putStr$unitTest("\"qu@example.com", False, "Doug Lovell says this should fail") + putStr$unitTest("ote\"@example.com", False, "Doug Lovell says this should fail") + putStr$unitTest(".dot@example.com", False, "Doug Lovell says this should fail") + putStr$unitTest("dot.@example.com", False, "Doug Lovell says this should fail") + putStr$unitTest("two..dot@example.com", False, "Doug Lovell says this should fail") + putStr$unitTest("\"Doug \"Ace\" L.\"@example.com", False, "Doug Lovell says this should fail") + putStr$unitTest("Doug\\ \\\"Ace\\\"\\ L\\.@example.com", False, "Doug Lovell says this should fail") + putStr$unitTest("hello world@example.com", False, "Doug Lovell says this should fail") + putStr$unitTest("gatsby@f.sc.ot.t.f.i.tzg.era.l.d.", False, "Doug Lovell says this should fail") + putStr$unitTest("test@example.com", True, "") + putStr$unitTest("TEST@example.com", True, "") + putStr$unitTest("1234567890@example.com", True, "") + putStr$unitTest("test+test@example.com", True, "") + putStr$unitTest("test-test@example.com", True, "") + putStr$unitTest("t*est@example.com", True, "") + putStr$unitTest("+1~1+@example.com", True, "") + putStr$unitTest("{_test_}@example.com", True, "") + putStr$unitTest("\"[[ test ]]\"@example.com", True, "") + putStr$unitTest("test.test@example.com", True, "") + putStr$unitTest("\"test.test\"@example.com", True, "") + putStr$unitTest("test.\"test\"@example.com", True, "Obsolete form, but documented in RFC2822") + putStr$unitTest("\"test@test\"@example.com", True, "") + putStr$unitTest("test@123.123.123.x123", True, "") + putStr$unitTest("test@123.123.123.123", False, "Top Level Domain won\'t be all-numeric (see RFC3696 Section 2). I disagree with Dave Child on this one.") + putStr$unitTest("test@[123.123.123.123]", True, "") + putStr$unitTest("test@example.example.com", True, "") + putStr$unitTest("test@example.example.example.com", True, "") + putStr$unitTest("test.example.com", False, "") + putStr$unitTest("test.@example.com", False, "") + putStr$unitTest("test..test@example.com", False, "") + putStr$unitTest(".test@example.com", False, "") + putStr$unitTest("test@test@example.com", False, "") + putStr$unitTest("test@@example.com", False, "") + putStr$unitTest("-- test --@example.com", False, "No spaces allowed in local part") + putStr$unitTest("[test]@example.com", False, "Square brackets only allowed within quotes") + putStr$unitTest("\"test\\test\"@example.com", True, "Any character can be escaped in a quoted string") + putStr$unitTest("\"test\"test\"@example.com", False, "Quotes cannot be nested") + putStr$unitTest("()[]\\;:,><@example.com", False, "Disallowed Characters") + putStr$unitTest("test@.", False, "Dave Child says so") + putStr$unitTest("test@example.", False, "Dave Child says so") + putStr$unitTest("test@.org", False, "Dave Child says so") + putStr$unitTest("test@123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012.com", False, "255 characters is maximum length for domain. This is 256.") + putStr$unitTest("test@example", False, "Dave Child says so") + putStr$unitTest("test@[123.123.123.123", False, "Dave Child says so") + putStr$unitTest("test@123.123.123.123]", False, "Dave Child says so") + putStr$unitTest("NotAnEmail", False, "Phil Haack says so") + putStr$unitTest("@NotAnEmail", False, "Phil Haack says so") + putStr$unitTest("\"test\\\\blah\"@example.com", True, "") + putStr$unitTest("\"test\\blah\"@example.com", True, "Any character can be escaped in a quoted string") + putStr$unitTest("\"test\\\rblah\"@example.com", True, "Quoted string specifically excludes carriage returns unless escaped") + putStr$unitTest("\"test\rblah\"@example.com", False, "Quoted string specifically excludes carriage returns") + putStr$unitTest("\"test\\\"blah\"@example.com", True, "") + putStr$unitTest("\"test\"blah\"@example.com", False, "Phil Haack says so") + putStr$unitTest("customer/department@example.com", True, "") + putStr$unitTest("_Yosemite.Sam@example.com", True, "") + putStr$unitTest("~@example.com", True, "") + putStr$unitTest(".wooly@example.com", False, "Phil Haack says so") + putStr$unitTest("wo..oly@example.com", False, "Phil Haack says so") + putStr$unitTest("pootietang.@example.com", False, "Phil Haack says so") + putStr$unitTest(".@example.com", False, "Phil Haack says so") + putStr$unitTest("\"Austin@Powers\"@example.com", True, "") + putStr$unitTest("Ima.Fool@example.com", True, "") + putStr$unitTest("\"Ima.Fool\"@example.com", True, "") + putStr$unitTest("\"Ima Fool\"@example.com", True, "") + putStr$unitTest("Ima Fool@example.com", False, "Phil Haack says so") + putStr$unitTest("phil.h\\@\\@ck@haacked.com", False, "Escaping can only happen in a quoted string") + putStr$unitTest("\"first\".\"last\"@example.com", True, "") + putStr$unitTest("\"first\".middle.\"last\"@example.com", True, "") + putStr$unitTest("\"first\\\\\"last\"@example.com", False, "Contains an unescaped quote") + putStr$unitTest("\"first\".last@example.com", True, "obs-local-part form as described in RFC 2822") + putStr$unitTest("first.\"last\"@example.com", True, "obs-local-part form as described in RFC 2822") + putStr$unitTest("\"first\".\"middle\".\"last\"@example.com", True, "obs-local-part form as described in RFC 2822") + putStr$unitTest("\"first.middle\".\"last\"@example.com", True, "obs-local-part form as described in RFC 2822") + putStr$unitTest("\"first.middle.last\"@example.com", True, "obs-local-part form as described in RFC 2822") + putStr$unitTest("\"first..last\"@example.com", True, "obs-local-part form as described in RFC 2822") + putStr$unitTest("foo@[\\1.2.3.4]", False, "RFC 5321 specifies the syntax for address-literal and does not allow escaping") + putStr$unitTest("\"first\\\\\\\"last\"@example.com", True, "") + putStr$unitTest("first.\"mid\\dle\".\"last\"@example.com", True, "Backslash can escape anything but must escape something") + putStr$unitTest("Test.\r\n Folding.\r\n Whitespace@example.com", True, "") + putStr$unitTest("first.\"\".last@example.com", False, "Contains a zero-length element") + putStr$unitTest("first\\last@example.com", False, "Unquoted string must be an atom") + putStr$unitTest("Abc\\@def@example.com", False, "Was incorrectly given as a valid address in the original RFC3696") + putStr$unitTest("Fred\\ Bloggs@example.com", False, "Was incorrectly given as a valid address in the original RFC3696") + putStr$unitTest("Joe.\\\\Blow@example.com", False, "Was incorrectly given as a valid address in the original RFC3696") + putStr$unitTest("first.last@[IPv6:1111:2222:3333:4444:5555:6666:12.34.567.89]", False, "IPv4 part contains an invalid octet") + putStr$unitTest("\"test\\\r\n blah\"@example.com", False, "Folding white space can\'t appear within a quoted pair") + putStr$unitTest("\"test\r\n blah\"@example.com", True, "This is a valid quoted string with folding white space") + putStr$unitTest("{^c\\@**Dog^}@cartoon.com", False, "This is a throwaway example from Doug Lovell\'s article. Actually it\'s not a valid address.") + putStr$unitTest("(foo)cal(bar)@(baz)iamcal.com(quux)", True, "A valid address containing comments") + putStr$unitTest("cal@iamcal(woo).(yay)com", True, "A valid address containing comments") + putStr$unitTest("\"foo\"(yay)@(hoopla)[1.2.3.4]", False, "Address literal can\'t be commented (RFC5321)") + putStr$unitTest("cal(woo(yay)hoopla)@iamcal.com", True, "A valid address containing comments") + putStr$unitTest("cal(foo\\@bar)@iamcal.com", True, "A valid address containing comments") + putStr$unitTest("cal(foo\\)bar)@iamcal.com", True, "A valid address containing comments and an escaped parenthesis") + putStr$unitTest("cal(foo(bar)@iamcal.com", False, "Unclosed parenthesis in comment") + putStr$unitTest("cal(foo)bar)@iamcal.com", False, "Too many closing parentheses") + putStr$unitTest("cal(foo\\)@iamcal.com", False, "Backslash at end of comment has nothing to escape") + putStr$unitTest("first().last@example.com", True, "A valid address containing an empty comment") + putStr$unitTest("first.(\r\n middle\r\n )last@example.com", True, "Comment with folding white space") + putStr$unitTest("first(12345678901234567890123456789012345678901234567890)last@(1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890)example.com", False, "Too long with comments, not too long without") + putStr$unitTest("first(Welcome to\r\n the (\"wonderful\" (!)) world\r\n of email)@example.com", True, "Silly example from my blog post") + putStr$unitTest("pete(his account)@silly.test(his host)", True, "Canonical example from RFC5322") + putStr$unitTest("c@(Chris\'s host.)public.example", True, "Canonical example from RFC5322") + putStr$unitTest("jdoe@machine(comment). example", True, "Canonical example from RFC5322") + putStr$unitTest("1234 @ local(blah) .machine .example", True, "Canonical example from RFC5322") + putStr$unitTest("first(middle)last@example.com", False, "Can\'t have a comment or white space except at an element boundary") + putStr$unitTest("first(abc.def).last@example.com", True, "Comment can contain a dot") + putStr$unitTest("first(a\"bc.def).last@example.com", True, "Comment can contain double quote") + putStr$unitTest("first.(\")middle.last(\")@example.com", True, "Comment can contain a quote") + putStr$unitTest("first(abc(\"def\".ghi).mno)middle(abc(\"def\".ghi).mno).last@(abc(\"def\".ghi).mno)example(abc(\"def\".ghi).mno).(abc(\"def\".ghi).mno)com(abc(\"def\".ghi).mno)", False, "Can\'t have comments or white space except at an element boundary") + putStr$unitTest("first(abc\\(def)@example.com", True, "Comment can contain quoted-pair") + putStr$unitTest("first.last@x(1234567890123456789012345678901234567890123456789012345678901234567890).com", True, "Label is longer than 63 octets, but not with comment removed") + putStr$unitTest("a(a(b(c)d(e(f))g)h(i)j)@example.com", True, "") + putStr$unitTest("a(a(b(c)d(e(f))g)(h(i)j)@example.com", False, "Braces are not properly matched") + putStr$unitTest("name.lastname@domain.com", True, "") + putStr$unitTest(".@", False, "") + putStr$unitTest("a@b", False, "") + putStr$unitTest("@bar.com", False, "") + putStr$unitTest("@@bar.com", False, "") + putStr$unitTest("a@bar.com", True, "") + putStr$unitTest("aaa.com", False, "") + putStr$unitTest("aaa@.com", False, "") + putStr$unitTest("aaa@.123", False, "") + putStr$unitTest("aaa@[123.123.123.123]", True, "") + putStr$unitTest("aaa@[123.123.123.123]a", False, "extra data outside ip") + putStr$unitTest("aaa@[123.123.123.333]", False, "not a valid IP") + putStr$unitTest("a@bar.com.", False, "") + putStr$unitTest("a@bar", False, "") + putStr$unitTest("a-b@bar.com", True, "") + putStr$unitTest("+@b.c", True, "TLDs can be any length") + putStr$unitTest("+@b.com", True, "") + putStr$unitTest("a@-b.com", False, "") + putStr$unitTest("a@b-.com", False, "") + putStr$unitTest("-@..com", False, "") + putStr$unitTest("-@a..com", False, "") + putStr$unitTest("a@b.co-foo.uk", True, "") + putStr$unitTest("\"hello my name is\"@stutter.com", True, "") + putStr$unitTest("\"Test \\\"Fail\\\" Ing\"@example.com", True, "") + putStr$unitTest("valid@special.museum", True, "") + putStr$unitTest("invalid@special.museum-", False, "") + putStr$unitTest("shaitan@my-domain.thisisminekthx", True, "Disagree with Paul Gregg here") + putStr$unitTest("test@...........com", False, "......") + putStr$unitTest("foobar@192.168.0.1", False, "ip need to be []") + putStr$unitTest("\"Joe\\\\Blow\"@example.com", True, "") + putStr$unitTest("Invalid \\\n Folding \\\n Whitespace@example.com", False, "This isn\'t FWS so Dominic Sayers says it\'s invalid") + putStr$unitTest("HM2Kinsists@(that comments are allowed)this.is.ok", True, "") + putStr$unitTest("user%uucp!path@somehost.edu", True, "") + putStr$unitTest("\"first(last)\"@example.com", True, "") + putStr$unitTest(" \r\n (\r\n x \r\n ) \r\n first\r\n ( \r\n x\r\n ) \r\n .\r\n ( \r\n x) \r\n last \r\n ( x \r\n ) \r\n @example.com", True, "") + putStr$unitTest("test.\r\n \r\n obs@syntax.com", True, "obs-fws allows multiple lines") + putStr$unitTest("test. \r\n \r\n obs@syntax.com", True, "obs-fws allows multiple lines (test 2: space before break)") + putStr$unitTest("test.\r\n\r\n obs@syntax.com", False, "obs-fws must have at least one WSP per line") + putStr$unitTest("\"null \\\0\"@char.com", True, "can have escaped null character") + putStr$unitTest("\"null \0\"@char.com", False, "cannot have unescaped null character") + +
email-validate.cabal view
@@ -1,11 +1,11 @@ name: email-validate -version: 0.2.8 +version: 0.3.1 license: BSD3 license-file: LICENSE author: George Pollard maintainer: George Pollard <porges@porg.es> homepage: http://porg.es/blog/email-address-validation-simpler-faster-more-correct -category: Text +category: Text, RFC synopsis: Validating an email address string against RFC 5322 description: Validating an email address string against RFC 5322 build-type: Simple