{-# LANGUAGE RecordWildCards #-} module Data.KeyStore.CLI ( cli , cli' , paramsParser , runParse , cliInfo , cliParser , execute , Command(..) , CtxParams(..) , CLI(..) ) where import Data.KeyStore.IO import Data.KeyStore.KS.Opt import Data.KeyStore.CLI.Command import Data.KeyStore.Version import qualified Data.Text.IO as T import qualified Data.ByteString.Char8 as B import Control.Applicative import Control.Monad import System.Exit cli :: IO () cli :: IO () cli = IO CLI parseCLI forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= Maybe CtxParams -> CLI -> IO () execute forall a. Maybe a Nothing cli' :: Maybe CtxParams -> [String] -> IO () cli' :: Maybe CtxParams -> [String] -> IO () cli' Maybe CtxParams mb [String] args = [String] -> IO CLI parseCLI' [String] args forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= Maybe CtxParams -> CLI -> IO () execute Maybe CtxParams mb execute :: Maybe CtxParams -> CLI -> IO () execute :: Maybe CtxParams -> CLI -> IO () execute Maybe CtxParams mb_cp CLI{CtxParams Command cli_command :: CLI -> Command cli_params :: CLI -> CtxParams cli_command :: Command cli_params :: CtxParams ..} = do IC ic <- case Command cli_command of Command Version -> forall (m :: * -> *) a. Monad m => a -> m a return forall {a}. a oops Initialise String _ -> forall (m :: * -> *) a. Monad m => a -> m a return forall {a}. a oops Command _ -> CtxParams -> IO IC instanceCtx CtxParams cp let ic_ro :: IC ic_ro = IC -> IC ro IC ic case Command cli_command of Command Version -> String -> IO () putStrLn String version Command Keystore -> String -> IO () putStrLn forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< IC -> IO String store IC ic Initialise String fp -> String -> Settings -> IO () newKeyStore String fp Settings defaultSettings UpdateSettings String fp -> IC -> String -> IO () updateSettings IC ic String fp Command ListSettings -> IC -> IO () listSettings IC ic ListSettingOpts Maybe OptEnum mb -> Text -> IO () pt forall a b. (a -> b) -> a -> b $ Maybe OptEnum -> Text listSettingsOpts Maybe OptEnum mb AddTrigger TriggerID ti Pattern re String fp -> IC -> TriggerID -> Pattern -> String -> IO () addTrigger IC ic TriggerID ti Pattern re String fp RmvTrigger TriggerID ti -> IC -> TriggerID -> IO () rmvTrigger IC ic TriggerID ti Command ListTriggers -> IC -> IO () listTriggers IC ic Create Name nm Comment cmt Identity ide Maybe EnvVar mbe Maybe String mbf [Safeguard] sgs -> IC -> Name -> Comment -> Identity -> Maybe EnvVar -> Maybe String -> [Safeguard] -> IO () create IC ic Name nm Comment cmt Identity ide Maybe EnvVar mbe Maybe String mbf [Safeguard] sgs CreateKeyPair Name nm Comment cmt Identity ide [Safeguard] sgs -> IC -> Name -> Comment -> Identity -> [Safeguard] -> IO () createRSAKeyPair IC ic Name nm Comment cmt Identity ide [Safeguard] sgs Secure Name nm Maybe String mbf [Safeguard] sgs -> IC -> Name -> Maybe String -> [Safeguard] -> IO () secure IC ic Name nm Maybe String mbf [Safeguard] sgs Command List -> IC -> IO () list IC ic_ro Info [Name] nms -> IC -> [Name] -> IO () info IC ic_ro [Name] nms ShowIdentity Bool aa Name nm -> IO ByteString -> IO () pr forall a b. (a -> b) -> a -> b $ IC -> Bool -> Name -> IO ByteString showIdentity IC ic_ro Bool aa Name nm ShowComment Bool aa Name nm -> IO ByteString -> IO () pr forall a b. (a -> b) -> a -> b $ IC -> Bool -> Name -> IO ByteString showComment IC ic_ro Bool aa Name nm ShowDate Bool aa Name nm -> IO ByteString -> IO () pr forall a b. (a -> b) -> a -> b $ IC -> Bool -> Name -> IO ByteString showDate IC ic_ro Bool aa Name nm ShowHash Bool aa Name nm -> IO ByteString -> IO () pr forall a b. (a -> b) -> a -> b $ IC -> Bool -> Name -> IO ByteString showHash IC ic_ro Bool aa Name nm ShowHashComment Bool aa Name nm -> IO ByteString -> IO () pr forall a b. (a -> b) -> a -> b $ IC -> Bool -> Name -> IO ByteString showHashComment IC ic_ro Bool aa Name nm ShowHashSalt Bool aa Name nm -> IO ByteString -> IO () pr forall a b. (a -> b) -> a -> b $ IC -> Bool -> Name -> IO ByteString showHashSalt IC ic_ro Bool aa Name nm ShowPublic Bool aa Name nm -> IO ByteString -> IO () pr forall a b. (a -> b) -> a -> b $ IC -> Bool -> Name -> IO ByteString showPublic IC ic_ro Bool aa Name nm ShowSecret Bool aa Name nm -> IO ByteString -> IO () pr forall a b. (a -> b) -> a -> b $ IC -> Bool -> Name -> IO ByteString showSecret IC ic_ro Bool aa Name nm Encrypt Name nm String sfp String dfp -> IC -> Name -> String -> String -> IO () encrypt IC ic_ro Name nm String sfp String dfp Decrypt String sfp String dfp -> IC -> String -> String -> IO () decrypt IC ic_ro String sfp String dfp Sign Name nm String sfp String dfp -> IC -> Name -> String -> String -> IO () sign IC ic Name nm String sfp String dfp Verify String sfp String dfp -> IC -> String -> String -> IO () verify_cli IC ic_ro String sfp String dfp Delete [Name] nms -> IC -> [Name] -> IO () deleteKeys IC ic [Name] nms where pr :: IO ByteString -> IO () pr IO ByteString p = IO ByteString p forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= ByteString -> IO () B.putStrLn pt :: Text -> IO () pt = Text -> IO () T.putStrLn ro :: IC -> IC ro IC ic = IC ic { ic_ctx_params :: CtxParams ic_ctx_params = CtxParams cli_params { cp_readonly :: Maybe Bool cp_readonly = CtxParams -> Maybe Bool cp_readonly CtxParams cp forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> forall a. a -> Maybe a Just Bool True } } cp :: CtxParams cp = CtxParams { cp_store :: Maybe String cp_store = CtxParams -> Maybe String cp_store CtxParams cp_ forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> CtxParams -> Maybe String cp_store CtxParams cli_params , cp_debug :: Maybe Bool cp_debug = CtxParams -> Maybe Bool cp_debug CtxParams cp_ forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> CtxParams -> Maybe Bool cp_debug CtxParams cli_params , cp_readonly :: Maybe Bool cp_readonly = CtxParams -> Maybe Bool cp_readonly CtxParams cp_ forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> CtxParams -> Maybe Bool cp_readonly CtxParams cli_params } where cp_ :: CtxParams cp_ = forall b a. b -> (a -> b) -> Maybe a -> b maybe CtxParams defaultCtxParams forall a. a -> a id Maybe CtxParams mb_cp oops :: a oops = forall a. HasCallStack => String -> a error String "command: this ic should not be used" create :: IC -> Name -> Comment -> Identity -> Maybe EnvVar -> Maybe FilePath -> [Safeguard] -> IO () create :: IC -> Name -> Comment -> Identity -> Maybe EnvVar -> Maybe String -> [Safeguard] -> IO () create IC ic Name nm Comment cmt Identity ide Maybe EnvVar mbe Maybe String mbf [Safeguard] secs = do IC -> Name -> Comment -> Identity -> Maybe EnvVar -> Maybe ByteString -> IO () createKey IC ic Name nm Comment cmt Identity ide Maybe EnvVar mbe forall a. Maybe a Nothing IC -> Name -> Maybe String -> [Safeguard] -> IO () secure IC ic Name nm Maybe String mbf [Safeguard] secs secure :: IC -> Name -> Maybe FilePath -> [Safeguard] -> IO () secure :: IC -> Name -> Maybe String -> [Safeguard] -> IO () secure IC ic Name nm Maybe String mbf [Safeguard] secs = do case Maybe String mbf of Maybe String Nothing -> forall a b. a -> b -> a const () forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> IC -> Name -> IO Key loadKey IC ic Name nm Just String fp -> IC -> Name -> String -> IO () rememberKey IC ic Name nm String fp forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => (a -> m b) -> t a -> m () mapM_ (IC -> Name -> Safeguard -> IO () secureKey IC ic Name nm) [Safeguard] secs info :: IC -> [Name] -> IO () info :: IC -> [Name] -> IO () info IC ic = forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => (a -> m b) -> t a -> m () mapM_ forall a b. (a -> b) -> a -> b $ IC -> Name -> IO () keyInfo IC ic verify_cli :: IC -> FilePath -> FilePath -> IO () verify_cli :: IC -> String -> String -> IO () verify_cli IC ic String m_fp String s_fp = do Bool ok <- IC -> String -> String -> IO Bool verify IC ic String m_fp String s_fp forall (f :: * -> *). Applicative f => Bool -> f () -> f () when (Bool -> Bool not Bool ok) forall a. IO a exitFailure