password-cli-0.1.1.0: app/Options.hs

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Options where

import qualified Data.Password.Argon2 as Argon2
import Data.Password.Bcrypt (PasswordCheck (..))
import qualified Data.Password.Bcrypt as Bcrypt
import qualified Data.Password.PBKDF2 as PBKDF2
import qualified Data.Password.Scrypt as Scrypt
import Data.Password.Types
import Data.Text (Text)
import Data.Version (showVersion)
import Options.Applicative
import Paths_password_cli (version)

data CLIOptions = CLIOptions
    { quiet :: Bool
    -- ^ Prevent any logging to stdout or stderr.
    , cmd :: Cmd
    -- ^ What command
    }

data Cmd
    = HashCmd HashOpts
    | CheckCmd CheckOpts
    | HelpCmd [String]

data FromFileOptions = FromFileOptions
    { fromFile :: FilePath
    , parseLiteralContents :: Bool
    }

data HashOpts = HashOpts
    { hashPassword :: Maybe FromFileOptions
    , hashAlgorithm :: HashAlgorithm
    }

data CheckOpts = CheckOpts
    { hash :: Either FromFileOptions Text
    , checkPassword :: Maybe FromFileOptions
    , checkAlgorithm :: CheckAlgorithm
    }

data HashAlgorithm
    = PBKDF2HashAlgo PBKDF2.PBKDF2Params
    | BcryptHashAlgo Int
    | ScryptHashAlgo Scrypt.ScryptParams
    | Argon2HashAlgo Argon2.Argon2Params

hashWithAlgorithm :: Password -> HashAlgorithm -> IO Text
hashWithAlgorithm pw = \case
    Argon2HashAlgo p ->
        unPasswordHash <$> Argon2.hashPasswordWithParams p pw
    BcryptHashAlgo p ->
        unPasswordHash <$> Bcrypt.hashPasswordWithParams p pw
    PBKDF2HashAlgo p ->
        unPasswordHash <$> PBKDF2.hashPasswordWithParams p pw
    ScryptHashAlgo p ->
        unPasswordHash <$> Scrypt.hashPasswordWithParams p pw

data CheckAlgorithm
    = PBKDF2CheckAlgo
    | BcryptCheckAlgo
    | ScryptCheckAlgo
    | Argon2CheckAlgo

checkWithAlgorithm :: Password -> Text -> CheckAlgorithm -> PasswordCheck
checkWithAlgorithm pw hashT = \case
    Argon2CheckAlgo -> Argon2.checkPassword pw hash
    BcryptCheckAlgo -> Bcrypt.checkPassword pw hash
    PBKDF2CheckAlgo -> PBKDF2.checkPassword pw hash
    ScryptCheckAlgo -> Scrypt.checkPassword pw hash
  where
    hash :: PasswordHash a
    hash = PasswordHash hashT

cliOpts :: ParserInfo CLIOptions
cliOpts =
    info cliOptsParser infoMods
  where
    v = showVersion version
    infoMods =
        fullDesc
            <> header ("Password CLI " <> v)
            <> progDesc
                "A command line interface to hash and check passwords in the terminal."
    cliOptsParser =
        CLIOptions
            <$> switch (short 'q' <> long "quiet" <> help "Suppress logging to stdout and stderr")
            <*> commandsParser
            <**> versionOpt v
            <**> helper

-- Copied over from 'optparse-applicative-0.17.1.0's 'simpleVersioner'
versionOpt :: String -> Parser (a -> a)
versionOpt v =
    infoOption v $
        long "version" <> help "Show version information" <> hidden

commandsParser :: Parser Cmd
commandsParser =
    hsubparser $
        command "hash" hashCmd
            <> command "check" checkCmd
            <> command "help" helpCmd
  where
    hashCmd =
        info (HashCmd <$> hashOptsParser) $
            progDesc
                "Hash a password from a file, or via stdin. Outputs to stdout.\
                \ (Will add a newline at the end when used interactively on Unix)"
    checkCmd =
        info (CheckCmd <$> checkOptsParser) $
            progDesc
                "Verify a hashed password from file or stdin. Returns exit code 0\
                \ when successful, and exit code 1 when the password did not match."
    helpCmd =
        info (HelpCmd <$> many (argument str (metavar "COMMAND"))) $
            progDesc "Show help text for the given command(s)"

hashOptsParser :: Parser HashOpts
hashOptsParser =
    HashOpts <$> passwordFileOption <*> hashParser

checkOptsParser :: Parser CheckOpts
checkOptsParser =
    CheckOpts <$> hashOption <*> passwordFileOption <*> checkParser
  where
    hashOption =
        Right <$> strOption (metavar "HASH" <> long "hash" <> help hashOptionMsg)
            <|> Left <$> hashFileOption
    hashOptionMsg = "Provide the hash as an option."

fromFileOption :: Bool -> Parser FilePath -> Parser FromFileOptions
fromFileOption acceptLiteral fileOption =
    FromFileOptions <$> fileOption <*> literalParseSwitch
  where
    literalParseSwitch
        | acceptLiteral =
            switch $ long "literal-contents" <> help helpMsg
        | otherwise = pure False
    helpMsg =
        "Hash all contents of the file. (by default only reads first line)"

passwordFileOption :: Parser (Maybe FromFileOptions)
passwordFileOption =
    optional . fromFileOption True $
        strOption (metavar "FILE" <> long "password-file" <> help "Hash password from file contents")

-- | We don't want to allow the '--literal-contents' option,
-- because hashes never have newlines and 'readLine' reads up to the first newline.
hashFileOption :: Parser FromFileOptions
hashFileOption =
    fromFileOption False $
        strOption (metavar "FILE" <> long "hash-file" <> help "Use hash from file contents")


data AlgoParsers a =
    AlgoParsers
        { argon2Parser :: Parser a
        , bcryptParser :: Parser a
        , pbkdf2Parser :: Parser a
        , scryptParser :: Parser a
        , commandDesc :: String -> String
        }

algorithmParser :: AlgoParsers a -> Parser a
algorithmParser AlgoParsers{..} =
    hsubparser
        ( commandGroup "Available algorithms:"
            <> command "argon2" (info argon2Parser (progDesc $ commandDesc "Argon2"))
            <> command "bcrypt" (info bcryptParser (progDesc $ commandDesc "bcrypt"))
            <> command "pbkdf2" (info pbkdf2Parser (progDesc $ commandDesc "PBKDF2"))
            <> command "scrypt" (info scryptParser (progDesc $ commandDesc "scrypt"))
        )

hashParser :: Parser HashAlgorithm
hashParser =
    algorithmParser
        AlgoParsers
            { argon2Parser = pure $ Argon2HashAlgo Argon2.defaultParams
            , bcryptParser = pure $ BcryptHashAlgo Bcrypt.defaultParams
            , pbkdf2Parser = pure $ PBKDF2HashAlgo PBKDF2.defaultParams
            , scryptParser = pure $ ScryptHashAlgo Scrypt.defaultParams
            , commandDesc = ("Hash a password using " <>)
            }

checkParser :: Parser CheckAlgorithm
checkParser =
    algorithmParser
        AlgoParsers
            { argon2Parser = pure Argon2CheckAlgo
            , bcryptParser = pure BcryptCheckAlgo
            , pbkdf2Parser = pure PBKDF2CheckAlgo
            , scryptParser = pure ScryptCheckAlgo
            , commandDesc = \algo -> "Check a " <> algo <> " hash"
            }