packages feed

confcrypt 0.2.3.0 → 0.2.3.3

raw patch · 12 files changed

+204/−29 lines, 12 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

+ ConfCrypt.Commands: [rTemplate] :: ReadConfCrypt -> Maybe Text
+ ConfCrypt.Commands: instance GHC.Classes.Eq ConfCrypt.Commands.ReadConfCrypt
+ ConfCrypt.Commands: instance GHC.Generics.Generic ConfCrypt.Commands.ReadConfCrypt
+ ConfCrypt.Commands: instance GHC.Read.Read ConfCrypt.Commands.ReadConfCrypt
+ ConfCrypt.Commands: instance GHC.Show.Show ConfCrypt.Commands.ReadConfCrypt
+ ConfCrypt.Template: instance GHC.Classes.Eq ConfCrypt.Template.TemplateParseError
+ ConfCrypt.Template: instance GHC.Classes.Ord ConfCrypt.Template.TemplateParseError
+ ConfCrypt.Template: instance GHC.Show.Show ConfCrypt.Template.Template
+ ConfCrypt.Template: instance GHC.Show.Show ConfCrypt.Template.TemplateParseError
+ ConfCrypt.Template: instance GHC.Show.Show ConfCrypt.Template.Variable
+ ConfCrypt.Template: instance Text.Megaparsec.Error.ShowErrorComponent ConfCrypt.Template.TemplateParseError
+ ConfCrypt.Template: renderTemplate :: Text -> Either Text (Parameter -> Text)
+ ConfCrypt.Types: FormatParseError :: Text -> ConfCryptError
+ ConfCrypt.Types: instance Text.Megaparsec.Error.ShowErrorComponent ConfCrypt.Types.ConfCryptError
- ConfCrypt.Commands: ReadConfCrypt :: ReadConfCrypt
+ ConfCrypt.Commands: ReadConfCrypt :: Maybe Text -> ReadConfCrypt

Files

