packages feed

banwords-0.1.0.0: tests/Unit.hs

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