Estimate.hs

{-|

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
  { getEstimate :: Estimates -> Integer }

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

    estimates :: Estimates
    estimates =
      let get t m = Estimate <$> estimate' t m
          ins t m tbl = maybe tbl (\e -> Map.insert t e tbl) (get t m)
      in Map.foldrWithKey ins Map.empty ms

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

    ReverseDictionaryMatch n ->
      caps token (toInteger n * 2)

    L33tMatch n l ->
      let s = l ^. l33tSub
          u = l ^. l33tUnsub
      in toInteger n * variations' s u

    KeyboardMatch k ->
      keyboardEstimate k

    SequenceMatch delta ->
      let f = (cfg ^. obviousSequenceStart)
      in estimateSequence f (token ^. tokenChars) delta

    DateMatch d ->
      estimateDate d

    RepeatMatch n t ->
      let worstcase = bruteForce $ Text.length (token ^. tokenChars)
          guess = (`getEstimate` es) <$> Map.lookup t es
      in fromMaybe worstcase guess * toInteger n