{-|

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.Sequence (
  -- * Sequence Matches
  Delta,
  isSequence,
  estimateSequence
  ) where

--------------------------------------------------------------------------------
-- Library Imports:
import Data.Char (ord, isDigit)
import Data.Text (Text)
import qualified Data.Text as Text

--------------------------------------------------------------------------------
-- | Type alias to represent the distance between characters.
type Delta = Int

--------------------------------------------------------------------------------
-- | If the delta between all of the characters in the given text are
-- the same, that delta is returned.
isSequence :: Text -> Maybe Delta
isSequence :: Text -> Maybe Delta
isSequence Text
t =
  case ((Char, Char) -> Delta) -> [(Char, Char)] -> [Delta]
forall a b. (a -> b) -> [a] -> [b]
map (Char, Char) -> Delta
measure [(Char, Char)]
offset of
    []   -> Maybe Delta
forall a. Maybe a
Nothing
    Delta
x:[Delta]
xs -> if (Delta -> Bool) -> [Delta] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Delta -> Delta -> Bool
forall a. Eq a => a -> a -> Bool
== Delta
x) [Delta]
xs
              then Delta -> Maybe Delta
forall a. a -> Maybe a
Just Delta
x
              else Maybe Delta
forall a. Maybe a
Nothing
  where
    offset :: [(Char, Char)]
    offset :: [(Char, Char)]
offset = Text -> Text -> [(Char, Char)]
Text.zip Text
t (Delta -> Text -> Text
Text.drop Delta
1 Text
t)

    measure :: (Char, Char) -> Delta
    measure :: (Char, Char) -> Delta
measure (Char
x, Char
y) = Char -> Delta
ord Char
y Delta -> Delta -> Delta
forall a. Num a => a -> a -> a
- Char -> Delta
ord Char
x

--------------------------------------------------------------------------------
-- | Estimate a sequence.
--
-- Uses the scoring equation from the paper and not from the other
-- implementations which don't even use the calculated delta.  The
-- only change from the paper is to compensated for a delta of 0,
-- which isn't accounted for in the paper.
estimateSequence :: (Char -> Bool) -> Text -> Delta -> Integer
estimateSequence :: (Char -> Bool) -> Text -> Delta -> Integer
estimateSequence Char -> Bool
f Text
t Delta
d =
  let len :: Integer
len    = Delta -> Integer
forall a. Integral a => a -> Integer
toInteger (Delta -> Integer) -> Delta -> Integer
forall a b. (a -> b) -> a -> b
$ Text -> Delta
Text.length Text
t
      start :: Char
start  = if Integer
len Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 then Text -> Char
Text.head Text
t else Char
'\0'
      delta :: Integer
delta  = Delta -> Integer
forall a. Integral a => a -> Integer
toInteger (if Delta
d Delta -> Delta -> Bool
forall a. Eq a => a -> a -> Bool
== Delta
0 then Delta
1 else Delta -> Delta
forall a. Num a => a -> a
abs Delta
d)
      base :: Integer
base   = case () of
                 () | Char -> Bool
f Char
start       -> Integer
4
                    | Char -> Bool
isDigit Char
start -> Integer
10
                    | Bool
otherwise     -> Integer
26
  in Integer
base Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
len Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
delta