{-# 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