banwords-0.2.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 $ passBlacklist banExact exampleReserved)
    $ goodWords <> goodExtraChars <> badExtraChars <> V.fromList ["Hill, Admin"]

exactUnacceptable :: Assertion
exactUnacceptable =
  V.mapM_ (assertBanned $ passBlacklist banExact exampleReserved)
    $ V.fromList ["admin", "security"]

almostAcceptable :: Assertion
almostAcceptable =
  V.mapM_ (assertAllowed $ passBlacklist banAlmostExact exampleReserved)
    $ goodWords <> goodExtraChars <> V.singleton "Hill"

almostUnacceptable :: Assertion
almostUnacceptable = V.mapM_ (assertBanned $ passBlacklist banAlmostExact exampleReserved)
  $ badExtraChars <> V.singleton "Admin"

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