From 1456ef025e88701be102cebb04bc9727f6596659 Mon Sep 17 00:00:00 2001
From: Romain Edelmann <romain.edelmann@gmail.com>
Date: Sat, 26 Apr 2014 00:15:11 +0200
Subject: [PATCH] Added some tests, factored out the scatter functions out of
 the main file. Renamed files to achieve that.

---
 scat.cabal   |  15 ++++-
 src/Main.hs  | 162 +++++++++++++++++++++++++++++++++++++++++++++++++++
 src/Scat.hs  | 157 +------------------------------------------------
 src/Tests.hs |  26 +++++++++
 4 files changed, 202 insertions(+), 158 deletions(-)
 create mode 100644 src/Main.hs
 create mode 100644 src/Tests.hs

diff --git a/scat.cabal b/scat.cabal
index 511d935..aa06139 100644
--- a/scat.cabal
+++ b/scat.cabal
@@ -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
diff --git a/src/Main.hs b/src/Main.hs
new file mode 100644
index 0000000..cb3aa80
--- /dev/null
+++ b/src/Main.hs
@@ -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
diff --git a/src/Scat.hs b/src/Scat.hs
index 955216c..1b4fb15 100644
--- a/src/Scat.hs
+++ b/src/Scat.hs
@@ -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
diff --git a/src/Tests.hs b/src/Tests.hs
new file mode 100644
index 0000000..5f7b1a5
--- /dev/null
+++ b/src/Tests.hs
@@ -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.