{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Data.Gibberish.Gen.Pass
  ( genPassword,
    genPasswords,
    genPasswords',
    genPassphrase,
    genPassphrase',
  ) where

import Data.Gibberish.Monad.Pass (MonadRandom ())
import Data.Gibberish.Types
import Data.Gibberish.Utils

import Control.Arrow ((>>>))
import Control.Monad (replicateM, (>=>))
import Control.Monad.Random (MonadRandom (..), fromList, fromListMay, uniform)
import Control.Monad.Trans.Maybe (MaybeT (..), hoistMaybe)
import Data.Bifunctor (bimap, second)
import Data.Char (toLower, toUpper)
import Data.Map qualified as Map
import Data.Maybe (fromMaybe)
import Data.Ratio
import Data.Text (Text ())
import Data.Text qualified as Text
import Prelude hiding (Word)

-- | Generate a password with the given options
genPassword :: MonadRandom m => GenPasswordOpts -> m Word
genPassword :: forall (m :: * -> *). MonadRandom m => GenPasswordOpts -> m Word
genPassword opts :: GenPasswordOpts
opts@GenPasswordOpts {Bool
Int
Trigraph
woptsCapitals :: Bool
woptsDigits :: Bool
woptsSpecials :: Bool
woptsTrigraph :: Trigraph
woptsLength :: Int
woptsCapitals :: GenPasswordOpts -> Bool
woptsDigits :: GenPasswordOpts -> Bool
woptsSpecials :: GenPasswordOpts -> Bool
woptsTrigraph :: GenPasswordOpts -> Trigraph
woptsLength :: GenPasswordOpts -> Int
..}
  | Int
woptsLength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
2 = Text -> Word
Word (Text -> Word) -> (Digram -> Text) -> Digram -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
Text.take Int
woptsLength (Text -> Text) -> (Digram -> Text) -> Digram -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digram -> Text
digramToText (Digram -> Word) -> m Digram -> m Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenPasswordOpts -> m Digram
forall (m :: * -> *). MonadRandom m => GenPasswordOpts -> m Digram
first2 GenPasswordOpts
opts
  | Bool
otherwise = GenPasswordOpts -> m Word
forall (m :: * -> *). MonadRandom m => GenPasswordOpts -> m Word
genPassword' GenPasswordOpts
opts

-- | Generates a password with the given options. Assumes optsLength is at least 3.
genPassword' :: MonadRandom m => GenPasswordOpts -> m Word
genPassword' :: forall (m :: * -> *). MonadRandom m => GenPasswordOpts -> m Word
genPassword' opts :: GenPasswordOpts
opts@(GenPasswordOpts {Bool
Int
Trigraph
woptsCapitals :: GenPasswordOpts -> Bool
woptsDigits :: GenPasswordOpts -> Bool
woptsSpecials :: GenPasswordOpts -> Bool
woptsTrigraph :: GenPasswordOpts -> Trigraph
woptsLength :: GenPasswordOpts -> Int
woptsCapitals :: Bool
woptsDigits :: Bool
woptsSpecials :: Bool
woptsTrigraph :: Trigraph
woptsLength :: Int
..}) = do
  -- Select the first two characters
  Digram
f2 <- GenPasswordOpts -> m Digram
forall (m :: * -> *). MonadRandom m => GenPasswordOpts -> m Digram
first2 GenPasswordOpts
opts
  -- Select the rest of the characters
  Text
rest <- GenPasswordOpts -> Int -> Digram -> m Text
forall (m :: * -> *).
MonadRandom m =>
GenPasswordOpts -> Int -> Digram -> m Text
lastN GenPasswordOpts
opts (Int
woptsLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) Digram
f2
  -- Construct the full password from f2 and rest
  let pass :: Text
pass = Digram -> Text
digramToText Digram
f2 Text -> Text -> Text
`Text.append` Text -> Text
Text.reverse Text
rest

  -- Apply transformations in order
  let transform :: Text -> m Text
transform =
        (Char -> Char) -> Text -> Text
Text.map Char -> Char
toLower
          (Text -> Text) -> (Text -> m Text) -> Text -> m Text
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> GenPasswordOpts -> Text -> m Text
forall (m :: * -> *).
MonadRandom m =>
GenPasswordOpts -> Text -> m Text
capitalize GenPasswordOpts
opts
          (Text -> m Text) -> (Text -> m Text) -> Text -> m Text
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> GenPasswordOpts -> Text -> m Text
forall (m :: * -> *).
MonadRandom m =>
GenPasswordOpts -> Text -> m Text
digitize GenPasswordOpts
opts
          (Text -> m Text) -> (Text -> m Text) -> Text -> m Text
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> GenPasswordOpts -> Text -> m Text
forall (m :: * -> *).
MonadRandom m =>
GenPasswordOpts -> Text -> m Text
specialize GenPasswordOpts
opts

  Text -> Word
Word (Text -> Word) -> m Text -> m Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> m Text
transform Text
pass

-- | Generate passwords with the given options. /Warning:/ Do not use with the IO monad,
-- instead use `genPasswords'`
genPasswords :: MonadRandom m => GenPasswordOpts -> m [Word]
genPasswords :: forall (m :: * -> *). MonadRandom m => GenPasswordOpts -> m [Word]
genPasswords = [m Word] -> m [Word]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([m Word] -> m [Word])
-> (GenPasswordOpts -> [m Word]) -> GenPasswordOpts -> m [Word]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m Word -> [m Word]
forall a. a -> [a]
repeat (m Word -> [m Word])
-> (GenPasswordOpts -> m Word) -> GenPasswordOpts -> [m Word]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenPasswordOpts -> m Word
forall (m :: * -> *). MonadRandom m => GenPasswordOpts -> m Word
genPassword

genPasswords' :: MonadRandom m => GenPasswordOpts -> Int -> m [Word]
genPasswords' :: forall (m :: * -> *).
MonadRandom m =>
GenPasswordOpts -> Int -> m [Word]
genPasswords' = (Int -> m Word -> m [Word]) -> m Word -> Int -> m [Word]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> m Word -> m [Word]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (m Word -> Int -> m [Word])
-> (GenPasswordOpts -> m Word)
-> GenPasswordOpts
-> Int
-> m [Word]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenPasswordOpts -> m Word
forall (m :: * -> *). MonadRandom m => GenPasswordOpts -> m Word
genPassword

-- | Generate a passphrase with the given options. /Warning:/ Do not use with the IO monad,
-- instead use `genPassphrash'`
genPassphrase :: MonadRandom m => GenPassphraseOpts -> m [Word]
genPassphrase :: forall (m :: * -> *).
MonadRandom m =>
GenPassphraseOpts -> m [Word]
genPassphrase = [m Word] -> m [Word]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([m Word] -> m [Word])
-> (GenPassphraseOpts -> [m Word]) -> GenPassphraseOpts -> m [Word]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m Word -> [m Word]
forall a. a -> [a]
repeat (m Word -> [m Word])
-> (GenPassphraseOpts -> m Word) -> GenPassphraseOpts -> [m Word]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenPassphraseOpts -> m Word
forall (m :: * -> *). MonadRandom m => GenPassphraseOpts -> m Word
genPassphraseWord

-- | Generate a passphrase with the given options and the given number of words.
genPassphrase' :: MonadRandom m => GenPassphraseOpts -> Int -> m [Word]
genPassphrase' :: forall (m :: * -> *).
MonadRandom m =>
GenPassphraseOpts -> Int -> m [Word]
genPassphrase' = (Int -> m Word -> m [Word]) -> m Word -> Int -> m [Word]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> m Word -> m [Word]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (m Word -> Int -> m [Word])
-> (GenPassphraseOpts -> m Word)
-> GenPassphraseOpts
-> Int
-> m [Word]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenPassphraseOpts -> m Word
forall (m :: * -> *). MonadRandom m => GenPassphraseOpts -> m Word
genPassphraseWord

-- | Generate a single word for a passphrase
genPassphraseWord :: MonadRandom m => GenPassphraseOpts -> m Word
genPassphraseWord :: forall (m :: * -> *). MonadRandom m => GenPassphraseOpts -> m Word
genPassphraseWord (GenPassphraseOpts {Bool
Int
Trigraph
poptsCapitals :: Bool
poptsDigits :: Bool
poptsSpecials :: Bool
poptsTrigraph :: Trigraph
poptsMinLength :: Int
poptsMaxLength :: Int
poptsCapitals :: GenPassphraseOpts -> Bool
poptsDigits :: GenPassphraseOpts -> Bool
poptsSpecials :: GenPassphraseOpts -> Bool
poptsTrigraph :: GenPassphraseOpts -> Trigraph
poptsMinLength :: GenPassphraseOpts -> Int
poptsMaxLength :: GenPassphraseOpts -> Int
..}) = do
  Int
len <- (Int, Int) -> m Int
forall a. Random a => (a, a) -> m a
forall (m :: * -> *) a. (MonadRandom m, Random a) => (a, a) -> m a
getRandomR (Int
poptsMinLength, Int
poptsMaxLength)

  let genPasswordOpts :: GenPasswordOpts
genPasswordOpts =
        GenPasswordOpts
          { woptsCapitals :: Bool
woptsCapitals = Bool
poptsCapitals,
            woptsDigits :: Bool
woptsDigits = Bool
poptsDigits,
            woptsSpecials :: Bool
woptsSpecials = Bool
poptsSpecials,
            woptsTrigraph :: Trigraph
woptsTrigraph = Trigraph
poptsTrigraph,
            woptsLength :: Int
woptsLength = Int
len
          }

  GenPasswordOpts -> m Word
forall (m :: * -> *). MonadRandom m => GenPasswordOpts -> m Word
genPassword GenPasswordOpts
genPasswordOpts

digramToText :: Digram -> Text
digramToText :: Digram -> Text
digramToText (Digram Char
a Char
b) = [Char
Item Text
a, Char
Item Text
b]

first2 :: MonadRandom m => GenPasswordOpts -> m Digram
first2 :: forall (m :: * -> *). MonadRandom m => GenPasswordOpts -> m Digram
first2 GenPasswordOpts {woptsTrigraph :: GenPasswordOpts -> Trigraph
woptsTrigraph = Trigraph Map Digram Frequencies
trigraph} =
  [(Digram, Rational)] -> m Digram
forall (m :: * -> *) a. MonadRandom m => [(a, Rational)] -> m a
fromList ([(Digram, Rational)] -> m Digram)
-> (Map Digram Frequencies -> [(Digram, Rational)])
-> Map Digram Frequencies
-> m Digram
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Digram, Frequencies) -> (Digram, Rational))
-> [(Digram, Frequencies)] -> [(Digram, Rational)]
forall a b. (a -> b) -> [a] -> [b]
map (Digram, Frequencies) -> (Digram, Rational)
toWeight ([(Digram, Frequencies)] -> [(Digram, Rational)])
-> (Map Digram Frequencies -> [(Digram, Frequencies)])
-> Map Digram Frequencies
-> [(Digram, Rational)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Digram Frequencies -> [(Digram, Frequencies)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map Digram Frequencies -> m Digram)
-> Map Digram Frequencies -> m Digram
forall a b. (a -> b) -> a -> b
$ Map Digram Frequencies
trigraph
  where
    toWeight :: (Digram, Frequencies) -> (Digram, Rational)
    toWeight :: (Digram, Frequencies) -> (Digram, Rational)
toWeight = (Frequencies -> Rational)
-> (Digram, Frequencies) -> (Digram, Rational)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Frequencies -> Rational
sumFrequencies

    sumFrequencies :: Frequencies -> Rational
    sumFrequencies :: Frequencies -> Rational
sumFrequencies (Frequencies Map Unigram Frequency
freqs) =
      (Frequency -> Rational -> Rational)
-> Rational -> Map Unigram Frequency -> Rational
forall a b k. (a -> b -> b) -> b -> Map k a -> b
Map.foldr (\Frequency
a Rational
b -> Frequency -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Frequency
a Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
b) Rational
0 Map Unigram Frequency
freqs

lastN :: MonadRandom m => GenPasswordOpts -> Int -> Digram -> m Text
lastN :: forall (m :: * -> *).
MonadRandom m =>
GenPasswordOpts -> Int -> Digram -> m Text
lastN GenPasswordOpts
opts Int
len di :: Digram
di@(Digram Char
_ Char
b)
  | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Text -> m Text
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  | Bool
otherwise = do
      Char
c <- GenPasswordOpts -> Digram -> m Char
forall (m :: * -> *).
MonadRandom m =>
GenPasswordOpts -> Digram -> m Char
next GenPasswordOpts
opts Digram
di
      Text
rs <- GenPasswordOpts -> Int -> Digram -> m Text
forall (m :: * -> *).
MonadRandom m =>
GenPasswordOpts -> Int -> Digram -> m Text
lastN GenPasswordOpts
opts (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Char -> Char -> Digram
Digram Char
b Char
c)
      Text -> m Text
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char
c Char -> Text -> Text
`Text.cons` Text
rs)

