diff --git a/src/Data/Gibberish/GenPass.hs b/src/Data/Gibberish/GenPass.hs index 61deda4..65aa428 100644 --- a/src/Data/Gibberish/GenPass.hs +++ b/src/Data/Gibberish/GenPass.hs @@ -44,6 +44,7 @@ genPassword' opts@(GenPassOptions {..}) = do Text.map toLower >>> capitalize opts >=> digitize opts + >=> specialize opts Word <$> transform pass @@ -113,6 +114,25 @@ digitize1 _ t digitizeR :: MonadRandom m => Text -> m Text digitizeR = updateR (uniform . toDigit) (1 % 6) +specialize :: MonadRandom m => GenPassOptions -> Text -> m Text +specialize opts t + | optsSpecials opts = specializeR =<< specialize1 opts t + | otherwise = pure t + +specialize1 :: MonadRandom m => GenPassOptions -> Text -> m Text +specialize1 _ t + | null candidates = pure t + | otherwise = specialize1' =<< uniform candidates + where + candidates = findIndices (`elem` Map.keys symbolConversions) t + specialize1' = update1 (uniform . toSymbol) t + +specializeR :: MonadRandom m => Text -> m Text +specializeR = updateR (uniform . toSymbol) (1 % 6) + -- | Map a letter to one or more digits, if possible toDigit :: Char -> [Char] toDigit c = fromMaybe [c] (numeralConversions Map.!? c) + +toSymbol :: Char -> [Char] +toSymbol c = fromMaybe [c] (symbolConversions Map.!? c) diff --git a/src/Data/Gibberish/Utils.hs b/src/Data/Gibberish/Utils.hs index b618a2e..6703d16 100644 --- a/src/Data/Gibberish/Utils.hs +++ b/src/Data/Gibberish/Utils.hs @@ -1,5 +1,6 @@ module Data.Gibberish.Utils ( numeralConversions, + symbolConversions, update1, updateR, findIndices, @@ -28,6 +29,15 @@ numeralConversions = ('b', ['8']) ] +-- | A mapping from letters to symbols that look like them +symbolConversions :: Map Char [Char] +symbolConversions = + Map.fromList + [ ('a', ['@']), + ('l', ['!']), + ('s', ['$']) + ] + update1 :: Monad m => (Char -> m Char) -> Text -> Int -> m Text update1 f t pos = case Text.splitAt pos t of diff --git a/test/Data/Gibberish/GenPassSpec.hs b/test/Data/Gibberish/GenPassSpec.hs index ad124c0..3d9a5df 100644 --- a/test/Data/Gibberish/GenPassSpec.hs +++ b/test/Data/Gibberish/GenPassSpec.hs @@ -4,7 +4,7 @@ import Data.Gibberish.GenPass (genPassword) import Data.Gibberish.MonadPass (usingPass) import Data.Gibberish.Trigraph (Language (..), loadTrigraph) import Data.Gibberish.Types (GenPassOptions (..), Word (..)) -import Data.Gibberish.Utils (numeralConversions) +import Data.Gibberish.Utils (numeralConversions, symbolConversions) import Test.Gibberish.Gen qualified as Gen import Control.Monad.IO.Class (liftIO) @@ -71,6 +71,26 @@ spec = do assert $ Text.any (\c -> isUpperCase c || isPunctuation c) pass + it "sometimes has multiple capitals when enabled" $ hedgehog $ do + trigraph <- liftIO $ loadTrigraph English + opts <- forAll Gen.genPassOptions + randomGen <- forAll Gen.stdGen + -- Only consider passwords of sufficient (>=10) length + len <- forAll (Gen.int $ Range.linear 10 20) + + let opts' = + opts + { optsTrigraph = trigraph, + optsCapitals = True, + optsLength = len + } + + let (Word pass, _) = usingPass randomGen (genPassword opts') + annotateShow pass + + cover 10 "has multiple capitals" $ + Text.length (Text.filter isUpperCase pass) > 1 + it "has at least one digit when enabled" $ hedgehog $ do trigraph <- liftIO $ loadTrigraph English opts <- forAll Gen.genPassOptions @@ -91,3 +111,67 @@ spec = do assert $ Text.any isNumber pass || Text.all (`Map.notMember` numeralConversions) pass + + it "sometimes has multiple digits when enabled" $ hedgehog $ do + trigraph <- liftIO $ loadTrigraph English + opts <- forAll Gen.genPassOptions + randomGen <- forAll Gen.stdGen + -- Only consider passwords of sufficient (>=10) length + len <- forAll (Gen.int $ Range.linear 10 20) + + let opts' = + opts + { optsTrigraph = trigraph, + optsDigits = True, + optsLength = len + } + + let (Word pass, _) = usingPass randomGen (genPassword opts') + annotateShow pass + + cover 10 "has multiple digits" $ + Text.length (Text.filter isNumber pass) > 1 + + it "usually has at least one special when enabled" $ hedgehog $ do + trigraph <- liftIO $ loadTrigraph English + opts <- forAll Gen.genPassOptions + randomGen <- forAll Gen.stdGen + -- Only consider passwords of sufficient (>=3) length + len <- forAll (Gen.int $ Range.linear 3 15) + + let opts' = + opts + { optsTrigraph = trigraph, + optsSpecials = True, + optsLength = len + } + + let (Word pass, _) = usingPass randomGen (genPassword opts') + annotateShow pass + + let allSymbols = concat (Map.elems symbolConversions) + + cover 50 "has at least one special" $ + Text.any (`elem` allSymbols) pass + + it "sometimes has at multiple specials when enabled" $ hedgehog $ do + trigraph <- liftIO $ loadTrigraph English + opts <- forAll Gen.genPassOptions + randomGen <- forAll Gen.stdGen + -- Only consider passwords of sufficient (>=10) length + len <- forAll (Gen.int $ Range.linear 10 20) + + let opts' = + opts + { optsTrigraph = trigraph, + optsSpecials = True, + optsLength = len + } + + let (Word pass, _) = usingPass randomGen (genPassword opts') + annotateShow pass + + let allSymbols = concat (Map.elems symbolConversions) + + cover 10 "has at least one special" $ + Text.length (Text.filter (`elem` allSymbols) pass) > 1