app/ConfCrypt/CLI/API.hs view
@@ -8,13 +8,17 @@ ) where  import ConfCrypt.Types (SchemaType(..))-import ConfCrypt.Commands (GetConfCrypt(..), AddConfCrypt(..), EditConfCrypt(..), DeleteConfCrypt(..))+import ConfCrypt.Commands (GetConfCrypt(..), AddConfCrypt(..), EditConfCrypt(..), DeleteConfCrypt(..), ReadConfCrypt(..)) -import Options.Applicative (ParserInfo, Parser, progDesc, command, fullDesc, long, flag, metavar,-    help, strOption, short, info, header, footer, strArgument, hsubparser, helper, (<**>))+import Options.Applicative+       (ParserInfo, Parser, progDesc, command, fullDesc, long, flag,+        metavar, maybeReader, help, strOption, short, info, header, footer,+        strArgument, hsubparser, helper, (<**>), value, option, auto,+        ReadM) import qualified Data.Text as T import Paths_confcrypt (version) import Data.Version (showVersion)+import Text.Read (readMaybe)  data KeyAndConf = KeyAndConf {key :: ParsedKey, provider :: KeyProvider, conf :: FilePath}     deriving (Eq, Show)@@ -22,7 +26,7 @@     deriving (Eq, Show)  data AnyCommand-    = RC KeyAndConf+    = RC KeyAndConf ReadConfCrypt     | GC KeyAndConf GetConfCrypt     | AC KeyAndConf AddConfCrypt     | EC KeyAndConf EditConfCrypt@@ -125,7 +129,7 @@ readConf ::     KeyProvider     -> ParserInfo AnyCommand-readConf provider = info ( RC <$> keyAndConf provider False)+readConf provider = info ( RC <$> keyAndConf provider False <*> (ReadConfCrypt <$> onlyFormat))            (progDesc "Read in the provided config and decrypt it with the key. Results are printed to StdOut." <>             fullDesc) @@ -204,7 +208,23 @@         long "type" <>         short 't' <>         metavar "PARAMETER_TYPE" <>-        help "The associated type for the variable"+        help "The associated type for the variable. Must be one of [String, Int, Boolean]"         )     where         fromString = read . (:) 'C'++onlyFormat :: Parser (Maybe T.Text)+onlyFormat = option maybeOptReader (+    long "format" <>+    short 'f' <>+    metavar "TEMPLATE" <>+    value Nothing <>+    help (+        "Output parameters in a custom format specified by a template, with placeholders being replaced " <>+        "with the values for each parameter. Placeholders consist of a '%' and a single character, " <>+        "a literal '%' can be written as '%%'. Valid placeholders are: %t: type, %n: name, %v: value."+        )+    )++maybeOptReader :: ReadM (Maybe T.Text)+maybeOptReader = maybeReader $ Just. Just . T.pack
app/ConfCrypt/CLI/Engine.hs view
@@ -47,8 +47,8 @@             result <- case parsedArguments of                  -- Requires Decryption-                RC KeyAndConf {key, provider} ->-                    runConfCrypt parsedConfiguration $ runWithDecrypt key provider ReadConfCrypt+                RC KeyAndConf {key, provider} cmd ->+                    runConfCrypt parsedConfiguration $ runWithDecrypt key provider cmd                 GC KeyAndConf {key, provider} cmd ->                     runConfCrypt parsedConfiguration $ runWithDecrypt key provider cmd                 VC KeyAndConf {key, provider} ->@@ -107,7 +107,7 @@     runResourceT . runExceptT $ runReaderT action (file, ())  confFilePath :: AnyCommand -> FilePath-confFilePath  (RC KeyAndConf {conf}) = conf+confFilePath  (RC KeyAndConf {conf} _) = conf confFilePath  (GC KeyAndConf {conf} _) = conf confFilePath  (VC KeyAndConf {conf}) = conf confFilePath  (AC KeyAndConf {conf} _) = conf
app/Main.hs view
@@ -5,11 +5,11 @@ import System.Environment (getArgs) import Data.Foldable (traverse_) import Data.Text (Text, intercalate, unpack)-import Options.Applicative (execParser)+import Options.Applicative (customExecParser, ParserPrefs, prefs, showHelpOnEmpty)  main :: IO () main = do-    parsedArguments <- execParser cliParser+    parsedArguments <- customExecParser (prefs showHelpOnEmpty) cliParser     results <- run parsedArguments     traverse_ (putStrLn . unpack) results     -- The ^ `putStrLn` call is important to preserve the trailing newline. Consider
confcrypt.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: ba0d2b5403892dd88223717284c0e5acb3e489ed1e7071a545b4f24587ad8c89+-- hash: 313d86bbf1c218344644664fb149e8dd094e88b2ab48cc5501ad565f975fd0fd  name:           confcrypt-version:        0.2.3.0+version:        0.2.3.3 description:    Please see the README on GitHub at <https://github.com/CollegeVine/confcrypt#readme> homepage:       https://github.com/collegevine/confcrypt#readme bug-reports:    https://github.com/collegevine/confcrypt/issues@@ -34,6 +34,7 @@       ConfCrypt.Validation       ConfCrypt.Default       ConfCrypt.Providers.AWS+      ConfCrypt.Template   other-modules:       Paths_confcrypt   hs-source-dirs:@@ -97,7 +98,7 @@   type: exitcode-stdio-1.0   main-is: Tests.hs   other-modules:-      ConfCrypt.Parser.Tests, ConfCrypt.Commands.Tests, ConfCrypt.Encryption.Tests, ConfCrypt.CLI.API.Tests, ConfCrypt.Common, ConfCrypt.CLI.API+      ConfCrypt.Parser.Tests, ConfCrypt.Commands.Tests, ConfCrypt.Encryption.Tests, ConfCrypt.CLI.API.Tests, ConfCrypt.Common, ConfCrypt.CLI.API, ConfCrypt.Template.Tests   hs-source-dirs:       test       app
src/ConfCrypt/Commands.hs view
@@ -24,6 +24,7 @@ import ConfCrypt.Encryption (MonadEncrypt, MonadDecrypt, encryptValue, decryptValue, TextKey(..), RemoteKey(..)) import ConfCrypt.Validation (runAllRules) import ConfCrypt.Providers.AWS (AWSCtx)+import ConfCrypt.Template (renderTemplate)  import Control.Arrow (second) import Control.Monad (unless, (<=<))@@ -50,14 +51,29 @@     evaluate :: a -> m [T.Text]  -- | Read and return the full contents of an encrypted file. Provides support for using a local RSA key or an externl KMS service-data ReadConfCrypt = ReadConfCrypt+data ReadConfCrypt = ReadConfCrypt {rTemplate :: Maybe T.Text}+    deriving (Eq, Read, Show, Generic)+ instance (Monad m, MonadDecrypt (ConfCryptM m key) key) => Command ReadConfCrypt (ConfCryptM m key) where-    evaluate _ = do+    evaluate (ReadConfCrypt template) = do         (ccFile, ctx) <- ask         let params = parameters ccFile-        transformed <- mapM (\p -> decryptedParam  p <$> decryptValue ctx (paramValue p)) params-        processReadLines transformed ccFile+        case template of+            Nothing -> do+                transformed <- mapM (\p -> decryptedParam p <$> decryptValue ctx (paramValue p)) params+                processReadLines transformed ccFile+            Just tpl ->+                case renderTemplate tpl of+                    Left e -> throwError $ FormatParseError e+                    Right parsedTpl -> do+                        params' <- sequence $ decryptParam ctx <$> params+                        pure $ parsedTpl <$> params'+         where+            decryptParam ctx param = do+                value' <- decryptValue ctx $ paramValue param+                pure param {paramValue = value'}+             decryptedParam param v = ParameterLine ParamLine {pName = paramName param, pValue = v}              -- Given a transformation, apply it to the current file contents then write them to the output buffer
src/ConfCrypt/Parser.hs view
@@ -10,6 +10,7 @@ import Text.Megaparsec (Parsec, parse, getSourcePos, SourcePos(..), unPos, (<?>), try, failure, oneOf, anySingle) import Text.Megaparsec.Char (char, space, eol, string', digitChar, alphaNumChar,     symbolChar, separatorChar, letterChar, digitChar, string)+import Text.Megaparsec.Error (errorBundlePretty) import qualified Data.Text as T import qualified Data.Map as M import qualified Data.Set as S@@ -25,7 +26,7 @@     -> Either ConfCryptError ConfCryptFile parseConfCrypt filename contents =     case parse confCryptParser filename contents of-        Left err -> Left $ ParserError (T.pack $ show err)+        Left err -> Left $ ParserError (T.pack $ errorBundlePretty err)         Right rawLines -> Right $ assembleConfCrypt rawLines     where         findParamSchema lines ParamLine {pName} = listToMaybe . fmap fst . M.toList $ M.filterWithKey (\s _ ->
+ src/ConfCrypt/Template.hs view
@@ -0,0 +1,52 @@+module ConfCrypt.Template (+    renderTemplate+    ) where++import ConfCrypt.Types (Parameter(..), typeToOutputString)+import Control.Monad (void)+import Data.Maybe (maybe)+import Data.Text (Text, pack)+import Text.Megaparsec (Parsec, (<|>), anySingle, try, noneOf, many, some, parse, errorBundlePretty, ShowErrorComponent)+import Text.Megaparsec.Char (string')++renderTemplate :: Text -> Either Text (Parameter -> Text)+renderTemplate template = case parse parseTemplate "" template of+    Left err -> Left . pack $ errorBundlePretty err+    Right parsed -> Right (\param -> foldMap (replaceVars param) parsed)+    where+        replaceVars p (Text_ t)         = t+        replaceVars p (Variable_ Name)  = paramName p+        replaceVars p (Variable_ Value) = paramValue p+        replaceVars p (Variable_ Type)  = maybe "" typeToOutputString $ paramType p+++type Parser = Parsec TemplateParseError Text+newtype TemplateParseError = TemplateParseError Text deriving (Show, Ord, Eq, ShowErrorComponent)++parseTemplate :: Parser [Template]+parseTemplate =+    many (txt <|> var)+    where+        var = Variable_ <$> parseVariable+        txt = Text_ <$> parseLiteral++data Template = Variable_ Variable | Text_ Text+    deriving Show++parseLiteral :: Parser Text+parseLiteral = "%" <$ try (string' "%%") <|> pack <$> some (noneOf ("%" :: String))+++data Variable = Name | Value | Type deriving Show++parseVariable :: Parser Variable+parseVariable =+        Name  <$ try (string' "%n")+    <|> Value <$ try (string' "%v")+    <|> Type  <$ try (string' "%t")+    <|> unrecognized+    where+        unrecognized = do+            void $ string' "%"+            invalid <- anySingle+            fail $ "Unrecognized variable " ++ [invalid]
src/ConfCrypt/Types.hs view
@@ -42,6 +42,7 @@ import GHC.Generics (Generic) import qualified Data.Text as T import qualified Data.Map.Strict as M+import Text.Megaparsec.Error (ShowErrorComponent, showErrorComponent)  -- | The core transformer stack for ConfCrypt. The most important parts are the 'ReaderT' and -- 'ResourceT', as 'ExceptT' can be replaced with explicit return type.@@ -65,7 +66,26 @@     | UnknownParameter T.Text     | WrongFileAction T.Text     | CleanupError T.Text-    deriving (Show, Generic, Eq, Ord)+    | FormatParseError T.Text+    deriving (Generic, Eq, Ord)++instance Show ConfCryptError where+    show (ParserError msg) = "ParserError: "<> T.unpack msg+    show NonRSAKey = "NonRSAKey"+    show (KeyUnpackingError msg) = "KeyUnpackingError: "<> T.unpack msg+    show (DecryptionError msg) = "DecryptionError: "<> T.unpack msg+    show (AWSDecryptionError msg) = "AWSDecryptionError: "<> T.unpack msg+    show (AWSEncryptionError msg) = "AWSEncryptionError: "<> T.unpack msg+    show (EncryptionError err) = "EncryptionError: "<> show err+    show (MissingLine msg) = "MissingLine: "<> T.unpack msg+    show (UnknownParameter msg) = "UnknownParameter: "<> T.unpack msg+    show (WrongFileAction msg) = "WrongFileAction: "<> T.unpack msg+    show (CleanupError msg) = "CleanupError: "<> T.unpack msg+    show (FormatParseError msg) = "Format parse error: "<> T.unpack msg++instance ShowErrorComponent ConfCryptError where+    showErrorComponent (ParserError msg) = T.unpack msg+    showErrorComponent _ = "Not a parsable error"  instance Ord RSA.Error where     (<=) l r = show l <= show r
test/ConfCrypt/CLI/API/Tests.hs view
@@ -3,7 +3,7 @@     ) where  import ConfCrypt.CLI.API-import ConfCrypt.Commands (GetConfCrypt(..), AddConfCrypt(..), EditConfCrypt(..), DeleteConfCrypt(..))+import ConfCrypt.Commands (GetConfCrypt(..), AddConfCrypt(..), EditConfCrypt(..), DeleteConfCrypt(..), ReadConfCrypt(..)) import ConfCrypt.Types  import ConfCrypt.Common@@ -50,7 +50,7 @@         let args = ["rsa", "read", "-k", "testKey", "test.econf"]             res = execParserPure defaultPrefs cliParser args         case res of-            Success (RC (KeyAndConf (OnDisk "testKey") LocalRSA "test.econf") ) -> assertBool "can't fail" True+            Success (RC (KeyAndConf (OnDisk "testKey") LocalRSA "test.econf") _) -> assertBool "can't fail" True             Success a -> assertFailure ("Incorrectly parsed: "<> show a)             Failure _ -> assertFailure "Should have parsed an RC"             CompletionInvoked _ -> assertFailure "Incorrectly triggered completion"@@ -58,7 +58,15 @@         let args = ["rsa", "read", "--key", "testKey","test.econf"]             res = execParserPure defaultPrefs cliParser args         case res of-            Success (RC (KeyAndConf (OnDisk "testKey") LocalRSA "test.econf") ) -> assertBool "can't fail" True+            Success (RC (KeyAndConf (OnDisk "testKey") LocalRSA "test.econf") _) -> assertBool "can't fail" True+            Success a -> assertFailure ("Incorrectly parsed: "<> show a)+            Failure _ -> assertFailure "Should have parsed an RC"+            CompletionInvoked _ -> assertFailure "Incorrectly triggered completion"+    ,testCase "read preserves the provided key file with --key" $ do+        let args = ["rsa", "read", "--key", "testKey","test.econf", "--format", "foo"]+            res = execParserPure defaultPrefs cliParser args+        case res of+            Success (RC (KeyAndConf (OnDisk "testKey") LocalRSA "test.econf") (ReadConfCrypt (Just "foo"))) -> assertBool "can't fail" True             Success a -> assertFailure ("Incorrectly parsed: "<> show a)             Failure _ -> assertFailure "Should have parsed an RC"             CompletionInvoked _ -> assertFailure "Incorrectly triggered completion"
test/ConfCrypt/Commands/Tests.hs view
@@ -75,7 +75,7 @@ readTests = testGroup "Read" [     testCase "reading produces decrypted results" $ do         let testLines = parseConfCrypt "test file" testFile-        res <- getReadResult testLines+        res <- getReadResult Nothing testLines         case res of             Left e ->                 assertFailure $ show e@@ -84,23 +84,41 @@     ,testCase "reading an empty file is an empty file" $ do         let testLines = parseConfCrypt "empty test file" "# just a comment"-        res <- getReadResult testLines+        res <- getReadResult Nothing testLines         case res of             Left e ->                 assertFailure $ show e             Right lines ->                 lines @=? [] +    ,testCase "user-specified formats are used to render output" $ do+        let testLines = parseConfCrypt "test file" testFile+        res <- getReadResult (Just "foo%t %n=%v %%") testLines+        case res of+            Left e ->+                assertFailure $ show e+            Right lines ->+                lines @=? ["fooString Test=Foobar %", "fooInt Test2=42 %"]++    ,testCase "invalid formats give an error" $ do+        let testLines = parseConfCrypt "test file" testFile+        res <- getReadResult (Just "foo%abar") testLines+        case res of+            Left e ->+                e @=? FormatParseError "1:6:\n  |\n1 | foo%abar\n  |      ^\nUnrecognized variable a\n"+            Right _ ->+                assertFailure "Invalid format didn't throw an error"+     -- TODO implement the 'Arbitrary' instance to make this rule possible    -- ,testProperty "read . encrypt . read == id" $ \x -> x == 0     ]     where-        getReadResult :: Either ConfCryptError ConfCryptFile -> IO (Either ConfCryptError [T.Text])-        getReadResult testLines = do+        getReadResult :: Maybe T.Text -> Either ConfCryptError ConfCryptFile -> IO (Either ConfCryptError [T.Text])+        getReadResult tpl testLines = do             probablyKP <- runExceptT $ unpackPrivateRSAKey dangerousTestKey             privateKey <- either (assertFailure . show) (pure . project ) probablyKP :: IO RSA.PrivateKey             ccf <- either (assertFailure . show) pure testLines-            runResourceT . runExceptT $ runReaderT (evaluate ReadConfCrypt) (ccf, TextKey privateKey) :: IO (Either ConfCryptError [T.Text])+            runResourceT . runExceptT $ runReaderT (evaluate $ ReadConfCrypt tpl) (ccf, TextKey privateKey) :: IO (Either ConfCryptError [T.Text])   addTests :: TestTree
+ test/ConfCrypt/Template/Tests.hs view
@@ -0,0 +1,37 @@+module ConfCrypt.Template.Tests (+    templateTests+    ) where++import ConfCrypt.Template (renderTemplate)+import ConfCrypt.Types (Parameter(..), SchemaType(..))++import Test.Tasty+import Test.Tasty.HUnit++import Data.Text (Text(..))+import Data.Either (isLeft)++templateTests :: TestTree+templateTests = testGroup "format template parser" [+    testCase "basic template works" $ +        render "%t %n %v" param @=? Right "String name value"+    +    ,testCase "template variables can appear next to any character" $ +        render "tt%ttt%ntt%vtt" param @=? Right "ttStringttnamettvaluett"+    +    ,testCase "invalid variable names give an error" $+        isLeft (render "%t %a" param) @=? True+    +    ,testCase "%% renders to %" $+        render "%v%%%n%%%t" param @=? Right "value%name%String"+    +    ,testCase "variables can appear more than once" $+        render "%v%v%v" param @=? Right "valuevaluevalue"+    ]++render :: Text -> Parameter -> Either Text Text+render tpl param =+    let renderFunc = renderTemplate tpl+    in renderFunc <*> pure param++param = Parameter "name" "value" (Just CString)
test/Tests.hs view
@@ -2,6 +2,7 @@ import ConfCrypt.Commands.Tests (commandTests) import ConfCrypt.Encryption.Tests (encryptionTests) import ConfCrypt.CLI.API.Tests (cliAPITests)+import ConfCrypt.Template.Tests (templateTests) import Test.Tasty (TestTree, defaultMain, testGroup)  main :: IO ()@@ -19,5 +20,6 @@ libraryTests = testGroup "all library tests"[     parserTests,     commandTests,-    encryptionTests+    encryptionTests,+    templateTests     ]