next :: MonadRandom m => GenPasswordOpts -> Digram -> m Char
next :: forall (m :: * -> *).
MonadRandom m =>
GenPasswordOpts -> Digram -> m Char
next GenPasswordOpts {Bool
Int
Trigraph
woptsCapitals :: GenPasswordOpts -> Bool
woptsDigits :: GenPasswordOpts -> Bool
woptsSpecials :: GenPasswordOpts -> Bool
woptsTrigraph :: GenPasswordOpts -> Trigraph
woptsLength :: GenPasswordOpts -> Int
woptsCapitals :: Bool
woptsDigits :: Bool
woptsSpecials :: Bool
woptsTrigraph :: Trigraph
woptsLength :: Int
..} Digram
digram = do
  Maybe Char
res <- MaybeT m Char -> m (Maybe Char)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT m Char -> m (Maybe Char))
-> MaybeT m Char -> m (Maybe Char)
forall a b. (a -> b) -> a -> b
$ do
    (Frequencies Map Unigram Frequency
freqs) <- Maybe Frequencies -> MaybeT m Frequencies
forall (m :: * -> *) b. Applicative m => Maybe b -> MaybeT m b
hoistMaybe (Maybe Frequencies -> MaybeT m Frequencies)
-> Maybe Frequencies -> MaybeT m Frequencies
forall a b. (a -> b) -> a -> b
$ Digram -> Map Digram Frequencies -> Maybe Frequencies
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Digram
digram (Trigraph -> Map Digram Frequencies
unTrigraph Trigraph
woptsTrigraph)
    let weights :: [(Char, Rational)]
