confcrypt 0.1.0.3 → 0.1.0.4

raw patch · 8 files changed

+59/−81 lines, 8 filesdep ~megaparsecPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: megaparsec

API changes (from Hackage documentation)

Files

• app/ConfCrypt/CLI/Engine.hs +2/−5
• confcrypt.cabal +5/−5
• src/ConfCrypt/Commands.hs +8/−13
• src/ConfCrypt/Encryption.hs +1/−1
• src/ConfCrypt/Parser.hs +8/−19
• src/ConfCrypt/Types.hs +2/−4
• src/ConfCrypt/Validation.hs +28/−30
• test/ConfCrypt/Commands/Tests.hs +5/−4

@@ -13,10 +13,8 @@ import Conduit (ResourceT, runResourceT) import Control.Exception (catch) import Control.DeepSeq (force)-import Control.Monad.Trans (MonadIO) import Control.Monad.Reader (MonadReader, ReaderT, runReaderT, withReaderT) import Control.Monad.Except (MonadError, ExceptT, runExceptT)-import Control.Monad.Writer (MonadWriter, WriterT, execWriterT) import Crypto.PubKey.RSA.Types (PublicKey, PrivateKey) import qualified Data.Text as T import qualified Data.Text.IO as T@@ -93,13 +91,12 @@         injectPrivateKey key (conf, _) = (conf, TextKey key)  - runConfCrypt ::     ConfCryptFile-    -> ConfCryptM IO () a+    -> ConfCryptM IO () [T.Text]     -> IO (Either ConfCryptError [T.Text]) runConfCrypt file action =-    runResourceT . runExceptT . execWriterT  $ runReaderT action (file, ())+    runResourceT . runExceptT $ runReaderT action (file, ())  confFilePath :: AnyCommand -> FilePath confFilePath  (RC KeyAndConf {conf}) = conf

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: a3df760fcf44cfbf4f12aae1540474ee182d0ba30d5a4146ab63055963b6b803+-- hash: 3348b210d7e230af456f68d94b941adedba4a217fe592d8af9572e8159cb927c  name:           confcrypt-version:        0.1.0.3+version:        0.1.0.4 description:    Please see the README on GitHub at <https://github.com/CollegeVine/confcrypt#readme> homepage:       https://github.com/https://github.com/collegevine/confcrypt#readme bug-reports:    https://github.com/https://github.com/collegevine/confcrypt/issues@@ -52,7 +52,7 @@     , cryptonite >=0.25     , deepseq >=1.4.3     , lens >=4.16-    , megaparsec >=6.5 && <6.6+    , megaparsec >=7.0     , mtl >=2.2 && <2.3     , optparse-applicative >=0.14 && <0.15     , parser-combinators@@ -83,7 +83,7 @@     , cryptonite >=0.25     , deepseq >=1.4.3     , lens >=4.16-    , megaparsec >=6.5 && <6.6+    , megaparsec >=7.0     , mtl >=2.2 && <2.3     , optparse-applicative     , parser-combinators@@ -117,7 +117,7 @@     , cryptonite >=0.25     , deepseq >=1.4.3     , lens >=4.16-    , megaparsec >=6.5 && <6.6+    , megaparsec >=7.0     , memory     , mtl >=2.2 && <2.3     , optparse-applicative >=0.14 && <0.15

