feature(lib): Add a genPassphrase function

app/Main.hs

@@ -5,7 +5,7 @@ import Data.Gibberish.Format qualified as Fmt
 import Data.Gibberish.GenPass (genPassword)
 import Data.Gibberish.MonadPass (Pass (), usingPass)
 import Data.Gibberish.Trigraph (Language (..), loadTrigraph)
-import Data.Gibberish.Types (GenPassOptions (..))
+import Data.Gibberish.Types (GenPasswordOpts (..))
 
 import Control.Monad.IO.Class (MonadIO (..))
 import Data.Maybe (fromMaybe)
@@ -79,12 +79,12 @@ passwords (CommonOpts {..}) (WordOpts {..}) gen = do
   trigraph <- liftIO $ loadTrigraph English
 
   let genOpts =
-        GenPassOptions
-          { optsCapitals = optCapitals,
-            optsDigits = optDigits,
-            optsSpecials = optSpecials,
-            optsTrigraph = trigraph,
-            optsLength = optLength
+        GenPasswordOpts
+          { woptsCapitals = optCapitals,
+            woptsDigits = optDigits,
+            woptsSpecials = optSpecials,
+            woptsTrigraph = trigraph,
+            woptsLength = optLength
           }
       formatOpts =
         Fmt.FormatOpts
@@ -98,7 +98,7 @@ passwords (CommonOpts {..}) (WordOpts {..}) gen = do
     fst $
       usingPass gen (genPasswords genOpts formatOpts)
 
-genPasswords :: RandomGen gen => GenPassOptions -> Fmt.FormatOpts -> Pass gen Text
+genPasswords :: RandomGen gen => GenPasswordOpts -> Fmt.FormatOpts -> Pass gen Text
 genPasswords genOpts formatOpts = do
   res <- sequence $ repeat (genPassword genOpts)
   pure (Fmt.formatWords formatOpts res)

src/Data/Gibberish/GenPass.hs

@@ -3,6 +3,7 @@
 
 module Data.Gibberish.GenPass
   ( genPassword,
+    genPassphrase,
   ) where
 
 import Data.Gibberish.MonadPass (MonadRandom ())
@@ -15,7 +16,6 @@ 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 (Map ())
 import Data.Map qualified as Map
 import Data.Maybe (fromMaybe)
 import Data.Ratio
@@ -24,18 +24,36 @@ import Data.Text qualified as Text
 import Prelude hiding (Word)
 
 -- | Generate a password with the given options
-genPassword :: MonadRandom m => GenPassOptions -> m Word
-genPassword opts@GenPassOptions {..}
-  | optsLength <= 2 = Word . Text.take optsLength . digramToText <$> first2 opts
+genPassword :: MonadRandom m => GenPasswordOpts -> m Word
+genPassword opts@GenPasswordOpts {..}
+  | woptsLength <= 2 = Word . Text.take woptsLength . digramToText <$> first2 opts
   | otherwise = genPassword' opts
 
+genPassphrase :: MonadRandom m => GenPassphraseOpts -> m [Word]
+genPassphrase (GenPassphraseOpts {..}) =
+  sequence $ repeat genWord
+  where
+    genWord = do
+      len <- getRandomR (poptsMinLength, poptsMaxLength)
+
+      let genPasswordOpts =
+            GenPasswordOpts
+              { woptsCapitals = poptsCapitals,
+                woptsDigits = poptsDigits,
+                woptsSpecials = poptsSpecials,
+                woptsTrigraph = poptsTrigraph,
+                woptsLength = len
+              }
+
+      genPassword genPasswordOpts
+
 -- | Generates a password with the given options. Assumes optsLength is at least 3.
-genPassword' :: MonadRandom m => GenPassOptions -> m Word
-genPassword' opts@(GenPassOptions {..}) = do
+genPassword' :: MonadRandom m => GenPasswordOpts -> m Word
+genPassword' opts@(GenPasswordOpts {..}) = do
   -- Select the first two characters
   f2 <- first2 opts
   -- Select the rest of the characters
-  rest <- lastN opts (optsLength - 2) f2
+  rest <- lastN opts (woptsLength - 2) f2
   -- Construct the full password from f2 and rest
   let pass = digramToText f2 `Text.append` Text.reverse rest
 
@@ -51,8 +69,8 @@ genPassword' opts@(GenPassOptions {..}) = do
 digramToText :: Digram -> Text
 digramToText (Digram a b) = [a, b]
 
-first2 :: MonadRandom m => GenPassOptions -> m Digram
-first2 GenPassOptions {optsTrigraph = Trigraph trigraph} =
+first2 :: MonadRandom m => GenPasswordOpts -> m Digram
+first2 GenPasswordOpts {woptsTrigraph = Trigraph trigraph} =
   fromList . map toWeight . Map.toList $ trigraph
   where
     toWeight :: (Digram, Frequencies) -> (Digram, Rational)
@@ -62,18 +80,18 @@ first2 GenPassOptions {optsTrigraph = Trigraph trigraph} =
     sumFrequencies (Frequencies freqs) =
       Map.foldr (\a b -> fromIntegral a + b) 0 freqs
 
-lastN :: MonadRandom m => GenPassOptions -> Int -> Digram -> m Text
+lastN :: MonadRandom m => GenPasswordOpts -> Int -> Digram -> m Text
 lastN opts len di@(Digram _ b)
   | len <= 0 = pure []
   | otherwise = do
       c <- next opts di
       rs <- lastN opts (len - 1) (Digram b c)
       pure (c `Text.cons` rs)
 
-next :: MonadRandom m => GenPassOptions -> Digram -> m Char
-next GenPassOptions {..} digram = do
+next :: MonadRandom m => GenPasswordOpts -> Digram -> m Char
+next GenPasswordOpts {..} digram = do
   res <- runMaybeT $ do
-    (Frequencies freqs) <- hoistMaybe $ Map.lookup digram (unTrigraph optsTrigraph)
+    (Frequencies freqs) <- hoistMaybe $ Map.lookup digram (unTrigraph woptsTrigraph)
     let weights = map (bimap unUnigram fromIntegral) (Map.toList freqs)
     MaybeT $ fromListMay weights
 
@@ -85,25 +103,25 @@ nextDefault = uniform (['a' .. 'z'] :: [Char])
 
 -- | Randomly capitalize at least 1 character. Additional characters capitalize
 --  at a probability of 1/12
-capitalize :: MonadRandom m => GenPassOptions -> Text -> m Text
-capitalize opts@GenPassOptions {..} t
-  | optsCapitals = capitalizeR =<< capitalize1 opts t
+capitalize :: MonadRandom m => GenPasswordOpts -> Text -> m Text
+capitalize opts@GenPasswordOpts {..} t
+  | woptsCapitals = capitalizeR =<< capitalize1 opts t
   | otherwise = pure t
 
 -- | Randomly capitalize 1 character
-capitalize1 :: MonadRandom m => GenPassOptions -> Text -> m Text
-capitalize1 GenPassOptions {..} t =
-  update1 (pure . toUpper) t =<< getRandomR (0, optsLength - 1)
+capitalize1 :: MonadRandom m => GenPasswordOpts -> Text -> m Text
+capitalize1 GenPasswordOpts {..} t =
+  update1 (pure . toUpper) t =<< getRandomR (0, woptsLength - 1)
 
 capitalizeR :: MonadRandom m => Text -> m Text
 capitalizeR = updateR (pure . toUpper) (1 % 12)
 
-digitize :: MonadRandom m => GenPassOptions -> Text -> m Text
+digitize :: MonadRandom m => GenPasswordOpts -> Text -> m Text
 digitize opts t
-  | optsDigits opts = digitizeR =<< digitize1 opts t
+  | woptsDigits opts = digitizeR =<< digitize1 opts t
   | otherwise = pure t
 
-digitize1 :: MonadRandom m => GenPassOptions -> Text -> m Text
+digitize1 :: MonadRandom m => GenPasswordOpts -> Text -> m Text
 digitize1 _ t
   | null candidates = pure t
   | otherwise = digitize1' =<< uniform candidates
@@ -114,12 +132,12 @@ digitize1 _ t
 digitizeR :: MonadRandom m => Text -> m Text
 digitizeR = updateR (uniform . toDigit) (1 % 6)
 
-specialize :: MonadRandom m => GenPassOptions -> Text -> m Text
+specialize :: MonadRandom m => GenPasswordOpts -> Text -> m Text
 specialize opts t
-  | optsSpecials opts = specializeR =<< specialize1 opts t
+  | woptsSpecials opts = specializeR =<< specialize1 opts t
   | otherwise = pure t
 
-specialize1 :: MonadRandom m => GenPassOptions -> Text -> m Text
+specialize1 :: MonadRandom m => GenPasswordOpts -> Text -> m Text
 specialize1 _ t
   | null candidates = pure t
   | otherwise = specialize1' =<< uniform candidates

src/Data/Gibberish/Types.hs

@@ -1,7 +1,8 @@
 {-# LANGUAGE OverloadedLists #-}
 
 module Data.Gibberish.Types
-  ( GenPassOptions (..),
+  ( GenPasswordOpts (..),
+    GenPassphraseOpts (..),
     Unigram (..),
     Digram (..),
     Trigram (..),
@@ -24,18 +25,35 @@ import GHC.Generics (Generic ())
 import TextShow (TextShow (..), fromString)
 import Prelude hiding (Word ())
 
--- | Password/Passphrase generation options
-data GenPassOptions = GenPassOptions
+-- | Password generation options
+data GenPasswordOpts = GenPasswordOpts
   { -- | Include capitals?
-    optsCapitals :: !Bool,
+    woptsCapitals :: !Bool,
     -- | Include numerals?
-    optsDigits :: !Bool,
+    woptsDigits :: !Bool,
     -- | Include special characters?
-    optsSpecials :: !Bool,
+    woptsSpecials :: !Bool,
     -- | The trigraph to use
-    optsTrigraph :: Trigraph,
+    woptsTrigraph :: Trigraph,
     -- | The length of the password
-    optsLength :: !Int
+    woptsLength :: !Int
+  }
+  deriving stock (Eq, Show)
+
+-- | Passphrase generation options
+data GenPassphraseOpts = GenPassphraseOpts
+  { -- | Include capitals?
+    poptsCapitals :: !Bool,
+    -- | Include numerals?
+    poptsDigits :: !Bool,
+    -- | Include special characters?
+    poptsSpecials :: !Bool,
+    -- | The trigraph to use
+    poptsTrigraph :: Trigraph,
+    -- | The mininum length of each word
+    poptsMinLength :: !Int,
+    -- | The maximum length of each word
+    poptsMaxLength :: !Int
   }
   deriving stock (Eq, Show)