weights = ((Unigram, Frequency) -> (Char, Rational))
-> [(Unigram, Frequency)] -> [(Char, Rational)]
forall a b. (a -> b) -> [a] -> [b]
map ((Unigram -> Char)
-> (Frequency -> Rational)
-> (Unigram, Frequency)
-> (Char, Rational)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Unigram -> Char
unUnigram Frequency -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (Map Unigram Frequency -> [(Unigram, Frequency)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Unigram Frequency
freqs)
    m (Maybe Char) -> MaybeT m Char
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe Char) -> MaybeT m Char)
-> m (Maybe Char) -> MaybeT m Char
forall a b. (a -> b) -> a -> b
$ [(Char, Rational)] -> m (Maybe Char)
forall (m :: * -> *) a.
MonadRandom m =>
[(a, Rational)] -> m (Maybe a)
fromListMay [(Char, Rational)]
weights

  -- If there are no suitable candidates, choose one at random
  m Char -> (Char -> m Char) -> Maybe Char -> m Char
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m Char
forall (m :: * -> *). MonadRandom m => m Char
nextDefault Char -> m Char
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Char
res

nextDefault :: MonadRandom m => m Char
nextDefault :: forall (m :: * -> *). MonadRandom m => m Char
nextDefault = [Char] -> m Char
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadRandom m) =>
t a -> m a
uniform ([Char
Item [Char]
'a' .. Char
Item [Char]
'z'] :: [Char])