@@ -27,17 +27,14 @@  import Control.Arrow (second) import Control.Monad (unless, (<=<))-import Control.Monad.Trans (lift) import Control.Monad.Reader (ask) import Control.Monad.Except (throwError, runExcept, MonadError, Except)-import Control.Monad.Writer (tell, MonadWriter) import Crypto.Random (MonadRandom)-import Data.Foldable (foldrM, traverse_) import Data.List (find, sortOn)+import Data.Maybe (maybeToList) import GHC.Generics (Generic) import qualified Crypto.PubKey.RSA.Types as RSA import qualified Data.Text as T-import qualified Data.Text.Encoding as T import qualified Data.Map as M  -- | Commands may perform one of the following operations to a line of a confcrypt file@@ -52,7 +49,7 @@ -- -- In reality the return type of 'evalutate' is 'Text', this needs to be cleaned up in the upcoming version. class Monad m => Command a m where-    evaluate :: a -> m ()+    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@@ -79,9 +76,9 @@     evaluate (GetConfCrypt name) = do         (ccFile, ctx) <- ask         let mParam = find ((==name) . paramName) (parameters ccFile)-        traverse_ (decrypt ctx) mParam+        traverse (decrypt ctx) $ maybeToList mParam         where-            decrypt ctx = tell . pure <=< decryptValue ctx . paramValue+            decrypt ctx = decryptValue ctx . paramValue  -- | Used to add a new config parameter to the file data AddConfCrypt = AddConfCrypt {aName :: T.Text, aValue :: T.Text, aType :: SchemaType}@@ -133,7 +130,7 @@ -- lines may simply be deleted based on the parameter name. data DeleteConfCrypt = DeleteConfCrypt {dName:: T.Text}     deriving (Eq, Read, Show, Generic)-instance (Monad m) => Command DeleteConfCrypt (ConfCryptM m ()) where+instance Monad m => Command DeleteConfCrypt (ConfCryptM m ()) where     evaluate DeleteConfCrypt {dName} = do         (ccFile, ()) <- ask @@ -198,15 +195,14 @@  -- | Writes the provided 'ConfCryptFile' (provided as a Map) to the output buffer in line-number order. This -- allows for producing an easily diffable output and makes in-place edits easy to spot in source control diffs.-writeFullContentsToBuffer :: (Monad m, MonadWriter [T.Text] m) =>+writeFullContentsToBuffer :: Monad m =>     Bool     -> M.Map ConfCryptElement LineNumber-    -> m ()+    -> m [T.Text] writeFullContentsToBuffer wrap contents =-    traverse_ (tell . singleton . toDisplayLine wrap) sortedLines+    return $ toDisplayLine wrap <$> sortedLines     where         sortedLines = fmap fst . sortOn snd $ M.toList contents-        singleton x = [x]          toDisplayLine ::             Bool@@ -215,7 +211,6 @@         toDisplayLine _ (CommentLine comment) = "# " <> comment         toDisplayLine _ (SchemaLine (Schema name tpe)) = name <> " : " <> typeToOutputString tpe         toDisplayLine wrap (ParameterLine (ParamLine name val)) = name <> " = " <> if wrap then wrapEncryptedValue val else val-  -- TODO remove this -- | Because the encrypted results are stored as UTF8 text, its possible for an encrypted value

@@ -160,7 +160,7 @@     encryptValue (TextKey key) = encryptValue key  instance (MonadRandom m) => MonadRandom (ConfCryptM m k) where-    getRandomBytes = lift . lift . lift . lift . getRandomBytes+    getRandomBytes = lift . lift . lift . getRandomBytes  instance (MonadRandom m) => MonadRandom (ExceptT e m) where     getRandomBytes = lift . getRandomBytes

