scat 1.0.1.0 → 1.1.0.0
raw patch · 8 files changed
+348/−240 lines, 8 filesdep ~ansi-terminaldep ~basedep ~bytestring
Dependency ranges changed: ansi-terminal, base, bytestring, mtl, optparse-applicative, scrypt
Files
- scat.cabal +30/−13
- src/Main.hs +162/−0
- src/Scat.hs +2/−172
- src/Scat/Builder.hs +7/−7
- src/Scat/Options.hs +8/−0
- src/Scat/Schemas.hs +74/−41
- src/Scat/Utils/Permutation.hs +9/−7
- src/Tests.hs +56/−0
scat.cabal view
@@ -1,16 +1,16 @@--- Initial scat.cabal generated by cabal init. For further documentation, +-- Initial scat.cabal generated by cabal init. For further documentation, -- see http://haskell.org/cabal/users-guide/ -- The name of the package. name: scat --- The package version. See the Haskell package versioning policy (PVP) +-- The package version. See the Haskell package versioning policy (PVP) -- for standards guiding when and how versions should be incremented. -- http://www.haskell.org/haskellwiki/Package_versioning_policy -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change-version: 1.0.1.0+version: 1.1.0.0 -- A short (one-line) description of the package. synopsis: Generates unique passwords for various websites from a single password.@@ -27,7 +27,7 @@ -- The package author(s). author: Romain Edelmann --- An email address to which users can send suggestions, bug reports, and +-- An email address to which users can send suggestions, bug reports, and -- patches. maintainer: romain.edelmann@gmail.com @@ -38,7 +38,7 @@ stability: experimental -- A copyright notice.--- copyright: +-- copyright: category: Password @@ -49,7 +49,7 @@ data-dir: lists -data-files: *.txt +data-files: *.txt source-repository head type: git@@ -57,15 +57,32 @@ executable scat -- .hs or .lhs file containing the Main module.- main-is: Scat.hs+ main-is: Main.hs - ghc-options: -Wall -O3 - + ghc-options: -Wall -O3+ hs-source-dirs: src -- Modules included in this executable, other than Main.- other-modules: Scat.Builder, Scat.Schemas, Scat.Options, Scat.Utils.Permutation, Paths_scat- + other-modules: Scat, Scat.Builder, Scat.Schemas, Scat.Options, Scat.Utils.Permutation, Paths_scat+ -- Other library packages from which modules are imported.- build-depends: base ==4.5.*, scrypt ==0.3.*, bytestring ==0.9.*, optparse-applicative ==0.5.*, mtl ==2.1.*, vector ==0.10.*, ansi-terminal ==0.6.*- + build-depends: base >=4.5 && <5+ , scrypt == 0.5.*+ , bytestring+ , optparse-applicative >= 0.5+ , mtl+ , vector == 0.10.*+ , ansi-terminal >= 0.6.1++test-suite scat-tests+ type: exitcode-stdio-1.0+ main-is: Tests.hs+ hs-source-dirs: src+ build-depends: base >=4.5 && <5+ , scrypt == 0.5.*+ , bytestring+ , optparse-applicative >= 0.5+ , mtl+ , vector == 0.10.*+ , ansi-terminal >= 0.6.1
+ src/Main.hs view
@@ -0,0 +1,162 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Password scatterer.+module Main (main) where++import Data.ByteString (ByteString, unpack)+import qualified Data.ByteString.Char8 as C+import System.IO+import System.Exit+import System.Console.ANSI+import Control.Exception+import Control.Monad.Reader++import Scat+import Scat.Schemas+import Scat.Builder+import Scat.Options++-- | Main type of the program.+type Scat a = ReaderT Options IO a++-- | Input visibility.+data Visibility = Shown | Hidden | Erased++-- | Should the input be echoed?+shouldShow :: Visibility -> Bool+shouldShow Shown = True+shouldShow Hidden = False+shouldShow Erased = True++-- | Should the input be erased afterwards?+shouldErase :: Visibility -> Bool+shouldErase Shown = False+shouldErase Hidden = False+shouldErase Erased = True++{- | Generates a password, given a input password,+ a service name (category, website, etc.),+ a code, and a password `Schema`.++ The parameters are specified as command line arguments.+ The password can be read from @stdin@ if not already provided. -}+main :: IO ()+main = getOptions >>= runReaderT scat++-- | Main program.+scat :: Scat ()+scat = do+ s <- getSchema+ k <- getService+ pw <- getPassword+ c <- getCode+ printVerbose "Generated password:\n"+ ms <- fmap size ask+ showGenerated $ evalBuilder (getBuilder s ms) $ scatter k pw c++-- | Prints out the generated password.+showGenerated :: String -> Scat ()+showGenerated gen = do+ v <- fmap verbose ask+ a <- fmap ansi ask+ let ok = v && a+ liftIO $ do+ when ok $ setSGR [SetSwapForegroundBackground True]+ putStrLn gen+ when ok $ setSGR [SetSwapForegroundBackground False]+++-- | Prints, if the verbosity level allows it.+printVerbose :: String -> Scat ()+printVerbose str = do+ v <- fmap verbose ask+ when v $ liftIO $ do+ putStr str+ hFlush stdout++-- | Gets the password.+getPassword :: Scat ByteString+getPassword = do+ mpw <- fmap password ask+ case mpw of+ -- Ask for the password on stdin.+ Nothing -> do+ c <- fmap confirm ask+ if c+ then getPassConfirm+ else getPass++ -- Retrieve the password from the arguments.+ Just st -> return $ C.pack st+ where+ getPass = prompt Hidden "Password: "++ getPassConfirm = do+ a <- prompt Hidden "Password: "+ b <- prompt Hidden "Confirm: "+ if a == b+ then return a+ else do+ printVerbose "Passwords do not match, please retry.\n"+ getPassConfirm++-- | Ask a for input on the command line, with the specified prompt.+prompt :: Visibility -> String -> Scat ByteString+prompt vis str = do+ printVerbose str+ old <- liftIO $ hGetEcho stdin+ pw <- liftIO $ bracket_+ (hSetEcho stdin $ shouldShow vis)+ (hSetEcho stdin old)+ C.getLine+ v <- fmap verbose ask+ a <- fmap ansi ask+ when (shouldErase vis && a && v) $ liftIO $ do+ cursorUpLine 1+ cursorForward $ length str+ clearFromCursorToScreenEnd+ cursorDownLine 1+ unless (shouldShow vis) $ printVerbose "\n"+ return pw++-- | Gets the service.+getService :: Scat ByteString+getService = do+ mk <- fmap service ask+ case mk of+ Just k -> return $ C.pack k+ Nothing -> prompt Shown "Service: "++-- | Gets the code.+getCode :: Scat ByteString+getCode = do+ uc <- fmap useCode ask+ if uc+ then do+ mc <- fmap code ask+ case mc of+ Just st -> return $ C.pack st+ Nothing -> prompt Erased "Code: "+ else return ""+++-- | Lists all the available schemas.+schemas :: [(String, Scat Schema)]+schemas =+ [ ("safe", return safe)+ , ("alpha", return alphanumeric)+ , ("parano", return paranoiac)+ , ("pin", return pin)+ , ("lock", return androidPatternLock)+ , ("diceware", liftIO diceware)+ , ("pokemons", liftIO pokemons) ]++-- | Gets the schema to generate the new password.+getSchema :: Scat Schema+getSchema = do+ name <- fmap schema ask+ case lookup name schemas of+ Just s -> s+ Nothing -> liftIO $ do+ hPutStrLn stderr "Error: Unknown schema"+ exitFailure
src/Scat.hs view
@@ -1,185 +1,15 @@-{-# LANGUAGE OverloadedStrings, PatternGuards #-} -- | Password scatterer.-module Main (main) where+module Scat (scatter) where import Data.Monoid import Data.ByteString (ByteString, unpack) import qualified Data.ByteString.Char8 as C-import System.IO-import System.Exit-import System.Console.ANSI-import Control.Exception-import Control.Monad.Reader import Crypto.Scrypt -import Scat.Schemas-import Scat.Builder-import Scat.Options- -- | Generates the seed integer given a service, a password and a code. scatter :: ByteString -> ByteString -> ByteString -> Integer scatter k pw c = foldr (\ n s -> fromIntegral n + 256 * s) 0 $- unpack $ unHash $ scrypt params (Salt k) (Pass $ pw <> c)+ unpack $ getHash $ scrypt params (Salt k) (Pass $ pw <> c) where Just params = scryptParams 14 8 50---- | Main type of the program.-type Scat a = ReaderT Options IO a---- | Input visibility.-data Visibility = Shown | Hidden | Erased---- | Should the input be echoed?-shouldShow :: Visibility -> Bool-shouldShow Shown = True-shouldShow Hidden = False-shouldShow Erased = True---- | Should the input be erased afterwards?-shouldErase :: Visibility -> Bool-shouldErase Shown = False-shouldErase Hidden = False-shouldErase Erased = True--{- | Generates a password, given a input password,- a service name (category, website, etc.),- a code, and a password `Schema`.-- The parameters are specified as command line arguments.- The password can be read from @stdin@ if not already provided. -}-main :: IO ()-main = getOptions >>= runReaderT scat---- | Main program.-scat :: Scat ()-scat = do- k <- getService- s <- getSchema- pw <- getPassword- c <- getCode- printVerbose "Generated password:\n"- showGenerated $ evalBuilder s $ scatter k pw c---- | Prints out the generated password.-showGenerated :: String -> Scat ()-showGenerated gen = do- v <- fmap verbose ask- a <- fmap ansi ask- let ok = v && a- liftIO $ do- when ok $ setSGR [SetSwapForegroundBackground True]- putStrLn gen- when ok $ setSGR [SetSwapForegroundBackground False]----- | Prints, if the verbosity level allows it.-printVerbose :: String -> Scat ()-printVerbose str = do- v <- fmap verbose ask- when v $ liftIO $ do- putStr str- hFlush stdout---- | Gets the password.-getPassword :: Scat ByteString-getPassword = do- mpw <- fmap password ask- case mpw of- -- Ask for the password on stdin.- Nothing -> do- c <- fmap confirm ask- if c- then getPassConfirm- else getPass-- -- Retrieve the password from the arguments.- Just st -> return $ C.pack st- where- getPass = prompt Hidden "Password: "-- getPassConfirm = do- a <- prompt Hidden "Password: "- b <- prompt Hidden "Confirm: "- if a == b- then return a- else do- printVerbose "Passwords do not match, please retry.\n"- getPassConfirm---- | Ask a for input on the command line, with the specified prompt.-prompt :: Visibility -> String -> Scat ByteString-prompt vis str = do- printVerbose str- old <- liftIO $ hGetEcho stdin- pw <- liftIO $ bracket_- (hSetEcho stdin $ shouldShow vis)- (hSetEcho stdin old)- C.getLine- v <- fmap verbose ask- a <- fmap ansi ask- when (shouldErase vis && a && v) $ liftIO $ do- cursorUpLine 1- cursorForward $ length str- clearFromCursorToScreenEnd- cursorDownLine 1- unless (shouldShow vis) $ printVerbose "\n"- return pw---- | Gets the service.-getService :: Scat ByteString-getService = do- mk <- fmap service ask- case mk of- Just k -> return $ C.pack k- Nothing -> prompt Shown "Service: "---- | Gets the code.-getCode :: Scat ByteString-getCode = do- uc <- fmap useCode ask- if uc- then do- mc <- fmap code ask- case mc of- Just st -> return $ C.pack st- Nothing -> prompt Erased "Code: "- else return ""---- | Gets the schema to generate the new password.-getSchema :: Scat Schema-getSchema = do- name <- fmap schema ask- case name of- -- Safe, the default.- "safe" -> return safe-- -- Alphanumeric.- "alpha" -> return alphanumeric-- -- Paranoiac- "parano" -> return paranoiac-- -- PIN.- 'p' : 'i' : 'n' : xs | [(n, "")] <- reads xs -> return $ pin n-- -- PIN with default size.- "pin" -> return $ pin 6-- -- Pattern lock- 'l' : 'o' : 'c' : 'k' : xs | [(n, "")] <- reads xs -> return $- androidPatternLock n-- -- Default size of pattern lock- "lock" -> return $ androidPatternLock 9-- -- Passphrase using Diceware's list.- "diceware" -> liftIO diceware-- -- Passphrase using Pokemons.- "pokemons" -> liftIO pokemons-- -- Unkown.- _ -> liftIO $ do- hPutStrLn stderr "Error: Unknown schema"- exitFailure
src/Scat/Builder.hs view
@@ -63,7 +63,7 @@ pure x = Builder (\ n -> (n, x)) f <*> x = Builder $ \ n -> let (n', g) = runBuilder f n- in fmap g $ runBuilder x n'+ in g <$> runBuilder x n' instance Monad Builder where return = pure@@ -85,19 +85,19 @@ -- | Returns a lower case letter. lower :: Builder Char-lower = fmap (chr . (+ ord 'a')) $ lessThan 26+lower = (chr . (+ ord 'a')) <$> lessThan 26 -- | Returns an upper case letter. upper :: Builder Char-upper = fmap (chr . (+ ord 'A')) $ lessThan 26+upper = (chr . (+ ord 'A')) <$> lessThan 26 -- | Returns an printable ascii char. ascii :: Builder Char-ascii = fmap chr $ inRange (32, 126)+ascii = chr <$> inRange (32, 126) -- | Returns a digit. digit :: Builder Char-digit = fmap chr $ inRange (48, 57)+digit = chr <$> inRange (48, 57) -- | Returns a letter. letter :: Builder Char@@ -125,7 +125,7 @@ -- | Shuffles the input list. shuffle :: [a] -> Builder [a]-shuffle xs = fmap (perm xs) $ lessThan $ fact $ length xs+shuffle xs = fmap (perm xs) $ lessThan $ fact $ fromIntegral $ length xs where- fact :: Int -> Int+ fact :: Integer -> Integer fact n = product [1 .. n]
src/Scat/Options.hs view
@@ -11,6 +11,7 @@ , useCode , code , schema+ , size , verbose , confirm , ansi@@ -34,6 +35,8 @@ -- ^ Extra code. , schema :: String -- ^ Name of the schema to use.+ , size :: Maybe Int+ -- ^ Size parameter of the schema. , verbose :: Bool -- ^ Verbosity. If false, do not print anything but the generated password. , confirm :: Bool@@ -81,6 +84,11 @@ <> metavar "SCHEMA" <> value "safe" <> showDefault)+ <*> optional (option+ (short 'n'+ <> long "size"+ <> help "Size parameter"+ <> metavar "SIZE")) <*> flag True False (long "silent" <> help "Do not print anything but the generated password")
src/Scat/Schemas.hs view
@@ -7,26 +7,37 @@ -- * Type Schema - -- * Passwords+ -- ** Constructors+ , withDefaultSize+ , ignoreSize++ -- ** Destructor+ , getBuilder++ -- * Built-in schemas++ -- ** Passwords , safe , alphanumeric , paranoiac - -- * PIN+ -- ** PIN , pin - -- * Pass phrases+ -- ** Pass phrases , pokemons , diceware - -- * Pattern lock+ -- ** Pattern lock , androidPatternLock ) where +import Data.Ratio ((%)) import Data.List (intercalate, (\\)) import Data.Vector (Vector) import qualified Data.Vector as V import Data.Monoid+import Control.Applicative import Control.Monad (replicateM) import System.IO @@ -35,39 +46,60 @@ import Paths_scat -- | Password builder.-type Schema = Builder String+data Schema = Schema+ { defaultSize :: Int+ , builder :: Int -> Builder String } --- | Paranoiac mode, entropy of 512 bits.+-- | Returns a `Builder` given an optional size.+getBuilder :: Schema -> Maybe Int -> Builder String+getBuilder schema Nothing = builder schema $ defaultSize schema+getBuilder schema (Just s) = builder schema s++-- | Specifies the Schema will not be sensible to any size parameter.+ignoreSize :: Builder String -> Schema+ignoreSize = Schema undefined . const++-- | Specifies the Schema accepts a size parameter.+withDefaultSize :: Int -> (Int -> Builder String) -> Schema+withDefaultSize = Schema++-- | Paranoiac mode, entropy of 512 bits with the default size of 78. paranoiac :: Schema-paranoiac = replicateM 78 ascii+paranoiac = withDefaultSize 78 $ \ s -> replicateM s ascii -{- | Generates a password of length 18,+{- | Generates a password, containing upper case letters, lower case letters, digits and symbols.- Entropy of about 115 bits. -}+ Entropy of about 115 bits for length 18. -} safe :: Schema-safe = do- nUpper <- inRange (2, 5)- nDigit <- inRange (2, 5)- nSpecial <- inRange (2, 5)- let nLower = 18 - nUpper - nSpecial - nDigit+safe = withDefaultSize 18 $ \ s -> do+ let number = max s 4+ lBound = max 1 $ floor $ number % 8+ uBound = ceiling $ number % 4+ nUpper <- inRange (lBound, uBound)+ nDigit <- inRange (lBound, uBound)+ nSpecial <- inRange (lBound, uBound)+ let nLower = number - nUpper - nSpecial - nDigit uppers <- replicateM nUpper upper digits <- replicateM nDigit digit specials <- replicateM nSpecial special lowers <- replicateM nLower lower shuffle (uppers <> digits <> specials <> lowers) -{- | Generates a password of length 18,+{- | Generates a password, containing upper case letters, lower case letters and digits, but no symbols.- Entropy of about 104.2 bits. -}+ Entropy of about 104.2 bits for length 18. -} alphanumeric :: Schema-alphanumeric = do- nUpper <- inRange (2, 5)- nDigit <- inRange (2, 5)- let nLower = 18 - nUpper - nDigit+alphanumeric = withDefaultSize 18 $ \ s -> do+ let number = max s 4+ lBound = max 1 $ floor $ number % 8+ uBound = ceiling $ number % 4+ nUpper <- inRange (lBound, uBound)+ nDigit <- inRange (lBound, uBound)+ let nLower = number - nUpper - nDigit uppers <- replicateM nUpper upper digits <- replicateM nDigit digit lowers <- replicateM nLower lower@@ -75,14 +107,13 @@ {- | Generates a PIN number, of length `n`. Entropy of about @3.32 * n@ bits. -}-pin :: Int -> Schema-pin n = replicateM n digit-+pin :: Schema+pin = withDefaultSize 6 $ \ s -> replicateM s digit --- | Generates an Android lock pattern, of specified length.-androidPatternLock :: Int -> Schema-androidPatternLock number = do- xs <- loop (min number (height * width)) []+-- | Generates an Android lock pattern.+androidPatternLock :: Schema+androidPatternLock = withDefaultSize 9 $ \ s -> do+ xs <- loop (min s (height * width)) [] return $ intercalate " - " $ map showPosition xs where -- Gets `n` points.@@ -133,27 +164,29 @@ vstep = vdiff `div` steps hstep = hdiff `div` steps -{- | Generates a password with 4 of the original Pokemons and their level.- Entropy of about 55.5 bits. -}+{- | Generates a password with `s` of the original Pokemons and their level.+ Entropy of about 55.5 bits for 4 pokemons. -} pokemons :: IO Schema-pokemons = fromFile "pokemons.txt" $ \ vect -> do- ps <- replicateM 4 $ oneOfV vect- ls <- replicateM 4 $ inRange (1, 100 :: Int)- let ss = zipWith (\ p l -> p ++ " " ++ show l) ps ls- return $ intercalate ", " ss+pokemons = fromFile "pokemons.txt" $ \ vect ->+ withDefaultSize 4 $ \ s -> do+ ps <- replicateM s $ oneOfV vect+ ls <- replicateM s $ inRange (1, 100 :: Int)+ let ss = zipWith (\ p l -> p ++ " " ++ show l) ps ls+ return $ intercalate ", " ss -{- | Generates a password with 5 words+{- | Generates a password with `s` words from the Diceware list.- Entropy of about 64.6 bits. -}+ Entropy of about 64.6 bits for 5 words. -} diceware :: IO Schema-diceware = fromFile "diceware.txt" $ \ vect -> do- ws <- replicateM 5 $ oneOfV vect+diceware = fromFile "diceware.txt" $ \ vect ->+ withDefaultSize 5 $ \ s -> do+ ws <- replicateM s $ oneOfV vect return $ unwords ws --- | Feeds all lines of a file to a builder.-fromFile :: FilePath -> (Vector String -> Builder a) -> IO (Builder a)+-- | Feeds all lines of a file to a function and gets the result.+fromFile :: FilePath -> (Vector String -> a) -> IO a fromFile fp bs = do fp' <- getDataFileName fp withFile fp' ReadMode $ \ h -> do- !vect <- fmap (V.fromList . lines) $ hGetContents h+ !vect <- (V.fromList . lines) <$> hGetContents h return $ bs vect
src/Scat/Utils/Permutation.hs view
@@ -25,17 +25,19 @@ Retrieved from: http://en.literateprograms.org/Kth_permutation_(Haskell)?oldid=16316 -} -{- | Permutations, taken from the+{- | Permutations, adapted from the http://en.literateprograms.org/Kth_permutation_(Haskell) webpage. -} module Scat.Utils.Permutation (perm) where -rr :: Int -> Int -> [Int]+rr :: Integer -> Integer -> [Integer] rr 0 _ = []-rr n k = k `mod` n : rr (n - 1) (k `div` n)+rr n k = m : rr (n - 1) d+ where+ (d, m) = k `divMod` n -dfr :: [Int] -> [Int]-dfr = foldr (\ x rs -> x : [r + (if x <= r then 1 else 0) | r <- rs]) []+dfr :: [Integer] -> [Integer]+dfr = foldr (\ x rs -> x : [r + if x <= r then 1 else 0 | r <- rs]) [] -- | List permutation.-perm :: [a] -> Int -> [a]-perm xs k = [xs !! i | i <- dfr (rr (length xs) k)]+perm :: [a] -> Integer -> [a]+perm xs k = [xs !! fromInteger i | i <- dfr (rr (fromIntegral $ length xs) k)]
+ src/Tests.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE OverloadedStrings #-}++module Main (main) where++import Control.Monad+import Data.ByteString (ByteString)+import System.Exit (exitFailure)++import Scat+import Scat.Builder+import Scat.Schemas++seedGithub :: Integer+seedGithub = 7273969660509039708598560774226985084748596416599584268407087707065680457723095089909612048211188783512827089141818809294015697773231266655764062992251214++seedFacebook :: Integer+seedFacebook = 13262460002149113723264840055577914239548551696334299511162926224707398066055935936276077079458293092086000192365956813128644769941942691534958728554307440++scatterTest :: String -> ByteString -> ByteString -> ByteString -> Integer -> IO ()+scatterTest name service password code expected = do+ putStrLn $ "Testing " ++ name+ when (scatter service password code /= expected) exitFailure++schemaTest :: String -> Schema -> Integer -> String -> IO ()+schemaTest name schema seed expected = do+ putStrLn $ "Testing " ++ name+ when (evalBuilder (getBuilder schema Nothing) seed /= expected) exitFailure++main :: IO ()+main = do+ -- Mainly here for regression testing.+ scatterTest "scatter test 1 - using github as service"+ "github" "pony1234" "AGDE2-DGXA4-33DLQ-WEDAP-GYPQ9"+ seedGithub+ scatterTest "scatter test 2 - using facebook as service"+ "facebook" "pony1234" "AGDE2-DGXA4-33DLQ-WEDAP-GYPQ9"+ seedFacebook++ -- Testing the examples from the README.+ schemaTest "schema test 1 - generating from 'safe' schema, with github seed"+ safe seedGithub+ "k2'8n?QXwmptbJ7D44"++ schemaTest "schema test 2 - generating from 'safe' schema, with facebook seed"+ safe seedFacebook+ "{g6e2hsKjh#Ra*\\ks("++ dicewareSchema <- diceware+ schemaTest "schema test 3 - generating from 'diceware' schema"+ dicewareSchema seedFacebook+ "101 dry whoa foil barb"++ pokemonsSchema <- pokemons+ schemaTest "schema test 4 - generating from 'pokemons' schema"+ pokemonsSchema seedFacebook+ "Snorlax 5, Weedle 35, Raichu 27, Alakazam 99"