-- | Randomly capitalize at least 1 character. Additional characters capitalize
--  at a probability of 1/12
capitalize :: MonadRandom m => GenPasswordOpts -> Text -> m Text
capitalize :: forall (m :: * -> *).
MonadRandom m =>
GenPasswordOpts -> Text -> m Text
capitalize opts :: GenPasswordOpts
opts@GenPasswordOpts {Bool
Int
Trigraph
woptsCapitals :: GenPasswordOpts -> Bool
woptsDigits :: GenPasswordOpts -> Bool
woptsSpecials :: GenPasswordOpts -> Bool
woptsTrigraph :: GenPasswordOpts -> Trigraph
woptsLength :: GenPasswordOpts -> Int
woptsCapitals :: Bool
woptsDigits :: Bool
woptsSpecials :: Bool
woptsTrigraph :: Trigraph
woptsLength :: Int
..} Text
t
  | Bool
woptsCapitals = Text -> m Text
forall (m :: * -> *). MonadRandom m => Text -> m Text
capitalizeR (Text -> m Text) -> m Text -> m Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< GenPasswordOpts -> Text -> m Text
forall (m :: * -> *).
MonadRandom m =>
GenPasswordOpts -> Text -> m Text
capitalize1 GenPasswordOpts
opts Text
t
  | Bool