@@ -1,12 +1,3 @@--- |--- Module:          ConfCrypt.Parser--- Copyright:       (c) 2018 Chris Coffey---                  (c) 2018 CollegeVine--- License:         MIT--- Maintainer:      Chris Coffey--- Stability:       experimental--- Portability:     portable--- module ConfCrypt.Parser (     parseConfCrypt ) where@@ -16,18 +7,16 @@ import Control.Applicative ((<|>)) import Control.Applicative.Combinators (manyTill, many, some) import Data.Maybe (listToMaybe)-import Text.Megaparsec (Parsec, parse, getPosition, SourcePos(..), unPos, (<?>), try, failure)-import Text.Megaparsec.Char (char, space, eol, anyChar, string', digitChar, alphaNumChar,-    oneOf, symbolChar, separatorChar, letterChar, digitChar, string)+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 qualified Data.Text as T import qualified Data.Map as M import qualified Data.Set as S  type Parser = Parsec ConfCryptError T.Text --- | Parse raw 'Text' into a 'ConfCryptFile'.------ Duplicates are removed by virtue of using a 'Map'. This means the behavior for having duplciate+-- | Duplicates are removed by virtue of using a 'Map'. This means the behavior for having duplciate -- parameter names is officially undefined, but as implemented the last parameter read will be preserved. -- DO NOT RELY ON THIS BEHAVIOR! parseConfCrypt ::@@ -68,7 +57,7 @@     _ <- space     _ <- char '#'     _ <- char ' '-    line <- T.pack <$> manyTill anyChar eol+    line <- T.pack <$> manyTill anySingle eol     _ <- many eol     pure (CommentLine line, lineNum) @@ -113,7 +102,7 @@  parseLineNum :: Parser LineNumber parseLineNum =-    LineNumber . unPos . sourceLine <$> getPosition+    LineNumber . unPos . sourceLine <$> getSourcePos  validName :: Parser T.Text validName =@@ -125,6 +114,6 @@     where         wrapped = do             _ <- string "BEGIN"-            value <- manyTill anyChar (string "END")+            value <- manyTill anySingle (string "END")             pure $ T.pack value-        standard = T.pack <$> manyTill anyChar eol+        standard = T.pack <$> manyTill anySingle eol

@@ -37,7 +37,6 @@ import Conduit (ResourceT) import Control.Monad.Reader (MonadReader, ReaderT, runReaderT) import Control.Monad.Except (MonadError, ExceptT, runExceptT)-import Control.Monad.Writer (MonadWriter, WriterT, execWriterT) import Control.DeepSeq (NFData) import qualified Crypto.PubKey.RSA.Types as RSA import GHC.Generics (Generic)@@ -45,12 +44,11 @@ import qualified Data.Map.Strict as M  -- | The core transformer stack for ConfCrypt. The most important parts are the 'ReaderT' and--- 'ResourceT', as the 'WriterT' and 'ExceptT' can both be replaced with explicit return types.+-- 'ResourceT', as 'ExceptT' can be replaced with explicit return type. type ConfCryptM m ctx =     ReaderT (ConfCryptFile, ctx) (-            WriterT [T.Text] (                 ExceptT ConfCryptError (-                    ResourceT m)+                    ResourceT m                 )         ) 

@@ -22,63 +22,61 @@ import ConfCrypt.Encryption (decryptValue, MonadDecrypt)  import Control.Monad.Except (runExcept, catchError)-import Control.Monad.Writer (MonadWriter, tell) import Control.Monad.Reader (MonadReader, ask) import Data.Char (isDigit)-import Data.Foldable (traverse_) import Data.Maybe (isNothing) import qualified Data.Text as T import qualified Data.Map as M  -- | Apply all validation rules, accumulating the errors across rules.-runAllRules :: (MonadDecrypt m key,-    Monad m,-    MonadWriter [T.Text] m,+runAllRules :: (Monad m,+    MonadDecrypt m key,     MonadReader (ConfCryptFile, key) m) =>-    m ()+    m [T.Text] runAllRules = do     (ccf, privateKey) <- ask-    parameterTypesMatchSchema privateKey ccf-    logMissingSchemas ccf-    logMissingParameters ccf+    a <- parameterTypesMatchSchema privateKey ccf+    b <- logMissingSchemas ccf+    c <- logMissingParameters ccf+    pure $ filter (not . T.null) $ a <> b <> c  -- | For each (Schema, Parameter)  pair, confirm that the parameter's value type matches the schema.-parameterTypesMatchSchema :: (Monad m, MonadWriter [T.Text] m, MonadDecrypt m key) =>+parameterTypesMatchSchema :: (Monad m, MonadDecrypt m key) =>     key     -> ConfCryptFile-    -> m ()+    -> m [T.Text] parameterTypesMatchSchema key ConfCryptFile {parameters} =-    traverse_ decryptAndCompare parameters+    traverse decryptAndCompare parameters     where         decryptAndCompare Parameter {paramName, paramValue, paramType} =             catchError (runRule paramType paramName =<< decryptValue key paramValue)-                       (const $ tell ["Error: Could not decrypt " <> paramName])+                       (const $ pure ("Error: Could not decrypt " <> paramName))         runRule paramType paramName val =             case paramType of-                Nothing -> pure ()-                Just CInt | all isDigit $ T.unpack val -> pure ()-                Just CBoolean | T.toLower val == "true" || T.toLower val == "false" -> pure ()-                Just CString | not (T.null val) -> pure ()-                Just CString | T.null val -> tell ["Warning: "<> paramName <> " is empty"]-                Just pt -> tell ["Error: "<> paramName <> " does not match the schema type " <> typeToOutputString pt]+                Nothing -> pure ""+                Just CInt | all isDigit $ T.unpack val -> pure ""+                Just CBoolean | T.toLower val == "true" || T.toLower val == "false" -> pure ""+                Just CString | not (T.null val) -> pure ""+                Just CString | T.null val -> pure $ "Warning: "<> paramName <> " is empty"+                Just pt -> pure $ "Error: "<> paramName <> " does not match the schema type " <> typeToOutputString pt  -- | Raise an error if there are parameters without a schema-logMissingSchemas :: (Monad m, MonadWriter [T.Text] m) =>+logMissingSchemas :: Monad m =>     ConfCryptFile-    -> m ()+    -> m [T.Text] logMissingSchemas ConfCryptFile {parameters} =-    traverse_ logMissingSchema parameters+    traverse logMissingSchema parameters     where         logMissingSchema Parameter {paramName, paramType}-            | isNothing paramType = tell ["Error: " <> paramName <> " does not have a scheam"]-            | otherwise = pure ()+            | isNothing paramType = pure $ "Error: " <> paramName <> " does not have a schema"+            | otherwise = pure ""  -- | Raise an error if there are schema without a parameter-logMissingParameters :: (Monad m, MonadWriter [T.Text] m) =>+logMissingParameters :: Monad m =>     ConfCryptFile-    -> m ()+    -> m [T.Text] logMissingParameters ConfCryptFile {fileContents} =-    traverse_ logMissingParameter . M.toList $ M.filterWithKey (\k _ -> isSchema k) fileContents+    traverse logMissingParameter . M.toList $ M.filterWithKey (\k _ -> isSchema k) fileContents     where         isSchema (SchemaLine _) = True         isSchema _ = False@@ -86,7 +84,7 @@         paramForName name _ = False          logMissingParameter (SchemaLine Schema {sName}, _)-            | M.null $ M.filterWithKey (\k _ -> paramForName sName k) fileContents  = tell ["Error: no matching parameter for schema "<> sName]-            | otherwise = pure ()-        logMissingParameter _ =  pure ()+            | M.null $ M.filterWithKey (\k _ -> paramForName sName k) fileContents  = pure $ "Error: no matching parameter for schema "<> sName+            | otherwise = pure ""+        logMissingParameter _ =  pure "" 

@@ -11,10 +11,10 @@ import ConfCrypt.Common  import Conduit (runResourceT)+import Control.Monad (join) import Control.Monad.Identity (runIdentity) import Control.Monad.Reader (runReaderT) import Control.Monad.Except (runExcept, runExceptT)-import Control.Monad.Writer (execWriter, execWriterT) import qualified Crypto.PubKey.RSA.Types as RSA import Crypto.Random (withDRG, drgNewSeed, seedFromInteger) import Data.Monoid ((<>))@@ -24,6 +24,7 @@ import Test.QuickCheck (NonEmptyList(..)) import Test.Tasty.HUnit import qualified Data.Text as T+import qualified Data.Text.IO as T import qualified Data.Map as M  commandTests :: TestTree@@ -63,7 +64,7 @@ bufferWriteProperties  = testGroup "Buffer write" [     testProperty "parse (writerBuffer xs) == xs" $ \(ValidCCF ccf)-> let         fc = fileContents ccf-        output = (<> "\n") . T.intercalate "\n" . execWriter $ writeFullContentsToBuffer True fc+        output = (<> "\n") . T.intercalate "\n" $ join (writeFullContentsToBuffer True fc)         parseRes = parseConfCrypt "" output         in either (const False)                   (\ccf' -> fileContents ccf' == fc)@@ -99,7 +100,7 @@             probablyKP <- runExceptT $ unpackPrivateRSAKey dangerousTestKey             privateKey <- either (assertFailure . show) (pure . project ) probablyKP :: IO RSA.PrivateKey             ccf <- either (assertFailure . show) pure testLines-            runResourceT . runExceptT . execWriterT $ runReaderT (evaluate ReadConfCrypt) (ccf, TextKey privateKey) :: IO (Either ConfCryptError [T.Text])+            runResourceT . runExceptT $ runReaderT (evaluate ReadConfCrypt) (ccf, TextKey privateKey) :: IO (Either ConfCryptError [T.Text])   addTests :: TestTree@@ -123,7 +124,7 @@                                 (M.fromList [(SchemaLine Schema {sName= "Test", sType = CString},LineNumber 1),                                              (ParameterLine ParamLine {pName ="Test", pValue="Foo"},LineNumber 2)])                                 [Parameter "Test" "Foo" ( Just CString )]-        res <- runResourceT . runExceptT . execWriterT $ runReaderT (evaluate dummyAdd) (ccf, TextKey publicKey) :: IO (Either ConfCryptError [T.Text])+        res <- runResourceT . runExceptT $ runReaderT (evaluate dummyAdd) (ccf, TextKey publicKey) :: IO (Either ConfCryptError [T.Text])         case res of             Left (WrongFileAction _) -> assertBool "hmm" True             _ -> assertFailure "Expected a WrongFileAction error"