1
0
mirror of https://github.com/redelmann/scat synced 2025-01-09 22:24:19 +01:00

Added some tests, factored out the scatter functions out of the main file. Renamed files to achieve that.

This commit is contained in:
Romain Edelmann 2014-04-26 00:15:11 +02:00
parent b80817a40b
commit 1456ef025e
4 changed files with 202 additions and 158 deletions

View File

@ -57,14 +57,14 @@ source-repository head
executable scat
-- .hs or .lhs file containing the Main module.
main-is: Scat.hs
main-is: Main.hs
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 && <5
@ -75,3 +75,14 @@ executable scat
, 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

162
src/Main.hs Normal file
View File

@ -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

View File

@ -1,170 +1,15 @@
{-# LANGUAGE OverloadedStrings #-}
-- | 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 $ 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
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

26
src/Tests.hs Normal file
View File

@ -0,0 +1,26 @@
{-# LANGUAGE OverloadedStrings #-}
module Main (main) where
import Control.Monad
import Data.ByteString (ByteString)
import System.Exit (exitFailure)
import Scat
scatterTest :: String -> ByteString -> ByteString -> ByteString -> Integer -> IO ()
scatterTest name service password code expected = do
putStrLn $ "Testing " ++ name
when (scatter service password code /= expected) exitFailure
main :: IO ()
main = do
-- Mainly here for regression testing.
scatterTest "scatter example 1"
"github" "pony1234" "AGDE2-DGXA4-33DLQ-WEDAP-GYPQ9"
7273969660509039708598560774226985084748596416599584268407087707065680457723095089909612048211188783512827089141818809294015697773231266655764062992251214
scatterTest "scatter example 2"
"facebook" "pony1234" "AGDE2-DGXA4-33DLQ-WEDAP-GYPQ9"
13262460002149113723264840055577914239548551696334299511162926224707398066055935936276077079458293092086000192365956813128644769941942691534958728554307440
-- TODO: Test also the schemas.