credentials-cli 0.0.1.1 → 0.0.2
raw patch · 7 files changed
+109/−71 lines, 7 filesdep ~aesondep ~uri-bytestring
Dependency ranges changed: aeson, uri-bytestring
Files
- credentials-cli.cabal +2/−2
- src/Credentials/CLI/Format.hs +5/−6
- src/Credentials/CLI/IO.hs +2/−1
- src/Credentials/CLI/Options.hs +13/−5
- src/Credentials/CLI/Types.hs +25/−11
- src/Credentials/CLI/Types/Protocol.hs +2/−2
- src/Main.hs +60/−44
credentials-cli.cabal view
@@ -1,5 +1,5 @@ name: credentials-cli-version: 0.0.1.1+version: 0.0.2 synopsis: Secure Credentials Administration homepage: https://github.com/brendanhay/credentials license: OtherLicense@@ -57,4 +57,4 @@ , text >= 0.11 , transformers-base >= 0.4 , unordered-containers >= 0.2.5- , uri-bytestring >= 0.2.1+ , uri-bytestring >= 0.2.2
src/Credentials/CLI/Format.hs view
@@ -20,19 +20,18 @@ import Credentials import Credentials.CLI.Types -import Data.Aeson (ToJSON (..), object, (.=))+import Data.Aeson (ToJSON (..), object, (.=)) import Data.Bifunctor-import Data.ByteString (ByteString)-import Data.List (foldl', intersperse)-import Data.List.NonEmpty (NonEmpty (..))+import Data.ByteString (ByteString)+import Data.List (foldl', intersperse)+import Data.List.NonEmpty (NonEmpty (..)) import Data.Monoid import Network.AWS.Data import Options.Applicative.Help hiding (list, string) -import qualified Data.ByteString.Lazy as LBS-import qualified Data.Text as Text+import qualified Data.Text as Text data Status = Deleted
src/Credentials/CLI/IO.hs view
@@ -24,6 +24,7 @@ import Data.Aeson.Encode.Pretty import Data.ByteString.Builder (Builder, hPutBuilder, stringUtf8) import Data.Char (isSpace, toLower)+import Data.Functor.Identity (runIdentity) import Data.Monoid import Network.AWS.Data@@ -60,7 +61,7 @@ emit :: Result -> App () emit r = do (f, s) <- asks (format &&& store)- let e = Emit s r+ let e = Emit (runIdentity s) r liftIO . hPutBuilder stdout $ case f of Pretty -> build (encodePretty e) <> "\n"
src/Credentials/CLI/Options.hs view
@@ -14,6 +14,7 @@ import Data.Bifunctor import Data.List (foldl')+import Data.Maybe (isJust) import Network.AWS.Data import Network.AWS.Data.Text@@ -52,7 +53,7 @@ => Text -- ^ The options' description. -> Text -- ^ A title for the values. -> [(a, String)] -- ^ Possible values and their documentation.- -> a -- ^ A default value.+ -> Maybe a -- ^ A default value. -> Maybe Text -- ^ Footer contents. -> Mod OptionFields a completes title note xs x foot = doc <> completeWith (map fst ys)@@ -66,16 +67,23 @@ => Text -> Text -> [(String, String)]- -> a+ -> Maybe a -> Maybe Text -> Mod OptionFields a-defaults title note xs x foot = describe title (Just doc) Default <> value x+defaults title note xs x foot =+ describe title (Just doc) Default <> maybe mempty value x where doc = maybe table (table .$.) (wrap <$> foot) table = wrap note .$. indent 2 rows- .$. ("Defaults to " <> bold (text (string x)) <> ".")+ $$$ ( case x of+ Nothing -> mempty+ Just y -> "Defaults to " <> bold (text (string y)) <> "."+ ) + ($$$) | isJust x = (.$.)+ | otherwise = mappend+ len = maximum (map (length . fst) xs) rows | [r] <- xs = f r@@ -87,7 +95,7 @@ ts | null v = mempty | otherwise = tupled [text v] -require :: Functor f => (Fact -> f a) -> f a+require :: (Fact -> a) -> a require f = f Required optional :: Alternative f => (Fact -> f a) -> f (Maybe a)
src/Credentials/CLI/Types.hs view
@@ -6,6 +6,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} @@ -35,7 +36,9 @@ import Data.Conduit import Data.Conduit.Lazy import Data.Data+import Data.Functor.Identity (Identity (..)) import Data.List (sort)+import Data.Maybe (fromMaybe) import Data.Text (Text) import Network.AWS@@ -92,14 +95,17 @@ "echo" -> pure Echo e -> fromTextError $ "Failure parsing format from: " <> e -data Options = Options- { region :: !Region- , store :: !Store+data Options f = Options+ { region :: !(f Region)+ , store :: !(f Store) , format :: !Format , level :: !LogLevel } -newtype App a = App { unApp :: ReaderT Options AWS a }+deriving instance Show (Options Maybe)+deriving instance Show (Options Identity)++newtype App a = App { unApp :: ReaderT (Options Identity) AWS a } deriving ( Functor , Applicative@@ -108,7 +114,7 @@ , MonadThrow , MonadCatch , MonadMask- , MonadReader Options+ , MonadReader (Options Identity) , MonadBase IO ) @@ -121,7 +127,7 @@ instance MonadRandom App where getRandomBytes = liftIO . getRandomBytes -runApp :: Env -> Options -> App a -> IO a+runApp :: Env -> Options Identity -> App a -> IO a runApp e c = runResourceT . runAWS e . (`runReaderT` c) . unApp runLazy :: Source App a -> App [a]@@ -136,13 +142,21 @@ fromURI u = Table u <$> fromURI u instance ToText Store where- toText = toText . URI.serializeURI' . \case+ toText = toText . URI.serializeURIRef' . \case Table u _ -> u instance Show Store where show = Text.unpack . toText instance Pretty Store where pretty = text . show instance ToLog Store where build = build . toText +defaultOptions :: Options Maybe -> Options Identity+defaultOptions x =+ let r = fromMaybe defaultRegion (region x)+ s = fromMaybe (defaultStore r) (store x)+ in x { region = Identity r+ , store = Identity s+ }+ defaultRegion :: Region defaultRegion = Frankfurt @@ -156,11 +170,11 @@ p = Port (_endpointPort e) e = defaultEndpoint dynamoDB r -setStore :: HasEnv a => Options -> a -> a+setStore :: HasEnv a => Options Identity -> a -> a setStore c = configure f where f = case store c of- Table u _ -> g u dynamoDB+ Identity (Table u _) -> g u dynamoDB g u | Just h <- host u = setEndpoint (secure u) h (port u) | otherwise = id@@ -185,5 +199,5 @@ key = A.skipSpace *> A.takeWhile1 (/= '=') val = A.char '=' *> A.takeText -ctx :: Alternative f => f Pair -> f Context-ctx f = Context . Map.fromList . map (\(Pair k v) -> (k, v)) <$> many f+fromPairs :: Alternative f => f Pair -> f Context+fromPairs f = Context . Map.fromList . map (\(Pair k v) -> (k, v)) <$> many f
src/Credentials/CLI/Types/Protocol.hs view
@@ -60,11 +60,11 @@ path = toText . BS8.dropWhile (== '/') . uriPath host :: URI -> Maybe ByteString-host = preview (uriAuthorityL . _Just . authorityHostL . hostBSL)+host = preview (authorityL . _Just . authorityHostL . hostBSL) secure :: URI -> Bool secure = (== 443) . port port :: URI -> Int port = fromMaybe 443 . preview- (uriAuthorityL . _Just . authorityPortL . _Just . portNumberL)+ (authorityL . _Just . authorityPortL . _Just . portNumberL)
src/Main.hs view
@@ -5,6 +5,7 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} @@ -26,7 +27,7 @@ import Control.Monad.Reader import Control.Monad.Trans.Resource -import Credentials hiding (context)+import Credentials import Credentials.CLI.Format import Credentials.CLI.IO import Credentials.CLI.Options@@ -34,8 +35,7 @@ import Data.ByteString.Builder (Builder) import Data.Conduit-import Data.Conduit.Lazy-import Data.List.NonEmpty (NonEmpty)+import Data.Functor.Identity (Identity (..)) import Data.Text (Text) import Network.AWS@@ -45,6 +45,7 @@ import System.IO +import qualified Control.Applicative as App import qualified Data.ByteString.Lazy as LBS import qualified Data.Conduit.Binary as CB import qualified Data.Conduit.List as CL@@ -53,17 +54,21 @@ main :: IO () main = do- (opt, mode) <- customExecParser (prefs (showHelpOnError <> columns 90)) options+ (defaultOptions -> opt, m) <-+ customExecParser (prefs (showHelpOnError <> columns 90)) options lgr <- newLogger (level opt) stderr- env <- newEnv (region opt) Discover <&> (envLogger .~ lgr) . setStore opt+ env <- newEnv (runIdentity (region opt)) Discover+ <&> (envLogger .~ lgr) . setStore opt - catches (runApp env opt (program opt mode))+ catches (runApp env opt (program opt m)) [ handler _CredentialError (quit 1 . show) ] -program :: Options -> Mode -> App ()-program Options{store = store@(Table _ table), ..} = \case+program :: Options Identity -> Mode -> App ()+program Options{ store = Identity store@(Table _ table)+ , region = Identity region+ , ..} = \case List -> do says ("Listing contents of " % store % " in " % region % "...") runLazy (revisions table) >>=@@ -120,7 +125,7 @@ teardown table emit TeardownR -options :: ParserInfo (Options, Mode)+options :: ParserInfo (Options Maybe, Mode) options = info (helper <*> modes) (fullDesc <> headerDoc (Just desc)) where desc = bold "credentials"@@ -135,24 +140,24 @@ \are stored." , mode "select"- (Select <$> context <*> name <*> optional revision)+ (Select <$> contextOption <*> nameOption <*> optional revisionOption) "Fetch and decrypt a specific credential revision." "Defaults to the latest available revision, if --revision is not specified." , mode "insert"- (Insert <$> key <*> context <*> name <*> input)+ (Insert <$> keyOption <*> contextOption <*> nameOption <*> inputOption) "Write and encrypt a new credential revision." "You can supply the secret value as a string with --secret, or as \ \a file path which contents' will be read by using --path." , mode "delete"- (Delete <$> name <*> require revision <*> force)+ (Delete <$> nameOption <*> require revisionOption <*> forceFlag) "Remove a specific credential revision." "Please note that if an application is pinned to the revision specified \ \by --revision, it will no longer be able to decrypt the credential." , mode "truncate"- (Truncate <$> name <*> force)+ (Truncate <$> nameOption <*> forceFlag) "Truncate a specific credential's revisions." "This will remove all but the most recent credential revision. \ \That is, after running this command you will have exactly _one_ \@@ -166,43 +171,54 @@ \the operation will succeed with exit status 0." , mode "teardown"- (Teardown <$> force)+ (Teardown <$> forceFlag) "Remove an entire credential store." "Warning: This will completely remove the credential store. For some \ \storage engines this action is irrevocable unless you specifically \ \perform backups for your data." ] -mode :: String -> Parser a -> Text -> Text -> Mod CommandFields (Options, a)-mode n p h f = command n (info ((,) <$> common <*> p) (fullDesc <> desc <> foot))- where- desc = progDescDoc (Just $ wrap h)- foot = footerDoc (Just $ indent 2 (wrap f) <> line)+mode :: String+ -> Parser a+ -> Text+ -> Text+ -> Mod CommandFields (Options Maybe, a)+mode name p desc foot =+ command name $ info ((,) <$> commonOptions <*> p)+ ( fullDesc <> progDescDoc (Just $ wrap desc)+ <> footerDoc (Just $ indent 2 (wrap foot) <> line)+ ) -common :: Parser Options-common = Options- <$> textOption+commonOptions :: Parser (Options Maybe)+commonOptions = Options+ <$> App.optional (textOption ( short 'r' <> long "region" <> metavar "REGION" <> completes "The AWS region in which to operate." "The following regions are supported:" (map (,mempty) unsafeEnum)- defaultRegion Nothing- )+ Nothing+ (Just "Note: this corresponds to both the KMS key region and the \+ \DynamoDB table region.")+ )) - <*> textOption+ <*> App.optional (textOption ( short 'u' <> long "uri" <> metavar "URI" <> defaults "URI specifying the storage system to use." "The URI format must follow the following protocol:" [ ("dynamo:/[/host[:port]]/table-name", "")+ , (show (defaultStore defaultRegion), "")+ ]- (defaultStore defaultRegion)- (Just "If no host is specified for AWS services (ie. dynamo:/table-name), \- \the default AWS endpoints will be used.")- )+ Nothing+ (Just "If no host is specified (ie. dynamo:/table-name), \+ \the default AWS endpoint for the given --region will be used. \+ \If an AWS endpoint is specified the endpoint region MUST \+ \correspond with --region, or a signature error will occur.")+ )) <*> textOption ( short 'o'@@ -215,7 +231,7 @@ , (Echo, "Untitled textual output with no trailing newline.") , (Print, "Print multi-line user output.") ]- Print Nothing+ (Just Print) Nothing ) <*> textOption@@ -229,11 +245,11 @@ , (Trace, "Sensitive signing metadata.") , (Info, "No logging of library routines.") ]- Info Nothing+ (Just Info) Nothing ) -key :: Parser KeyId-key = textOption+keyOption :: Parser KeyId+keyOption = textOption ( short 'k' <> long "key" <> metavar "ARN"@@ -244,12 +260,12 @@ , ("12345678-1234-1234-12345", "") , ("alias/MyAliasName", "") ]- defaultKeyId+ (Just defaultKeyId) (Just "It's recommended to setup a new key using the default alias.") ) -context :: Parser Context-context = ctx $ textOption+contextOption :: Parser Context+contextOption = fromPairs $ textOption ( short 'c' <> long "context" <> metavar "KEY=VALUE"@@ -260,31 +276,31 @@ ) Optional ) -name :: Parser Name-name = textOption+nameOption :: Parser Name+nameOption = textOption ( short 'n' <> long "name" <> metavar "STRING" <> describe "The unique name of the credential." Nothing Required ) -revision :: Fact -> Parser Revision-revision r = textOption+revisionOption :: Fact -> Parser Revision+revisionOption r = textOption ( short 'v' <> long "revision" <> metavar "STRING" <> describe "The revision of the credential." Nothing r ) -force :: Parser Force-force = flag Prompt NoPrompt+forceFlag :: Parser Force+forceFlag = flag Prompt NoPrompt ( short 'f' <> long "force" <> help "Always overwrite or remove, without an interactive prompt." ) -input :: Parser Input-input = textual <|> filepath+inputOption :: Parser Input+inputOption = textual <|> filepath where textual = Value <$> textOption