diff --git a/Data/Random/Choice.hs b/Data/Random/Choice.hs deleted file mode 100644 --- a/Data/Random/Choice.hs +++ /dev/null @@ -1,21 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} --- | Random choice between two alternatives of inequal probability. -module Data.Random.Choice(randomChoice) where - -import Data.Random.RVar -import Data.Random.Distribution -import Data.Random.Distribution.Uniform - --- | Performs random choice between two RVar values. --- Input is a _ratio_ of the _relative_ probabilities between first and --- second option (A/B). -randomChoice :: (Fractional r, Ord r, Data.Random.Distribution.Distribution Uniform r) => r -> - RVar b -> RVar b -> RVar b -randomChoice ratio variantA variantB = do draw <- uniform 0 1 - if draw >= probabilityOfVariantA - then variantA - else variantB - where - probabilityOfVariantA = 1/(1+1/ratio) - - diff --git a/Data/Random/RVar/Enum.hs b/Data/Random/RVar/Enum.hs deleted file mode 100644 --- a/Data/Random/RVar/Enum.hs +++ /dev/null @@ -1,15 +0,0 @@ -{-# LANGUAGE OverlappingInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE FlexibleInstances #-} --- | Provides a random variable (@RVar@) instance for any @Enum@ instance. --- Very convenient, even if may overlap with more specific instances for integer types. -module Data.Random.RVar.Enum() where - -import Data.Random.Distribution -import Data.Random.Distribution.Uniform -import Control.Applicative((<$>)) - --- TODO: Send to library author as a "missing instance" -instance (Enum a) => Distribution Uniform a where - rvarT (Uniform l h) = toEnum <$> uniformT (fromEnum l) (fromEnum h) - diff --git a/Data/Random/Vector.hs b/Data/Random/Vector.hs deleted file mode 100644 --- a/Data/Random/Vector.hs +++ /dev/null @@ -1,12 +0,0 @@ --- | Provides a convenient way to pick a random element of a vector. -module Data.Random.Vector(randomElement) where - -import Data.Random.RVar -import Data.Random.Distribution.Uniform -import qualified Data.Vector as V -import Control.Applicative - --- | Take a random element of a vector. -randomElement :: V.Vector a -> RVar a -randomElement elements = (elements V.!) <$> uniform 0 (V.length elements - 1) - diff --git a/Text/WordPass.hs b/Text/WordPass.hs --- a/Text/WordPass.hs +++ b/Text/WordPass.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE TemplateHaskell, NoMonomorphismRestriction #-} +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE ScopedTypeVariables #-} -- | Main module generating passwords. module Text.WordPass where @@ -12,12 +13,7 @@ import qualified Data.Set as Set import Data.Set (Set) import Data.Char (isAlpha, isPunctuation, isSymbol) -import Data.Random.RVar -import Data.Random.RVar.Enum() -import Data.Random.Choice -import Data.Random.Vector -import Data.Random.Distribution.Uniform -import Data.Random.Source.IO() +import Test.QuickCheck.Gen import qualified Data.Vector as V import Control.Applicative import Control.Monad (replicateM, foldM, filterM) @@ -36,7 +32,7 @@ resolveSymbolicLink s = do b <- isSymbolicLink `fmap` getSymbolicLinkStatus s if b then do newPath <- readSymbolicLink s - resolveSymbolicLink $! takeDirectory s newPath + resolveSymbolicLink $! takeDirectory s newPath else return s -- | Reads a dict format to get a list of unique words without any special @@ -92,9 +88,9 @@ defaultDictionary = "/usr/share/dict/british-english" -- | Pick a random password, given a words list, and a number of words it will contain. -randomPassword :: WordList -> Int -> RVar Text -randomPassword wordlist numWords = do ws <- replicateM numWords $ randomElement wordlist - seps <- replicateM numWords randomSeparator +randomPassword :: WordList -> Int -> Gen Text +randomPassword wordlist numWords = do ws <- replicateM numWords $ randomElement wordlist + seps <- replicateM numWords randomSeparator return $ Text.concat $ zipWith Text.append ws seps -- | Estimate strength of random password with given inputs. @@ -113,25 +109,31 @@ -- * Random separators -- | Randomly pick a word separator as a two-digit number, or a symbol -- character. -randomSeparator :: RVar Text -randomSeparator = randomChoice ratio randomSymbolSeparator randomNumericSeparator +randomSeparator :: Gen Text +randomSeparator = do + r <- choose (0.0, 1.0::Double) + if r > ratio + then randomSymbolSeparator + else randomNumericSeparator where - ratio = numSymbols % numNumericSeparators + ratio :: Double = fromIntegral numSymbols / fromIntegral(numNumericSeparators+numSymbols) -- | Two-digit number as a separator 10^2 = 6.6 bits of entropy. -randomNumericSeparator :: RVar Text -randomNumericSeparator = Text.pack <$> show <$> uniform 0 (numNumericSeparators :: Int) +randomNumericSeparator :: Gen Text +randomNumericSeparator = Text.pack . show <$> choose (0, numNumericSeparators-1) -- | Conjunction of two unary predicates (|||) :: (t -> Bool) -> (t -> Bool) -> t -> Bool (|||) f g x = f x || g x +randomElement :: V.Vector a -> Gen a +randomElement v = (v V.!) <$> choose (0, V.length v-1) + -- | List of symbol and punctuation characters in ASCII -- Should be 5 bits of entropy symbolChars :: V.Vector Char symbolChars = V.fromList $ filter (isSymbol ||| isPunctuation) $ map toEnum [0..127] -- | Text with random symbol character, 5 bits of entropy -randomSymbolSeparator :: RVar Text +randomSymbolSeparator :: Gen Text randomSymbolSeparator = Text.singleton <$> randomElement symbolChars - diff --git a/WordPass.hs b/WordPass.hs --- a/WordPass.hs +++ b/WordPass.hs @@ -1,55 +1,66 @@ -{-# LANGUAGE TemplateHaskell, NoMonomorphismRestriction #-} +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE RecordWildCards #-} -- | Main module generating passwords. module Main where import qualified Data.Text.IO as Text import qualified Data.Set as Set -import Data.Random.Sample -import Data.Random.RVar.Enum() -import Data.Random.Source.DevRandom -import Data.Random.Source.IO() import qualified Data.Vector as V import Control.Applicative import Control.Monad (replicateM_) -import HFlags +import Options.Applicative import Text.WordPass +import Test.QuickCheck.Gen(generate) -- * Command-line flags --- | Number of words per password -defineFlag "w:words" (4 :: Int) "Number of words for each password." - --- | Number of passwords -defineFlag "p:passwords" (10 :: Int) "Number of passwords to generate." - --- | Default word list directory. -defineFlag "d:directory" ("/usr/share/dict" :: FilePath) "Default directory to search for dictionaries\n (works only if --wordlist options is NOT USED.)" - --- | Pick specific wordlist. -defineFlag "l:wordlist" ("" :: FilePath) "Select particular dictionary (filepath)." - --- | Pick specific wordlist. -defineFlag "t:pseudorandom" (False :: Bool) "Generate passwords using StdRandom generator, instead of DevRandom. (Faster, but less safe. Good for testing." - --- | Fake flag to avoid GHC losing the last instance declaration -defineFlag "fakeflag" (False :: Bool) "This flag does nothing and is never used" +data Options = Options { + optWords :: Int + -- ^ Number of words per password + , optCount :: Int + -- ^ Number of passwords + , optWordlist :: Either FilePath FilePath + -- ^ Default word list directory or pick specific wordlist. + } deriving (Show) +options :: Parser Options +options = Options + <$> option auto (short 'w' <> + long "words" <> + metavar "INT" <> + value 4 <> + help "Number of words for each password.") + <*> option auto (short 'p' <> + long "passwords" <> + metavar "COUNT" <> + value 10 <> + help "Number of passwords to generate.") + <*> ((Left <$> strOption (short 'd' <> + long "directory" <> + metavar "DIR" <> + value "/usr/share/dict" <> + help "Default directory to search for dictionaries.")) + <|> (Right <$> strOption (short 'l' <> + long "wordlist" <> + metavar "FILENAME" <> + help "Use specific wordlist file."))) -- | Read wordlist given by explict filepath, or search for all wordlists in a given directory. -selectWordList :: FilePath -> FilePath -> IO WordSet -selectWordList "" dir = readDictDir dir -selectWordList filename _ = readDict filename +selectWordList :: Either FilePath FilePath -> IO WordSet +selectWordList (Left dir ) = readDictDir dir +selectWordList (Right filename) = readDict filename +parseOptions = info (options <**> helper) + (fullDesc <> + progDesc "Generate xkcd-style passwords" <> + header "WordPass - dictionary-based password generator") + main :: IO () -main = do _args <- $initHFlags "WordPass - dictionary-based password generator" - dictWords <- (V.fromList . Set.toList) <$> selectWordList flags_wordlist flags_directory +main = do Options {..} <- execParser parseOptions + dictWords <- (V.fromList . Set.toList) <$> selectWordList optWordlist putStrLn $ "Read " ++ show (V.length dictWords) ++ " words from dictionaries." putStr "Estimated password strength (bits): " - print $ randomPasswordStrength dictWords flags_words - replicateM_ flags_passwords $ do - let rand = randomPassword dictWords flags_words - rv <- if flags_pseudorandom - then sample rand - else sampleFrom DevRandom rand + print $ randomPasswordStrength dictWords optWords + replicateM_ optCount $ do + let rand = randomPassword dictWords optWords + rv <- generate rand Text.putStrLn rv - - diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -1,4 +1,9 @@ -*-Changelog-*- +1.0.0.9 May 2018 + * Use Test.QuickCheck.Gen for random generation instead of RVar. + +1.0.0.8 Nov 2017 + * Relax deps for GHC 8.2. 1.0.0.7 Nov 2016 * Updated to directory-1.2.6.2 on GHC 8.0. diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -36,7 +36,6 @@ # non-dependency (i.e. a user package), and its test suites and benchmarks # will not be run. This is useful for tweaking upstream packages. packages: -#- haskeleton/ - '.' # Dependency packages to be pulled from upstream that are not in the resolver # (e.g., acme-missiles-0.3) diff --git a/wordpass.cabal b/wordpass.cabal --- a/wordpass.cabal +++ b/wordpass.cabal @@ -1,5 +1,5 @@ name: wordpass -version: 1.0.0.7 +version: 1.0.0.9 synopsis: Dictionary-based password generator description: This script reads dict word lists and generates word-based passwords. Not unlike . @@ -22,7 +22,7 @@ extra-source-files: README.md changelog stack.yaml cabal-version: >=1.10 stability: stable -tested-with: GHC==8.0.1 +tested-with: GHC==7.8.4,GHC==7.10.3,GHC==8.0.1,GHC==8.2.2 source-repository head type: git @@ -30,36 +30,35 @@ executable wordpass main-is: WordPass.hs - other-modules: Data.Random.RVar.Enum, Data.Random.Vector, Data.Random.Choice, Text.WordPass + other-modules: Text.WordPass other-extensions: OverlappingInstances, MultiParamTypeClasses, FlexibleInstances - build-depends: base >=4.4 && <4.10, + build-depends: base >=4.4 && <4.11, text >=1.1 && <1.4, containers >=0.5 && <0.6, - random-fu >=0.2 && <0.3, - random-source >=0.3 && <0.4, - vector >=0.10 && <0.12, + vector >=0.10 && <0.13, directory >= 1.2 && <1.4, + optparse-applicative >= 0.12 && <0.14, unix-compat >= 0.4 && <0.5, deepseq >= 1.3 && <1.5, filepath >= 1.3 && <1.5, - hflags >= 0.4 && <0.5 + QuickCheck >= 2.0 && <3.0 ghc-options: -O3 -- hs-source-dirs: default-language: Haskell2010 library - exposed-modules: Data.Random.RVar.Enum, Data.Random.Vector, Data.Random.Choice, Text.WordPass + exposed-modules: Text.WordPass other-extensions: OverlappingInstances, MultiParamTypeClasses, FlexibleInstances - build-depends: base >=4.4 && <4.10, + build-depends: base >=4.4 && <4.11, text >=1.1 && <1.4, containers >=0.5 && <0.6, - random-fu >=0.2 && <0.3, - random-source >=0.3 && <0.4, - vector >=0.10 && <0.12, + vector >=0.10 && <0.13, directory >= 1.2 && <1.4, unix-compat >= 0.4 && <0.5, deepseq >= 1.3 && <1.5, - filepath >= 1.3 && <1.5 + QuickCheck >= 2.0 && <3.0, + filepath >= 1.3 && <1.5, + optparse-applicative >= 0.12 && <0.14 ghc-options: -O3 -- hs-source-dirs: default-language: Haskell2010