{-# LANGUAGE TupleSections #-}

{-|

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.Keyboard (
  -- * Keyboard Pattern Matching
  KeyboardPattern,
  keyboardToken,
  keyboardPattern,
  keyboardEstimate
  ) where

--------------------------------------------------------------------------------
-- Library Imports:
import Control.Lens (Lens, (^.), _3)
import Data.Foldable (foldl')
import Numeric.SpecFunctions (choose)

--------------------------------------------------------------------------------
-- Project Imports:
import Text.Password.Strength.Internal.Adjacency
import Text.Password.Strength.Internal.Token
import Text.Password.Strength.Internal.Math (variations')

--------------------------------------------------------------------------------
-- | Information about a found pattern.
newtype KeyboardPattern =
  KeyboardPattern (Int, Int, Token, AdjacencyScore)
  deriving (Int -> KeyboardPattern -> ShowS
[KeyboardPattern] -> ShowS
KeyboardPattern -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyboardPattern] -> ShowS
$cshowList :: [KeyboardPattern] -> ShowS
show :: KeyboardPattern -> String
$cshow :: KeyboardPattern -> String
showsPrec :: Int -> KeyboardPattern -> ShowS
$cshowsPrec :: Int -> KeyboardPattern -> ShowS
Show)

--------------------------------------------------------------------------------
-- | Allow other code to access the token used in a pattern.
keyboardToken :: Lens KeyboardPattern KeyboardPattern Token Token
keyboardToken :: Lens KeyboardPattern KeyboardPattern Token Token
keyboardToken Token -> f Token
f (KeyboardPattern (Int, Int, Token, AdjacencyScore)
t) = (Int, Int, Token, AdjacencyScore) -> KeyboardPattern
KeyboardPattern forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s t a b. Field3 s t a b => Lens s t a b
_3 Token -> f Token
f (Int, Int, Token, AdjacencyScore)
t

--------------------------------------------------------------------------------
-- | Helper function to check if a token forms a keyboard pattern.
keyboardPattern :: AdjacencyTable -> Token -> Maybe KeyboardPattern
keyboardPattern :: AdjacencyTable -> Token -> Maybe KeyboardPattern
keyboardPattern AdjacencyTable
graph Token
token = (Int, Int, Token, AdjacencyScore) -> KeyboardPattern
KeyboardPattern forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (AdjacencyTable
graph forall s a. s -> Getting a s a -> a
^. Lens' AdjacencyTable Int
totalChars, AdjacencyTable
graph forall s a. s -> Getting a s a -> a
^. Lens' AdjacencyTable Int
averageNeighbors, Token
token,) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' AdjacencyScore -> Adjacency -> AdjacencyScore
scoreSequence forall a. Monoid a => a
mempty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> AdjacencyTable -> Maybe (NonEmpty Adjacency)
findSequence (Token
token forall s a. s -> Getting a s a -> a
^. Lens' Token Text
tokenChars) AdjacencyTable
graph

--------------------------------------------------------------------------------
-- | Estimate the number of guesses needed for a keyboard pattern to
-- be cracked.
keyboardEstimate :: KeyboardPattern -> Integer
keyboardEstimate :: KeyboardPattern -> Integer
keyboardEstimate (KeyboardPattern (Int
s, Int
d, Token
_, AdjacencyScore
a)) =
    Integer
e3 forall a. Num a => a -> a -> a
* Int -> Int -> Integer
e2 (AdjacencyScore
a forall s a. s -> Getting a s a -> a
^. Lens' AdjacencyScore Int
primaryLayer) (AdjacencyScore
a forall s a. s -> Getting a s a -> a
^. Lens' AdjacencyScore Int
secondaryLayer)

  where
    -- Equation 3, section 4, page 163 (8/18)
    --
    -- Deviations from the paper or other implementations:
    --
    --   * There's a typo in the paper: min(T, i - i)
    --     but should be: min(T, i - 1)
    --
    --   * Another typo, i should start at 2 and not 1.
    --
    --   * The other implementations don't seem to divide the outer
    --     sum by two but the equation clearly does.
    e3 :: Integer
    e3 :: Integer
e3 = forall a. Ord a => a -> a -> a
max Integer
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Integral a => a -> a -> a
`div` Integer
2) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ do
      Int
i <- [Int
2 .. (AdjacencyScore
a forall s a. s -> Getting a s a -> a
^. Lens' AdjacencyScore Int
patternLength)]
      Int
j <- [Int
1 .. forall a. Ord a => a -> a -> a
min (AdjacencyScore
a forall s a. s -> Getting a s a -> a
^. Lens' AdjacencyScore Int
totalTurns) (Int
i forall a. Num a => a -> a -> a
- Int
1)]
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. (RealFrac a, Integral b) => a -> b
floor (Int -> Int -> Double
choose (Int
i forall a. Num a => a -> a -> a
- Int
1) (Int
j forall a. Num a => a -> a -> a
- Int
1)) forall a. Num a => a -> a -> a
* forall a. Integral a => a -> Integer
toInteger Int
s forall a. Num a => a -> a -> a
* (forall a. Integral a => a -> Integer
toInteger Int
d forall a b. (Num a, Integral b) => a -> b -> a
^ Int
j)

    -- Modified version of equation 2 for primary layer vs. secondary.
    e2 :: Int -> Int -> Integer
    e2 :: Int -> Int -> Integer
e2 = Int -> Int -> Integer
variations'