{-|

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.Estimate (
  -- * Estimate Matched Tokens
  Guesses,
  Estimates,
  Estimate(..),
  estimateAll,
  estimate,
  ) where

--------------------------------------------------------------------------------
-- Library Imports:
import Data.Maybe (fromMaybe)
import Control.Lens ((^.))
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import qualified Data.Text as Text

--------------------------------------------------------------------------------
-- Project Imports:
import Text.Password.Strength.Internal.Config
import Text.Password.Strength.Internal.Date
import Text.Password.Strength.Internal.Keyboard
import Text.Password.Strength.Internal.L33t
import Text.Password.Strength.Internal.Match
import Text.Password.Strength.Internal.Math
import Text.Password.Strength.Internal.Sequence
import Text.Password.Strength.Internal.Token

--------------------------------------------------------------------------------
-- | Final mapping of a token to its lowest score.
type Guesses = Map Token Integer

--------------------------------------------------------------------------------
-- | Map of partially applied estimates.
type Estimates = Map Token Estimate

--------------------------------------------------------------------------------
-- | A function that will produce an estimate once we know the
-- estimates for other tokens.  This is necessary to score repeat
-- matches since they require looking up the score for a different
-- token.
newtype Estimate = Estimate
  { Estimate -> Estimates -> Integer
getEstimate :: Estimates -> Integer }

--------------------------------------------------------------------------------
-- | Estimate all of the given matches.
estimateAll :: Config -> Matches -> Guesses
estimateAll :: Config -> Matches -> Guesses
estimateAll Config
cfg Matches
ms =
    forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Estimate -> Estimates -> Integer
`getEstimate` Estimates
estimates) Estimates
estimates
  where
    estimate' :: Token -> [Match] -> Maybe (Estimates -> Integer)
    estimate' :: Token -> [Match] -> Maybe (Estimates -> Integer)
estimate' Token
_ []  = forall a. Maybe a
Nothing
    estimate' Token
t [Match]
ms' = forall a. a -> Maybe a
Just (\Estimates
e -> forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\Match
m -> Config -> Token -> Match -> Estimates -> Integer
estimate Config
cfg Token
t Match
m Estimates
e) [Match]
ms')

    estimates :: Estimates
    estimates :: Estimates
estimates =
      let get :: Token -> [Match] -> Maybe Estimate
get Token
t [Match]
m = (Estimates -> Integer) -> Estimate
Estimate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Token -> [Match] -> Maybe (Estimates -> Integer)
estimate' Token
t [Match]
m
          ins :: Token -> [Match] -> Estimates -> Estimates
ins Token
t [Match]
m Estimates
tbl = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Estimates
tbl (\Estimate
e -> forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Token
t Estimate
e Estimates
tbl) (Token -> [Match] -> Maybe Estimate
get Token
t [Match]
m)
      in forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey Token -> [Match] -> Estimates -> Estimates
ins forall k a. Map k a
Map.empty Matches
ms

--------------------------------------------------------------------------------
-- | Estimate a single match.
estimate :: Config -> Token -> Match -> Estimates -> Integer
estimate :: Config -> Token -> Match -> Estimates -> Integer
estimate Config
cfg Token
token Match
match Estimates
es =
  case Match
match of
    DictionaryMatch Rank
n ->
      Token -> Integer -> Integer
caps Token
token (forall a. Integral a => a -> Integer
toInteger Rank
n)

    ReverseDictionaryMatch Rank
n ->
      Token -> Integer -> Integer
caps Token
token (forall a. Integral a => a -> Integer
toInteger Rank
n forall a. Num a => a -> a -> a
* Integer
2)

    L33tMatch Rank
n L33t
l ->
      let s :: Rank
s = L33t
l forall s a. s -> Getting a s a -> a
^. Lens' L33t Rank
l33tSub
          u :: Rank
u = L33t
l forall s a. s -> Getting a s a -> a
^. Lens' L33t Rank
l33tUnsub
      in forall a. Integral a => a -> Integer
toInteger Rank
n forall a. Num a => a -> a -> a
* Rank -> Rank -> Integer
variations' Rank
s Rank
u

    KeyboardMatch KeyboardPattern
k ->
      KeyboardPattern -> Integer
keyboardEstimate KeyboardPattern
k

    SequenceMatch Rank
delta ->
      let f :: Char -> Bool
f = (Config
cfg forall s a. s -> Getting a s a -> a
^. forall c. HasConfig c => Lens' c (Char -> Bool)
obviousSequenceStart)
      in (Char -> Bool) -> Text -> Rank -> Integer
estimateSequence Char -> Bool
f (Token
token forall s a. s -> Getting a s a -> a
^. Lens' Token Text
tokenChars) Rank
delta

    DateMatch Date
d ->
      Date -> Integer
estimateDate Date
d

    RepeatMatch Rank
n Token
t ->
      let worstcase :: Integer
worstcase = Rank -> Integer
bruteForce forall a b. (a -> b) -> a -> b
$ Text -> Rank
Text.length (Token
token forall s a. s -> Getting a s a -> a
^. Lens' Token Text
tokenChars)
          guess :: Maybe Integer
guess = (Estimate -> Estimates -> Integer
`getEstimate` Estimates
es) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Token
t Estimates
es
      in forall a. a -> Maybe a -> a
fromMaybe Integer
worstcase Maybe Integer
guess forall a. Num a => a -> a -> a
* forall a. Integral a => a -> Integer
toInteger Rank
n