From 03e29933663c3b0504304f4a97c05d771584fcf8 Mon Sep 17 00:00:00 2001
From: Sean D Gillespie <sean@mistersg.net>
Date: Tue, 13 Feb 2024 22:51:53 -0500
Subject: [PATCH] feature(lib): Add a transformation to add special characters

---
 src/Data/Gibberish/GenPass.hs      | 20 +++++++
 src/Data/Gibberish/Utils.hs        | 10 ++++
 test/Data/Gibberish/GenPassSpec.hs | 86 +++++++++++++++++++++++++++++-
 3 files changed, 115 insertions(+), 1 deletion(-)

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