{-# LANGUAGE TemplateHaskell #-} {-| 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 Text.Password.Strength.Internal.Token ( -- * Splitting a Password into Tokens Token(..), allTokens, -- * Lenses for the 'Token' Type tokenChars, tokenLower, startIndex, endIndex, -- * Translate the Characters of a Password translateMap ) where -------------------------------------------------------------------------------- -- Library Imports: import Control.Lens.TH (makeLenses) import Data.Text (Text) import qualified Data.Text as Text -------------------------------------------------------------------------------- -- | A token is a substring of a password. data Token = Token { _tokenChars :: Text , _tokenLower :: Text , _startIndex :: Int , _endIndex :: Int } deriving (Show, Eq, Ord) makeLenses ''Token -------------------------------------------------------------------------------- -- | Extract all substrings from the input 'Text'. A substring has a -- minimum character length of 3 for performance and to prevent false -- positives for matches such as sequences and repeats. -- -- Examples: -- -- >>> map _tokenChars (allTokens "abcdef") -- ["abc","abcd","abcde","abcdef","bcd","bcde","bcdef","cde","cdef","def"] allTokens :: Text -> [Token] allTokens = outer 0 where outer :: Int -> Text -> [Token] outer i t | Text.null t = [ ] | otherwise = inner i 2 t ++ outer (i+1) (Text.drop 1 t) inner :: Int -> Int -> Text -> [Token] inner i j t | Text.compareLength t (j+1) == LT = [ ] | otherwise = mkT i j t : inner i (j+1) t mkT :: Int -> Int -> Text -> Token mkT i j t = let chars = Text.take (j+1) t in Token chars (Text.toLower chars) i (i + j) -------------------------------------------------------------------------------- -- | Translate the characters of a 'Text' value. -- -- Given a function that translates a character into one or more -- characters, return all possible translations. -- -- Examples: -- -- >>> translateMap l33t2Eng "p111 -- ["piii","plii","pili","plli","piil","plil","pill","plll"] translateMap :: (Char -> String) -> Text -> [Text] translateMap f = map Text.pack . Text.foldr fork [""] where fork :: Char -> [String] -> [String] fork c cs = case f c of [] -- No translations so keep the existing char: -> map (c:) cs xs -- Add (length xs) new forks of the text: -> concatMap (\c' -> map (c':) cs) xs