diff --git a/MIT-LICENSE.txt b/MIT-LICENSE.txt new file mode 100644 --- /dev/null +++ b/MIT-LICENSE.txt @@ -0,0 +1,20 @@ +The MIT License (MIT) +Copyright (c) 2015 FanJam, Inc. + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, +DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR +OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE +OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,3 @@ +# Intro + +A few tools for checking if a word is a close match against a blacklist. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/banwords.cabal b/banwords.cabal new file mode 100644 --- /dev/null +++ b/banwords.cabal @@ -0,0 +1,48 @@ +name: banwords +version: 0.1.0.0 +author: Ian Grant Jeffries +maintainer: ian@housejeffries.com +category: Heuristics +synopsis: Generalized word blacklister +homepage: https://github.com/fanjam/banwords +build-type: Simple +license: MIT +license-file: MIT-LICENSE.txt +cabal-version: >=1.10 +extra-source-files: README.md + +library + hs-source-dirs: src + exposed-modules: Heuristics.BanWords + default-language: Haskell2010 + ghc-options: -Wall + default-extensions: OverloadedStrings + + build-depends: attoparsec >= 0.12.1 && < 0.13 + , base >= 4.6 && < 5.0 + , bytestring >= 0.10 && < 0.11 + , data-default >= 0.5 && < 0.6 + , text >= 1.1 && < 1.3 + , vector >= 0.10.12 && < 0.11 + +test-suite unit + type: exitcode-stdio-1.0 + hs-source-dirs: tests + main-is: Unit.hs + other-modules: GoodWords + default-language: Haskell2010 + ghc-options: -Wall + default-extensions: OverloadedStrings + + build-depends: attoparsec + , banwords + , base + , text + , vector + , HUnit >= 1.2 && < 1.3 + , test-framework >= 0.8 && < 0.9 + , test-framework-hunit >= 0.3 && < 0.4 + +source-repository head + type: git + location: git://github.com/fanjam/banwords.git diff --git a/src/Heuristics/BanWords.hs b/src/Heuristics/BanWords.hs new file mode 100644 --- /dev/null +++ b/src/Heuristics/BanWords.hs @@ -0,0 +1,52 @@ +module Heuristics.BanWords where + +import Prelude hiding (notElem) + +import Control.Applicative +import Data.Attoparsec.Text +import Data.Foldable +import Data.Monoid +import Data.Text (Text) +import Data.Vector (Vector) +import qualified Data.Vector as V + +-- | Block exact matches. +passesBlacklist :: Vector Text -> Text -> Maybe Text +passesBlacklist blacklist t = + case parseOnly (banExact blacklist) t of + Right _ -> Nothing + Left _ -> Just t + +-- | Intended for internal use. +banExact :: Vector Text -> Parser Text +banExact bans = asum $ (\x -> string x *> endOfInput *> return x) <$> bans + +-- | Block exact matches, or exact matches that are surrounded by only non-alphabetical characters. +passesBlacklistPlus :: Vector Text -> Text -> Maybe Text +passesBlacklistPlus blacklist t = + case parseOnly (banAlmostExact blacklist) t of + Right _ -> Nothing + Left _ -> Just t + +-- | Intended for internal use. +banAlmostExact :: Vector Text -> Parser Text +banAlmostExact bans = asum $ (\x -> skipNonAlphabetical *> string x *> skipNonAlphabetical *> endOfInput *> return x) <$> bans + +-- | Intended for internal use. +skipNonAlphabetical :: Parser () +skipNonAlphabetical = skipWhile $ \c -> notElem c (['a'..'z'] <> ['A'..'Z']) + +exampleReserved :: Vector Text +exampleReserved = V.fromList + [ "accounts" + , "admin" + , "beta" + , "billing" + , "help" + , "jobs" + , "mail" + , "registration" + , "root" + , "security" + , "support" + ] diff --git a/tests/GoodWords.hs b/tests/GoodWords.hs new file mode 100644 --- /dev/null +++ b/tests/GoodWords.hs @@ -0,0 +1,1001 @@ +-- A modified subset of this list: +-- +-- https://github.com/first20hours/google-10000-english +-- commit # bdf424fc5bc6d5e558f51ba74bab33174a601785 + +module GoodWords where + +import Data.Text (Text) +import Data.Vector (Vector) +import qualified Data.Vector as V + +goodWords :: Vector Text +goodWords = V.fromList + [ "entry" + , "stay" + , "nature" + , "orders" + , "availability" + , "africa" + , "summary" + , "turn" + , "mean" + , "growth" + , "notes" + , "agency" + , "king" + , "monday" + , "european" + , "activity" + , "copy" + , "although" + , "drug" + , "pics" + , "western" + , "income" + , "force" + , "cash" + , "employment" + , "overall" + , "bay" + , "river" + , "commission" + , "ad" + , "package" + , "contents" + , "seen" + , "players" + , "engine" + , "port" + , "album" + , "regional" + , "stop" + , "supplies" + , "started" + , "administration" + , "bar" + , "institute" + , "views" + , "plans" + , "double" + , "dog" + , "build" + , "screen" + , "exchange" + , "types" + , "soon" + , "sponsored" + , "lines" + , "electronic" + , "continue" + , "across" + , "benefits" + , "needed" + , "season" + , "apply" + , "someone" + , "held" + , "ny" + , "anything" + , "printer" + , "condition" + , "effective" + , "believe" + , "organization" + , "effect" + , "asked" + , "eur" + , "mind" + , "sunday" + , "selection" + , "casino" + , "pdf" + , "lost" + , "tour" + , "menu" + , "volume" + , "cross" + , "anyone" + , "mortgage" + , "hope" + , "silver" + , "corporation" + , "wish" + , "inside" + , "solution" + , "mature" + , "role" + , "rather" + , "weeks" + , "addition" + , "came" + , "supply" + , "nothing" + , "certain" + , "usr" + , "executive" + , "running" + , "lower" + , "necessary" + , "union" + , "jewelry" + , "according" + , "dc" + , "clothing" + , "mon" + , "com" + , "particular" + , "fine" + , "names" + , "robert" + , "homepage" + , "hour" + , "gas" + , "skills" + , "six" + , "bush" + , "islands" + , "advice" + , "career" + , "military" + , "rental" + , "decision" + , "leave" + , "british" + , "teens" + , "pre" + , "huge" + , "sat" + , "woman" + , "facilities" + , "zip" + , "bid" + , "kind" + , "sellers" + , "middle" + , "move" + , "cable" + , "opportunities" + , "taking" + , "values" + , "division" + , "coming" + , "tuesday" + , "object" + , "lesbian" + , "appropriate" + , "machine" + , "logo" + , "length" + , "actually" + , "nice" + , "score" + , "statistics" + , "client" + , "ok" + , "returns" + , "capital" + , "follow" + , "sample" + , "investment" + , "sent" + , "shown" + , "saturday" + , "christmas" + , "england" + , "culture" + , "band" + , "flash" + , "ms" + , "lead" + , "george" + , "choice" + , "went" + , "starting" + , "fri" + , "thursday" + , "courses" + , "consumer" + , "hi" + , "airport" + , "foreign" + , "artist" + , "outside" + , "furniture" + , "levels" + , "channel" + , "letter" + , "mode" + , "phones" + , "ideas" + , "wednesday" + , "structure" + , "fund" + , "summer" + , "allow" + , "degree" + , "contract" + , "button" + , "releases" + , "wed" + , "homes" + , "super" + , "male" + , "matter" + , "custom" + , "virginia" + , "almost" + , "took" + , "located" + , "multiple" + , "asian" + , "distribution" + , "editor" + , "inn" + , "industrial" + , "cause" + , "potential" + , "song" + , "cnet" + , "ltd" + , "los" + , "hp" + , "focus" + , "late" + , "fall" + , "featured" + , "idea" + , "rooms" + , "female" + , "responsible" + , "inc" + , "communications" + , "win" + , "associated" + , "thomas" + , "primary" + , "cancer" + , "numbers" + , "reason" + , "tool" + , "browser" + , "spring" + , "foundation" + , "answer" + , "voice" + , "eg" + , "friendly" + , "schedule" + , "documents" + , "communication" + , "purpose" + , "feature" + , "bed" + , "comes" + , "police" + , "everyone" + , "independent" + , "ip" + , "approach" + , "cameras" + , "brown" + , "physical" + , "operating" + , "hill" + , "maps" + , "medicine" + , "deal" + , "hold" + , "ratings" + , "chicago" + , "forms" + , "glass" + , "happy" + , "tue" + , "smith" + , "wanted" + , "developed" + , "thank" + , "safe" + , "unique" + , "survey" + , "prior" + , "telephone" + , "sport" + , "ready" + , "feed" + , "animal" + , "sources" + , "mexico" + , "population" + , "pa" + , "regular" + , "secure" + , "navigation" + , "operations" + , "therefore" + , "simply" + , "evidence" + , "station" + , "christian" + , "round" + , "paypal" + , "favorite" + , "understand" + , "option" + , "master" + , "valley" + , "recently" + , "probably" + , "thu" + , "rentals" + , "sea" + , "built" + , "publications" + , "blood" + , "cut" + , "worldwide" + , "improve" + , "connection" + , "publisher" + , "hall" + , "larger" + , "anti" + , "networks" + , "earth" + , "parents" + , "nokia" + , "impact" + , "transfer" + , "introduction" + , "kitchen" + , "strong" + , "tel" + , "carolina" + , "wedding" + , "properties" + , "hospital" + , "ground" + , "overview" + , "ship" + , "accommodation" + , "owners" + , "disease" + , "tx" + , "excellent" + , "paid" + , "italy" + , "perfect" + , "hair" + , "opportunity" + , "kit" + , "classic" + , "basis" + , "command" + , "cities" + , "william" + , "express" + , "award" + , "distance" + , "tree" + , "peter" + , "assessment" + , "ensure" + , "thus" + , "wall" + , "ie" + , "involved" + , "el" + , "extra" + , "especially" + , "interface" + , "partners" + , "budget" + , "rated" + , "guides" + , "success" + , "maximum" + , "ma" + , "operation" + , "existing" + , "quite" + , "selected" + , "boy" + , "amazon" + , "patients" + , "restaurants" + , "beautiful" + , "warning" + , "wine" + , "locations" + , "horse" + , "vote" + , "forward" + , "flowers" + , "stars" + , "significant" + , "lists" + , "technologies" + , "owner" + , "retail" + , "animals" + , "useful" + , "directly" + , "manufacturer" + , "ways" + , "est" + , "son" + , "providing" + , "rule" + , "mac" + , "housing" + , "takes" + , "iii" + , "gmt" + , "bring" + , "catalog" + , "searches" + , "max" + , "trying" + , "mother" + , "authority" + , "considered" + , "told" + , "xml" + , "traffic" + , "programme" + , "joined" + , "input" + , "strategy" + , "feet" + , "agent" + , "valid" + , "bin" + , "modern" + , "senior" + , "ireland" + , "teaching" + , "door" + , "grand" + , "testing" + , "trial" + , "charge" + , "units" + , "instead" + , "canadian" + , "cool" + , "normal" + , "wrote" + , "enterprise" + , "ships" + , "entire" + , "educational" + , "md" + , "leading" + , "metal" + , "positive" + , "fl" + , "fitness" + , "chinese" + , "opinion" + , "mb" + , "asia" + , "football" + , "abstract" + , "uses" + , "output" + , "funds" + , "mr" + , "greater" + , "likely" + , "develop" + , "employees" + , "artists" + , "alternative" + , "processing" + , "responsibility" + , "resolution" + , "java" + , "guest" + , "seems" + , "publication" + , "pass" + , "relations" + , "trust" + , "van" + , "contains" + , "session" + , "multi" + , "photography" + , "republic" + , "fees" + , "components" + , "vacation" + , "century" + , "academic" + , "assistance" + , "completed" + , "skin" + , "graphics" + , "indian" + , "prev" + , "ads" + , "mary" + , "il" + , "expected" + , "ring" + , "grade" + , "dating" + , "pacific" + , "mountain" + , "organizations" + , "pop" + , "filter" + , "mailing" + , "vehicle" + , "longer" + , "consider" + , "int" + , "northern" + , "behind" + , "panel" + , "floor" + , "german" + , "buying" + , "match" + , "proposed" + , "default" + , "require" + , "iraq" + , "boys" + , "outdoor" + , "deep" + , "morning" + , "otherwise" + , "allows" + , "rest" + , "protein" + , "plant" + , "reported" + , "hit" + , "transportation" + , "mm" + , "pool" + , "mini" + , "politics" + , "partner" + , "disclaimer" + , "authors" + , "boards" + , "faculty" + , "parties" + , "fish" + , "membership" + , "mission" + , "eye" + , "string" + , "sense" + , "modified" + , "pack" + , "released" + , "stage" + , "internal" + , "goods" + , "recommended" + , "born" + , "unless" + , "richard" + , "detailed" + , "japanese" + , "race" + , "approved" + , "background" + , "target" + , "except" + , "character" + , "usb" + , "maintenance" + , "ability" + , "maybe" + , "functions" + , "ed" + , "moving" + , "brands" + , "places" + , "php" + , "pretty" + , "trademarks" + , "phentermine" + , "spain" + , "southern" + , "yourself" + , "etc" + , "winter" + , "battery" + , "youth" + , "pressure" + , "submitted" + , "boston" + , "debt" + , "keywords" + , "medium" + , "television" + , "interested" + , "core" + , "break" + , "purposes" + , "throughout" + , "sets" + , "dance" + , "wood" + , "msn" + , "itself" + , "defined" + , "papers" + , "playing" + , "awards" + , "fee" + , "studio" + , "reader" + , "virtual" + , "device" + , "established" + , "answers" + , "rent" + , "las" + , "remote" + , "dark" + , "programming" + , "external" + , "apple" + , "le" + , "regarding" + , "instructions" + , "min" + , "offered" + , "theory" + , "enjoy" + , "remove" + , "aid" + , "surface" + , "minimum" + , "visual" + , "host" + , "variety" + , "teachers" + , "isbn" + , "martin" + , "manual" + , "block" + , "subjects" + , "agents" + , "increased" + , "repair" + , "fair" + , "civil" + , "steel" + , "understanding" + , "songs" + , "fixed" + , "wrong" + , "beginning" + , "hands" + , "associates" + , "finally" + , "az" + , "updates" + , "desktop" + , "classes" + , "paris" + , "ohio" + , "gets" + , "sector" + , "capacity" + , "requires" + , "jersey" + , "un" + , "fat" + , "fully" + , "father" + , "electric" + , "saw" + , "instruments" + , "quotes" + , "officer" + , "driver" + , "businesses" + , "dead" + , "respect" + , "unknown" + , "specified" + , "restaurant" + , "mike" + , "trip" + , "pst" + , "worth" + , "mi" + , "procedures" + , "poor" + , "teacher" + , "eyes" + , "relationship" + , "workers" + , "farm" + , "fucking" + , "georgia" + , "peace" + , "traditional" + , "campus" + , "tom" + , "showing" + , "creative" + , "coast" + , "benefit" + , "progress" + , "funding" + , "devices" + , "lord" + , "grant" + , "sub" + , "agree" + , "fiction" + , "hear" + , "sometimes" + , "watches" + , "careers" + , "beyond" + , "goes" + , "families" + , "led" + , "museum" + , "themselves" + , "fan" + , "transport" + , "interesting" + , "blogs" + , "wife" + , "evaluation" + , "accepted" + , "former" + , "implementation" + , "ten" + , "hits" + , "zone" + , "complex" + , "th" + , "cat" + , "galleries" + , "references" + , "die" + , "presented" + , "jack" + , "flat" + , "flow" + , "agencies" + , "literature" + , "respective" + , "parent" + , "spanish" + , "michigan" + , "columbia" + , "setting" + , "dr" + , "scale" + , "stand" + , "economy" + , "highest" + , "helpful" + , "monthly" + , "critical" + , "frame" + , "musical" + , "definition" + , "secretary" + , "angeles" + , "networking" + , "path" + , "australian" + , "employee" + , "chief" + , "gives" + , "kb" + , "bottom" + , "magazines" + , "packages" + , "detail" + , "francisco" + , "laws" + , "changed" + , "pet" + , "heard" + , "begin" + , "individuals" + , "colorado" + , "royal" + , "clean" + , "switch" + , "russian" + , "largest" + , "african" + , "guy" + , "titles" + , "relevant" + , "guidelines" + , "justice" + , "connect" + , "bible" + , "dev" + , "cup" + , "basket" + , "applied" + , "weekly" + , "vol" + , "installation" + , "described" + , "demand" + , "pp" + , "suite" + , "vegas" + , "na" + , "square" + , "chris" + , "attention" + , "advance" + , "skip" + , "diet" + , "army" + , "auction" + , "gear" + , "lee" + , "os" + , "difference" + , "allowed" + , "correct" + , "charles" + , "nation" + , "selling" + , "lots" + , "piece" + , "sheet" + , "firm" + , "seven" + , "older" + , "illinois" + , "regulations" + , "elements" + , "species" + , "jump" + , "cells" + , "module" + , "resort" + , "facility" + , "random" + , "pricing" + , "dvds" + , "certificate" + , "minister" + , "motion" + , "looks" + , "fashion" + , "directions" + , "visitors" + , "documentation" + , "monitor" + , "trading" + , "forest" + , "calls" + , "whose" + , "coverage" + , "couple" + , "giving" + , "chance" + , "vision" + , "ball" + , "ending" + , "clients" + , "actions" + , "listen" + , "discuss" + , "accept" + , "automotive" + , "naked" + , "goal" + , "successful" + , "sold" + , "wind" + , "communities" + , "clinical" + , "situation" + , "sciences" + , "markets" + , "lowest" + , "highly" + , "publishing" + , "appear" + , "emergency" + , "developing" + , "lives" + , "currency" + , "leather" + , "determine" + , "temperature" + , "palm" + , "announcements" + , "patient" + , "actual" + , "historical" + , "stone" + , "bob" + , "commerce" + , "ringtones" + , "perhaps" + , "persons" + , "difficult" + , "scientific" + , "satellite" + , "fit" + , "tests" + , "village" + , "amateur" + , "ex" + , "met" + , "pain" + , "xbox" + , "particularly" + , "factors" + , "coffee" + , "www" + , "settings" + , "buyer" + , "cultural" + , "steve" + , "easily" + , "oral" + , "ford" + , "poster" + , "edge" + , "functional" + , "au" + , "fi" + , "closed" + , "holidays" + , "ice" + , "pink" + , "zealand" + , "balance" + , "monitoring" + , "graduate" + , "replies" + , "shot" + , "nc" + , "architecture" + , "initial" + , "label" + , "thinking" + , "scott" + , "llc" + , "sec" + , "recommend" + , "canon" + , "league" + , "waste" + , "minute" + , "bus" + , "provider" + , "optional" + , "dictionary" + , "cold" + , "accounting" + , "manufacturing" + , "sections" + , "chair" + , "fishing" + , "effort" + , "phase" + , "fields" + , "bag" + , "fantasy" + , "po" + , "letters" + , "motor" + ] diff --git a/tests/Unit.hs b/tests/Unit.hs new file mode 100644 --- /dev/null +++ b/tests/Unit.hs @@ -0,0 +1,60 @@ +module Main where + +import Data.Monoid +import Data.Text (Text) +import qualified Data.Text as T +import Data.Vector (Vector) +import qualified Data.Vector as V +import GoodWords +import Heuristics.BanWords +import Test.Framework (defaultMain, testGroup) +import Test.Framework.Providers.HUnit (testCase) +import Test.HUnit hiding (Test) + +main :: IO () +main = defaultMain + [ testGroup "unit" + [ testCase "banExact allows words correctly" exactAcceptable + , testCase "banExact blocks words correctly" exactUnacceptable + , testCase "banAlmostExact allows words correctly" almostAcceptable + , testCase "banAlmostExact blocks words correctly" almostUnacceptable + ] + ] + +exactAcceptable :: Assertion +exactAcceptable = V.mapM_ (assertAllowed $ passesBlacklist exampleReserved) $ goodWords <> goodExtraChars <> badExtraChars + +exactUnacceptable :: Assertion +exactUnacceptable = V.mapM_ (assertBanned $ passesBlacklist exampleReserved) (V.fromList ["admin", "security"]) + +almostAcceptable :: Assertion +almostAcceptable = V.mapM_ (assertAllowed $ passesBlacklistPlus exampleReserved) $ goodWords <> goodExtraChars + +almostUnacceptable :: Assertion +almostUnacceptable = V.mapM_ (assertBanned $ passesBlacklistPlus exampleReserved) badExtraChars + +goodExtraChars :: Vector Text +goodExtraChars = V.fromList + [ " hill", "hill " + , "&$4*hill", "hill&1$*", "&$7@hill$2*&" + , " &*3 hill", "hill &* 4 ", " *& hill &4 " + ] + +badExtraChars :: Vector Text +badExtraChars = V.fromList + [ " admin", "admin " + , "&$4*admin", "admin&1$*", "&$7@admin$2*&" + , " &*3 admin", "admin &* 4 ", " *& admin &4 " + ] + +assertAllowed :: (Text -> Maybe Text) -> Text -> Assertion +assertAllowed f t = + case f t of + Nothing -> assertFailure (T.unpack t <> " should have been allowed") + Just _ -> return () + +assertBanned :: (Text -> Maybe Text) -> Text -> Assertion +assertBanned f t = + case f t of + Nothing -> return () + Just _ -> assertFailure (T.unpack t <> " should have been forbidden")