otherwise = Text -> m Text
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t

-- | Randomly capitalize 1 character
capitalize1 :: MonadRandom m => GenPasswordOpts -> Text -> m Text
capitalize1 :: forall (m :: * -> *).
MonadRandom m =>
GenPasswordOpts -> Text -> m Text
capitalize1 GenPasswordOpts {Bool
Int
Trigraph
woptsCapitals :: GenPasswordOpts -> Bool
woptsDigits :: GenPasswordOpts -> Bool
woptsSpecials :: GenPasswordOpts -> Bool
woptsTrigraph :: GenPasswordOpts -> Trigraph
woptsLength :: GenPasswordOpts -> Int
woptsCapitals :: Bool
woptsDigits :: Bool
woptsSpecials :: Bool
woptsTrigraph :: Trigraph
woptsLength :: Int
..} Text
t =
  (Char -> m Char) -> Text -> Int -> m Text
forall (m :: * -> *).
Monad m =>
(Char -> m Char) -> Text -> Int -> m Text
update1 (Char -> m Char
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> m Char) -> (Char -> Char) -> Char -> m Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char
toUpper) Text
t (Int -> m Text) -> m Int -> m Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Int, Int) -> m Int
forall a. Random a => (a, a) -> m a
forall (m :: * -> *) a. (MonadRandom m, Random a) => (a, a) -> m a
getRandomR (Int
0, Int
woptsLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

capitalizeR :: MonadRandom m => Text -> m Text
capitalizeR :: forall (m :: * -> *). MonadRandom m => Text -> m Text
capitalizeR = (Char -> m Char) -> Rational -> Text -> m Text
forall (m :: * -> *).
MonadRandom m =>
(Char -> m Char) -> Rational -> Text -> m Text
updateR (Char -> m Char
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> m Char) -> (Char -> Char) -> Char -> m Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char
toUpper) (Integer
1 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
12)

digitize :: MonadRandom m => GenPasswordOpts -> Text -> m Text
digitize :: forall (m :: * -> *).
MonadRandom m =>
GenPasswordOpts -> Text -> m Text
digitize GenPasswordOpts
opts Text
t
  | GenPasswordOpts -> Bool
woptsDigits GenPasswordOpts
opts = Text -> m Text
forall (m :: * -> *). MonadRandom m => Text -> m Text
digitizeR (Text -> m Text) -> m Text -> m Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< GenPasswordOpts -> Text -> m Text
forall (m :: * -> *).
MonadRandom m =>
GenPasswordOpts -> Text -> m Text
digitize1 GenPasswordOpts
opts Text
t
  | Bool
otherwise = Text -> m Text
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t

digitize1 :: MonadRandom m => GenPasswordOpts -> Text -> m Text
digitize1 :: forall (m :: * -> *).
MonadRandom m =>
GenPasswordOpts -> Text -> m Text
digitize1 GenPasswordOpts
_ Text
t
  | [Int] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
candidates = Text -> m Text
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t
  | Bool
otherwise = Int -> m Text
digitize1' (Int -> m Text) -> m Int -> m Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Int] -> m Int
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadRandom m) =>
t a -> m a
uniform [Int]
candidates
  where
    candidates :: [Int]
candidates = (Char -> Bool) -> Text -> [Int]
findIndices (Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Map Char [Char] -> [Char]
forall k a. Map k a -> [k]
Map.keys Map Char [Char]
numeralConversions) Text
t
    digitize1' :: Int -> m Text
