diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -85,3 +85,6 @@ syntax for cleaner embedding in optparse-applicative parsers * hope dependent pacakges have stopped breaking the Hackage build +0.6.1.0 Chris Dornan 2014-09-21 + * expose ks optparse-applicative CLI parser + * adapt 'deploy' example to use 'ks' and 'pm' optparse-applicative parsers diff --git a/examples/deploy/Deploy/Cmd.hs b/examples/deploy/Deploy/Cmd.hs new file mode 100644 --- /dev/null +++ b/examples/deploy/Deploy/Cmd.hs @@ -0,0 +1,213 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Deploy.Cmd + ( CtxCmd(..) + , Cmd(..) + , parseCLI + ) where + +import Deploy.HostSectionKey +import Data.KeyStore +import Data.Monoid +import Options.Applicative +import System.Environment + + +data CtxCmd = + CtxCmd + { cc_params :: CtxParams + , cc_cmd :: Cmd + } + deriving (Show) + +data Cmd + = C_create + | C_rotate (Maybe HostID) (Maybe SectionID) (Maybe KeyID) + | C_rotate_smart (Maybe HostID) (Maybe SectionID) (Maybe KeyID) + | C_deploy Bool (Maybe FilePath) HostID + | C_client + | C_sign + | C_verify + | C_list_hosts + | C_info_key (Maybe KeyID ) + | C_info_section (Maybe SectionID) + | C_secret_script + | C_public_script + | C_sample_script + | C_ks CLI + | C_pm (PMCommand SectionID) + deriving (Show) + +parseCLI :: PMConfig SectionID -> IO CtxCmd +parseCLI pmc = getArgs >>= runParse (pi_cli $ p_cli pmc) + +pi_cli :: Parser CtxCmd -> ParserInfo CtxCmd +pi_cli psr = + h_info psr $ + fullDesc <> + progDesc "For carrying out deployments from the keystore." + +p_cli :: PMConfig SectionID -> Parser CtxCmd +p_cli pmc = CtxCmd <$> paramsParser <*> (p_command pmc) + +p_command :: PMConfig SectionID -> Parser Cmd +p_command pmc = + subparser + $ command "create" pi_create + <> command "rotate" (pi_rotate_key False) + <> command "rotate-smart" (pi_rotate_key True ) + <> command "deploy" pi_deploy + <> command "client" pi_client + <> command "sign" pi_sign + <> command "verify" pi_verify + <> command "list-hosts" pi_list_hosts + <> command "info-key" pi_info_key + <> command "info-section" pi_info_section + <> command "secret-script" pi_secret_script + <> command "public-script" pi_public_script + <> command "sample-load-script" pi_sample_script + <> command "ks" pi_ks_args + <> command "pm" (pi_pm_args pmc) + +pi_create :: ParserInfo Cmd +pi_create = + h_info + (helper <*> (pure C_create)) + (progDesc "create a new keystore") + +pi_rotate_key :: Bool -> ParserInfo Cmd +pi_rotate_key sm = + h_info + (helper <*> + ((if sm then C_rotate_smart else C_rotate) + <$> optional p_host + <*> optional p_section + <*> optional p_key)) + (progDesc $ if sm then "rotate keys, but only if they have changed" else "rotate keys") + +pi_deploy :: ParserInfo Cmd +pi_deploy = + h_info + (helper <*> (C_deploy <$> p_shell_flg <*> optional p_out <*> p_host_arg)) + (progDesc $ "deploy a configuration file for a host " ++ + "(here merely generating the JSON configuration file)") + +pi_client :: ParserInfo Cmd +pi_client = + h_info + (helper <*> (pure C_client)) + (progDesc $ "run a mock client " ++ + "(here merely displays the session token)") + + +pi_sign :: ParserInfo Cmd +pi_sign = + h_info + (helper <*> (pure C_sign)) + (progDesc "sign the keystore") + +pi_verify :: ParserInfo Cmd +pi_verify = + h_info + (helper <*> (pure C_verify)) + (progDesc "verify the keystore") + +pi_list_hosts :: ParserInfo Cmd +pi_list_hosts = + h_info + (helper <*> (pure C_list_hosts)) + (progDesc "list the hosts") + +pi_info_key :: ParserInfo Cmd +pi_info_key = + h_info + (helper <*> (C_info_key <$> optional p_key)) + (progDesc "get the gen on the keystore keys") + +pi_info_section :: ParserInfo Cmd +pi_info_section = + h_info + (helper <*> (C_info_section <$> optional p_a_section)) + (progDesc "get the gen on the keystore sections") + +pi_secret_script :: ParserInfo Cmd +pi_secret_script = + h_info + (helper <*> (pure C_secret_script)) + (progDesc $ "print a script to establish the all section passwords in the environment") + +pi_public_script :: ParserInfo Cmd +pi_public_script = + h_info + (helper <*> (pure C_public_script)) + (progDesc "print a script to save the public signing key in a file") + +pi_sample_script :: ParserInfo Cmd +pi_sample_script = + h_info + (helper <*> (pure C_sample_script)) + (progDesc "print a sample script to define keystore passwords in the environment") + +pi_ks_args :: ParserInfo Cmd +pi_ks_args = + h_info + (helper <*> (C_ks <$> cliParser)) + (progDesc "run a ks command (see 'ks --help' for details)") + +pi_pm_args :: PMConfig SectionID -> ParserInfo Cmd +pi_pm_args pmc = + h_info + (helper <*> (C_pm <$> pmCommandParser pmc)) + (progDesc "run a pm command (see 'pm --help' for details)") + +p_shell_flg :: Parser Bool +p_shell_flg = + switch + (long "shell" <> + help "launch a shell with the deploy passwords setup in their environment variables") + +p_host_arg :: Parser HostID +p_host_arg = + argument decode + $ metavar "HOST" + <> help "a host ID" + +p_host :: Parser HostID +p_host = + nullOption + $ long "host" + <> metavar "HOST" + <> reader (maybe (fail "host not recognised") return . decode) + <> help "a host ID" + +p_section :: Parser SectionID +p_section = + nullOption + $ long "section" + <> metavar "SECTION" + <> reader (maybe (fail "section not recognised") return . decode) + <> help "a section ID" + +p_a_section :: Parser SectionID +p_a_section = + argument decode + $ metavar "SECTION" + <> help "a section ID" + +p_key :: Parser KeyID +p_key = + nullOption + $ long "key" + <> metavar "KEY" + <> reader (maybe (fail "key not recognised") return . decode) + <> help "a key ID" + +p_out :: Parser FilePath +p_out = + strOption + $ long "out" + <> metavar "FILE" + <> help "output file" + +h_info :: Parser a -> InfoMod a -> ParserInfo a +h_info pr = info (helper <*> pr) diff --git a/examples/deploy/Deploy/Command.hs b/examples/deploy/Deploy/Command.hs deleted file mode 100644 --- a/examples/deploy/Deploy/Command.hs +++ /dev/null @@ -1,234 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Deploy.Command - ( CLI(..) - , Command(..) - , parseCLI - ) where - -import Deploy.HostSectionKey -import Data.KeyStore -import Data.Monoid -import Options.Applicative -import System.Environment - - -data CLI = - CLI - { cli_params :: CtxParams - , cli_command :: Command - } - deriving (Show) - -data Command - = Create - | Rotate (Maybe HostID) (Maybe SectionID) (Maybe KeyID) - | RotateSmart (Maybe HostID) (Maybe SectionID) (Maybe KeyID) - | Deploy Bool (Maybe FilePath) HostID - | Client - | Sign - | Verify - | ListHosts - | InfoKey (Maybe KeyID ) - | InfoSection (Maybe SectionID) - | SecretScript - | PublicScript - | SampleScript - | KS [String] - | PM [String] - deriving (Show) - -parseCLI :: IO CLI -parseCLI = do - args <- getArgs - case span is_flg args of - (flgs,"ks":args') -> runParse (pi_cli $ p_ks args') flgs - (flgs,"pm":args') -> runParse (pi_cli $ p_pm args') flgs - _ -> runParse (pi_cli p_cli ) args - -pi_cli :: Parser CLI -> ParserInfo CLI -pi_cli psr = - h_info psr $ - fullDesc <> - progDesc "For carrying out deployments from the keystore." - -p_ks :: [String] -> Parser CLI -p_ks args = CLI <$> paramsParser <*> pure (KS args) - -p_pm :: [String] -> Parser CLI -p_pm args = CLI <$> paramsParser <*> pure (PM args) - -p_cli :: Parser CLI -p_cli = CLI <$> paramsParser <*> p_command - -p_command :: Parser Command -p_command = - subparser - $ command "create" pi_create - <> command "rotate" (pi_rotate_key False) - <> command "rotate-smart" (pi_rotate_key True ) - <> command "deploy" pi_deploy - <> command "client" pi_client - <> command "sign" pi_sign - <> command "verify" pi_verify - <> command "list-hosts" pi_list_hosts - <> command "info-key" pi_info_key - <> command "info-section" pi_info_section - <> command "secret-script" pi_secret_script - <> command "public-script" pi_public_script - <> command "sample-load-script" pi_sample_script - <> command "ks" pi_ks_args - <> command "pm" pi_pm_args - -pi_create :: ParserInfo Command -pi_create = - h_info - (helper <*> (pure Create)) - (progDesc "create a new keystore") - -pi_rotate_key :: Bool -> ParserInfo Command -pi_rotate_key sm = - h_info - (helper <*> - ((if sm then RotateSmart else Rotate) - <$> optional p_host - <*> optional p_section - <*> optional p_key)) - (progDesc $ if sm then "rotate keys, but only if they have changed" else "rotate keys") - -pi_deploy :: ParserInfo Command -pi_deploy = - h_info - (helper <*> (Deploy <$> p_shell_flg <*> optional p_out <*> p_host_arg)) - (progDesc $ "deploy a configuration file for a host " ++ - "(here merely generating the JSON configuration file)") - -pi_client :: ParserInfo Command -pi_client = - h_info - (helper <*> (pure Client)) - (progDesc $ "run a mock client " ++ - "(here merely displays the session token)") - - -pi_sign :: ParserInfo Command -pi_sign = - h_info - (helper <*> (pure Sign)) - (progDesc "sign the keystore") - -pi_verify :: ParserInfo Command -pi_verify = - h_info - (helper <*> (pure Verify)) - (progDesc "verify the keystore") - -pi_list_hosts :: ParserInfo Command -pi_list_hosts = - h_info - (helper <*> (pure ListHosts)) - (progDesc "list the hosts") - -pi_info_key :: ParserInfo Command -pi_info_key = - h_info - (helper <*> (InfoKey <$> optional p_key)) - (progDesc "get the gen on the keystore keys") - -pi_info_section :: ParserInfo Command -pi_info_section = - h_info - (helper <*> (InfoSection <$> optional p_a_section)) - (progDesc "get the gen on the keystore sections") - -pi_secret_script :: ParserInfo Command -pi_secret_script = - h_info - (helper <*> (pure SecretScript)) - (progDesc $ "print a script to establish the all section passwords in the environment") - -pi_public_script :: ParserInfo Command -pi_public_script = - h_info - (helper <*> (pure PublicScript)) - (progDesc "print a script to save the public signing key in a file") - -pi_sample_script :: ParserInfo Command -pi_sample_script = - h_info - (helper <*> (pure SampleScript)) - (progDesc "print a sample script to define keystore passwords in the environment") - -pi_ks_args :: ParserInfo Command -pi_ks_args = - h_info - (helper <*> (KS <$> many p_arg)) - (progDesc "run a ks command (see 'ks --help' for details)") - -pi_pm_args :: ParserInfo Command -pi_pm_args = - h_info - (helper <*> (KS <$> many p_arg)) - (progDesc "run a pm command (see 'pm --help' for details)") - -p_shell_flg :: Parser Bool -p_shell_flg = - switch - (long "shell" <> - help "launch a shell with the deploy passwords setup in their environment variables") - -p_host_arg :: Parser HostID -p_host_arg = - argument decode - $ metavar "HOST" - <> help "a host ID" - -p_host :: Parser HostID -p_host = - nullOption - $ long "host" - <> metavar "HOST" - <> reader (maybe (fail "host not recognised") return . decode) - <> help "a host ID" - -p_section :: Parser SectionID -p_section = - nullOption - $ long "section" - <> metavar "SECTION" - <> reader (maybe (fail "section not recognised") return . decode) - <> help "a section ID" - -p_a_section :: Parser SectionID -p_a_section = - argument decode - $ metavar "SECTION" - <> help "a section ID" - -p_key :: Parser KeyID -p_key = - nullOption - $ long "key" - <> metavar "KEY" - <> reader (maybe (fail "key not recognised") return . decode) - <> help "a key ID" - -p_out :: Parser FilePath -p_out = - strOption - $ long "out" - <> metavar "FILE" - <> help "output file" - -p_arg :: Parser String -p_arg = - argument Just - $ metavar "ARG" - <> help "a sub-command argument" - -h_info :: Parser a -> InfoMod a -> ParserInfo a -h_info pr = info (helper <*> pr) - -is_flg :: String -> Bool -is_flg ('-':_) = True -is_flg _ = False diff --git a/examples/deploy/Deploy/HostSectionKey.hs b/examples/deploy/Deploy/HostSectionKey.hs --- a/examples/deploy/Deploy/HostSectionKey.hs +++ b/examples/deploy/Deploy/HostSectionKey.hs @@ -170,8 +170,7 @@ |] describe_key :: KeyID -> String -describe_key k = - case k of +describe_key k = case k of K_admin_init_pw -> "the starting password for the administrator" K_super_api -> "the 'super_api' key will authenticate any request" K_api -> "the api key is needed to make requests when the client has not credentials (e.g., to login)" @@ -182,8 +181,7 @@ K_ssl -> "the SSL Host key and certificate" describe_section :: SectionID -> String -describe_section s = - case s of +describe_section s = case s of S_top -> "the top section has access to all keys" S_signing -> "just contains the keystore signing key" S_eu_admin -> "contains adminsitrative keys for the 'eu' live server not required for deployment" @@ -198,8 +196,7 @@ S_session -> "this section does not contain any keys (the section is needed for the password manager)" is_ssl :: HostID -> Bool -is_ssl h = - case h of +is_ssl h = case h of H_live_eu -> True H_staging_eu -> True H_live_us -> True @@ -227,18 +224,17 @@ S_us_deploy -> True _ -> False - summarize s = - case s of - S_top -> "top key: accesses everything" - S_signing -> "keystore signing key" - S_eu_admin -> "eu admin keys" - S_eu_deploy -> "eu deploy keys" - S_eu_staging -> "eu staging deployment keys" - S_us_admin -> "us admin keys" - S_us_deploy -> "us deploy keys" - S_us_staging -> "us staging keys" - S_dev -> "dev deployment keys" - S_session -> "client sessions tokens" + summarize s = case s of + S_top -> "top key: accesses everything" + S_signing -> "keystore signing key" + S_eu_admin -> "eu admin keys" + S_eu_deploy -> "eu deploy keys" + S_eu_staging -> "eu staging deployment keys" + S_us_admin -> "us admin keys" + S_us_deploy -> "us deploy keys" + S_us_staging -> "us staging keys" + S_dev -> "dev deployment keys" + S_session -> "client sessions tokens" describe = describe_section diff --git a/examples/deploy/deploy.hs b/examples/deploy/deploy.hs --- a/examples/deploy/deploy.hs +++ b/examples/deploy/deploy.hs @@ -6,7 +6,7 @@ module Main (main) where import Deploy.Deploy -import Deploy.Command +import Deploy.Cmd import Deploy.HostSectionKey import Data.KeyStore import Data.API.Types @@ -18,7 +18,6 @@ import Data.List import System.IO import System.Environment -import System.SetEnv import System.Process import Control.Applicative import Control.Exception @@ -46,42 +45,42 @@ dump_pfx = "deploy pm" main :: IO () -main = - do CLI{..} <- parseCLI - let cp0 = cli_params +main = do + CtxCmd{..} <- parseCLI pmc + let cp0 = cc_params cp = cp0 { cp_store = cp_store cp0 <|> Just ks_fp } - case cli_command of - Create -> collect pmc create_cc >> initialise cp no_keys - ListHosts -> mapM_ (putStrLn . encode) $ [minBound..maxBound :: HostID] - SampleScript -> mapM_ sample_ln [minBound..maxBound] - KS args -> collect pmc deploy_cc >> KS.cli' (Just cp) args - PM args -> passwordManager pmc args + case cc_cmd of + C_create -> collect pmc create_cc >> initialise cp no_keys + C_list_hosts -> mapM_ (putStrLn . encode) $ [minBound..maxBound :: HostID] + C_sample_script -> mapM_ sample_ln [minBound..maxBound] + C_ks ks_cmd -> collect pmc deploy_cc >> KS.execute (Just cp) ks_cmd + C_pm pm_cmd -> passwordManager' pmc pm_cmd _ -> - do case cli_command of - Client -> collect pmc client_cc - _ -> collect pmc deploy_cc + do case cc_cmd of + C_client -> collect pmc client_cc + _ -> collect pmc deploy_cc ic <- instanceCtx cp let ic_ro = ic { ic_ctx_params = cp {cp_readonly = cp_readonly cp <|> Just True} } - case cli_command of - Sign -> return () - _ -> verify_ks True ic_ro - case cli_command of - Create -> error "main: Initialise" - Rotate mbh mbs mbk -> rotate ic $ key_prededicate mbh mbs mbk - RotateSmart mbh mbs mbk -> rotateIfChanged ic $ key_prededicate mbh mbs mbk - Deploy False mb hst -> deploy ic_ro hst >>= write mb - Deploy True _ _ -> interactive_shell - Client -> lookupEnv "KEY_pw_session" >>= putStrLn . ("session-token=>" ++) . maybe "NONE" id - Sign -> sign_ks ic_ro - Verify -> T.putStrLn "the keystore matches the signature" - ListHosts -> error "main: ListHosts" - InfoKey mbk -> T.putStr $ keyHelp mbk - InfoSection mbs -> sectionHelp mbs >>= T.putStr - SecretScript -> secretKeySummary ic sections >>= T.putStr - PublicScript -> publicKeySummary ic sections ks_mac_fp >>= T.putStr - SampleScript -> error "main: SampleScript" - KS _ -> error "main: KS" - PM _ -> error "main: PM" + case cc_cmd of + C_sign -> return () + _ -> verify_ks True ic_ro + case cc_cmd of + C_create -> error "main: Initialise" + C_rotate mbh mbs mbk -> rotate ic $ key_prededicate mbh mbs mbk + C_rotate_smart mbh mbs mbk -> rotateIfChanged ic $ key_prededicate mbh mbs mbk + C_deploy False mb hst -> deploy ic_ro hst >>= write mb + C_deploy True _ _ -> interactive_shell + C_client -> lookupEnv "KEY_pw_session" >>= putStrLn . ("session-token=>" ++) . maybe "NONE" id + C_sign -> sign_ks ic_ro + C_verify -> T.putStrLn "the keystore matches the signature" + C_list_hosts -> error "main: ListHosts" + C_info_key mbk -> T.putStr $ keyHelp mbk + C_info_section mbs -> sectionHelp mbs >>= T.putStr + C_secret_script -> secretKeySummary ic sections >>= T.putStr + C_public_script -> publicKeySummary ic sections ks_mac_fp >>= T.putStr + C_sample_script -> error "main: SampleScript" + C_ks _ -> error "main: KS" + C_pm _ -> error "main: PM" verify_ks False ic_ro create_cc, deploy_cc, client_cc :: CollectConfig SectionID diff --git a/keystore.cabal b/keystore.cabal --- a/keystore.cabal +++ b/keystore.cabal @@ -1,5 +1,5 @@ Name: keystore -Version: 0.6.0.0 +Version: 0.6.1.0 Synopsis: Managing stores of secret things Homepage: http://github.com/cdornan/keystore Author: Chris Dornan @@ -224,7 +224,7 @@ Default-Language: Haskell2010 Other-modules: - Deploy.Command + Deploy.Cmd Deploy.Deploy Deploy.HostSectionKey diff --git a/src/Data/KeyStore/CLI.hs b/src/Data/KeyStore/CLI.hs --- a/src/Data/KeyStore/CLI.hs +++ b/src/Data/KeyStore/CLI.hs @@ -5,6 +5,12 @@ , cli' , paramsParser , runParse + , cliInfo + , cliParser + , execute + , Command(..) + , CtxParams(..) + , CLI(..) ) where import Data.KeyStore.IO @@ -19,13 +25,13 @@ cli :: IO () -cli = parseCLI >>= command Nothing +cli = parseCLI >>= execute Nothing cli' :: Maybe CtxParams -> [String] -> IO () -cli' mb args = parseCLI' args >>= command mb +cli' mb args = parseCLI' args >>= execute mb -command :: Maybe CtxParams -> CLI -> IO () -command mb_cp CLI{..} = +execute :: Maybe CtxParams -> CLI -> IO () +execute mb_cp CLI{..} = do ic <- case cli_command of Version -> return oops diff --git a/src/Data/KeyStore/PasswordManager.hs b/src/Data/KeyStore/PasswordManager.hs --- a/src/Data/KeyStore/PasswordManager.hs +++ b/src/Data/KeyStore/PasswordManager.hs @@ -49,7 +49,7 @@ -- password manager CLI internals , passwordManager' , PMCommand - , parseCommand + , pmCommandParser ) where import Data.KeyStore.Types.PasswordStoreModel @@ -167,7 +167,7 @@ -- | the password manager CLI: it just needs the config and command line passwordManager :: PW p => PMConfig p -> [String] -> IO () -passwordManager pmc args = parseCommand pmc args >>= passwordManager' pmc +passwordManager pmc args = parsePMCommand pmc args >>= passwordManager' pmc -- | a sample 'HashDescription' generator to help with setting up 'PMConfig' defaultHashDescription :: Salt -> HashDescription @@ -937,19 +937,19 @@ deriving (Show) -- | parse a passwword manager command -parseCommand :: PW p => PMConfig p -> [String] -> IO (PMCommand p) -parseCommand pmc = run_parse $ command_info pmc +parsePMCommand :: PW p => PMConfig p -> [String] -> IO (PMCommand p) +parsePMCommand pmc = run_parse $ command_info pmc command_info :: PW p => PMConfig p -> ParserInfo (PMCommand p) command_info pmc = - O.info (helper <*> command_parser pmc) + O.info (helper <*> pmCommandParser pmc) ( fullDesc <> progDesc "a simple password manager" <> header "pm - sub-command for managing the password store" <> footer "'ks COMMAND --help' to get help on each command") -command_parser :: PW p => PMConfig p -> Parser (PMCommand p) -command_parser pmc = +pmCommandParser :: PW p => PMConfig p -> Parser (PMCommand p) +pmCommandParser pmc = subparser $ f $ g $ command "version" pi_version <> command "setup" (pi_setup pmc) diff --git a/src/Data/KeyStore/Version.hs b/src/Data/KeyStore/Version.hs --- a/src/Data/KeyStore/Version.hs +++ b/src/Data/KeyStore/Version.hs @@ -6,4 +6,4 @@ (a,b,c,d) = versionTuple versionTuple :: (Int,Int,Int,Int) -versionTuple = (0,6,0,0) +versionTuple = (0,6,1,0)