{-# 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
  { Token -> Text
_tokenChars :: Text
  , Token -> Text
_tokenLower :: Text
  , Token -> Int
_startIndex :: Int
  , Token -> Int
_endIndex   :: Int
  } deriving (Int -> Token -> ShowS
[Token] -> ShowS
Token -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Token] -> ShowS
$cshowList :: [Token] -> ShowS
show :: Token -> String
$cshow :: Token -> String
showsPrec :: Int -> Token -> ShowS
$cshowsPrec :: Int -> Token -> ShowS
Show, Token -> Token -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Token -> Token -> Bool
$c/= :: Token -> Token -> Bool
== :: Token -> Token -> Bool
$c== :: Token -> Token -> Bool
Eq, Eq Token
Token -> Token -> Bool
Token -> Token -> Ordering
Token -> Token -> Token
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Token -> Token -> Token
$cmin :: Token -> Token -> Token
max :: Token -> Token -> Token
$cmax :: Token -> Token -> Token
>= :: Token -> Token -> Bool
$c>= :: Token -> Token -> Bool
> :: Token -> Token -> Bool
$c> :: Token -> Token -> Bool
<= :: Token -> Token -> Bool
$c<= :: Token -> Token -> Bool
< :: Token -> Token -> Bool
$c< :: Token -> Token -> Bool
compare :: Token -> Token -> Ordering
$ccompare :: Token -> Token -> Ordering
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 :: Text -> [Token]
allTokens = Int -> Text -> [Token]
outer Int
0
  where
    outer :: Int -> Text -> [Token]
    outer :: Int -> Text -> [Token]
outer Int
i Text
t
      | Text -> Bool
Text.null Text
t = [ ]
      | Bool
otherwise   = Int -> Int -> Text -> [Token]
inner Int
i Int
2 Text
t forall a. [a] -> [a] -> [a]
++ Int -> Text -> [Token]
outer (Int
iforall a. Num a => a -> a -> a
+Int
1) (Int -> Text -> Text
Text.drop Int
1 Text
t)

    inner :: Int -> Int -> Text -> [Token]
    inner :: Int -> Int -> Text -> [Token]
inner Int
i Int
j Text
t
      | Text -> Int -> Ordering
Text.compareLength Text
t (Int
jforall a. Num a => a -> a -> a
+Int
1) forall a. Eq a => a -> a -> Bool
== Ordering
LT = [ ]
      | Bool
otherwise = Int -> Int -> Text -> Token
mkT Int
i Int
j Text
t forall a. a -> [a] -> [a]
: Int -> Int -> Text -> [Token]
inner Int
i (Int
jforall a. Num a => a -> a -> a
+Int
1) Text
t

    mkT :: Int -> Int -> Text -> Token
    mkT :: Int -> Int -> Text -> Token
mkT Int
i Int
j Text
t =
      let chars :: Text
chars = Int -> Text -> Text
Text.take (Int
jforall a. Num a => a -> a -> a
+Int
1) Text
t
      in Text -> Text -> Int -> Int -> Token
Token Text
chars (Text -> Text
Text.toLower Text
chars) Int
i (Int
i forall a. Num a => a -> a -> a
+ Int
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 :: (Char -> String) -> Text -> [Text]
translateMap Char -> String
f = forall a b. (a -> b) -> [a] -> [b]
map String -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Char -> a -> a) -> a -> Text -> a
Text.foldr Char -> [String] -> [String]
fork [String
""]
  where
    fork :: Char -> [String] -> [String]
    fork :: Char -> [String] -> [String]
fork Char
c [String]
cs =
      case Char -> String
f Char
c of
        [] -- No translations so keep the existing char:
          -> forall a b. (a -> b) -> [a] -> [b]
map (Char
cforall a. a -> [a] -> [a]
:) [String]
cs
        String
xs -- Add (length xs) new forks of the text:
          -> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Char
c' -> forall a b. (a -> b) -> [a] -> [b]
map (Char
c'forall a. a -> [a] -> [a]
:) [String]
cs) String
xs