digitize1' = (Char -> m Char) -> Text -> Int -> m Text
forall (m :: * -> *).
Monad m =>
(Char -> m Char) -> Text -> Int -> m Text
update1 ([Char] -> m Char
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadRandom m) =>
t a -> m a
uniform ([Char] -> m Char) -> (Char -> [Char]) -> Char -> m Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> [Char]
toDigit) Text
t

digitizeR :: MonadRandom m => Text -> m Text
digitizeR :: forall (m :: * -> *). MonadRandom m => Text -> m Text
digitizeR = (Char -> m Char) -> Rational -> Text -> m Text
forall (m :: * -> *).
MonadRandom m =>
(Char -> m Char) -> Rational -> Text -> m Text
updateR ([Char] -> m Char
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadRandom m) =>
t a -> m a
uniform ([Char] -> m Char) -> (Char -> [Char]) -> Char -> m Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> [Char]
toDigit) (Integer
1 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
6)

specialize :: MonadRandom m => GenPasswordOpts -> Text -> m Text
specialize :: forall (m :: * -> *).
MonadRandom m =>
GenPasswordOpts -> Text -> m Text
specialize GenPasswordOpts
opts Text
t
  | GenPasswordOpts -> Bool
woptsSpecials GenPasswordOpts
opts = Text -> m Text
forall (m :: * -> *). MonadRandom m => Text -> m Text
specializeR (Text -> m Text) -> m Text -> m Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< GenPasswordOpts -> Text -> m Text
forall (m :: * -> *).
MonadRandom m =>
GenPasswordOpts -> Text -> m Text
specialize1 GenPasswordOpts
opts Text
t
  | Bool
otherwise = Text -> m Text
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t

specialize1 :: MonadRandom m => GenPasswordOpts -> Text -> m Text
specialize1 :: forall (m :: * -> *).
MonadRandom m =>
GenPasswordOpts -> Text -> m Text
specialize1 GenPasswordOpts
_ Text
t
  | [Int] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
candidates = Text -> m Text
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t
  | Bool
otherwise = Int -> m Text
specialize1' (Int -> m Text) -> m Int -> m Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Int] -> m Int
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadRandom m) =>
t a -> m a
uniform [Int]
candidates
  where
    candidates :: [Int]
candidates = (Char -> Bool) -> Text -> [Int]
findIndices (Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Map Char [Char] -> [Char]
forall k a. Map k a -> [k]
Map.keys Map Char [Char]
symbolConversions) Text
t
    specialize1' :: Int -> m Text
specialize1' = (Char -> m Char) -> Text -> Int -> m Text
forall (m :: * -> *).
Monad m =>
(Char -> m Char) -> Text -> Int -> m Text
update1 ([Char] -> m Char
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadRandom m) =>
t a -> m a
uniform ([Char] -> m Char) -> (Char -> [Char]) -> Char -> m Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> [Char]
toSymbol) Text
t

specializeR :: MonadRandom m => Text -> m Text
specializeR :: forall (m :: * -> *). MonadRandom m => Text -> m Text
specializeR = (Char -> m Char) -> Rational -> Text -> m Text
forall (m :: * -> *).
MonadRandom m =>
(Char -> m Char) -> Rational -> Text -> m Text
updateR ([Char] -> m Char
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadRandom m) =>
t a -> m a
uniform ([Char] -> m Char) -> (Char -> [Char]) -> Char -> m Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> [Char]
toSymbol) (Integer
1 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
6)

-- | Map a letter to one or more digits, if possible
toDigit :: Char -> [Char]
toDigit :: Char -> [Char]
toDigit Char
c = [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char
Item [Char]
c] (Map Char [Char]
numeralConversions Map Char [Char] -> Char -> Maybe [Char]
forall k a. Ord k => Map k a -> k -> Maybe a
Map.!? Char
c)

toSymbol :: Char -> [Char]
toSymbol :: Char -> [Char]
toSymbol Char
c = [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char
Item [Char]
c] (Map Char [Char]
symbolConversions Map Char [Char] -> Char -> Maybe [Char]
forall k a. Ord k => Map k a -> k -> Maybe a
Map.!? Char
c)