{-# LANGUAGE OverloadedStrings #-} {-| Copyright: This file is part of the package zxcvbn-hs. It is subject to the license terms in the LICENSE file found in the top-level directory of this distribution and at: https://code.devalot.com/sthenauth/zxcvbn-hs No part of this package, including this file, may be copied, modified, propagated, or distributed except according to the terms contained in the LICENSE file. License: MIT -} module Zxcvbn.Match ( test ) where -------------------------------------------------------------------------------- import Control.Lens import qualified Data.Map as Map import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Time.Calendar as Time import Test.Tasty import Test.Tasty.HUnit -------------------------------------------------------------------------------- import Text.Password.Strength.Internal -------------------------------------------------------------------------------- test :: TestTree test = testGroup "Match" [ shouldRank "password123" "password" 2 , shouldRank "1drowssap_@" "drowssap" 2 , shouldRank "/p@ssw0rd^5" "p@ssw0rd" 2 ] -------------------------------------------------------------------------------- shouldRank :: Text -> Text -> Int -> TestTree shouldRank p p' n = testCase (Text.unpack p) $ do let ms = matches en_US ref p ts = filter (\t -> t ^. tokenChars == p') (Map.keys ms) t <- case ts of [] -> assertFailure ("missing token: " <> show p' <> " " <> show ms) [x] -> pure x _ -> assertFailure ("multiple matching tokens! " <> show p') case Map.lookup t ms of Nothing -> assertFailure "should not happen" Just xs -> getRank xs @?= n where getRank :: [Match] -> Int getRank [] = -1 getRank xs = minimum (map extract xs) ref :: Time.Day ref = Time.fromGregorian 2019 1 1 extract :: Match -> Int extract (DictionaryMatch n') = n' extract (ReverseDictionaryMatch n') = n' extract (L33tMatch n' _) = n' extract (KeyboardMatch _) = -1 extract (RepeatMatch _ _) = -1 extract (SequenceMatch _) = -1 extract (DateMatch _) = -1