diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,3 @@ +# Changelog for confcrypt + +## Unreleased changes diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Author name here (c) 2018 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,72 @@ +# confcrypt +As soon as an application is deployed or built on more than a single machine, you tend to start worrying about managing the configuration. There are a number of ways to approach this problem, but ultimately there's a need to protect sentisive inforamtion like database password and api tokens. While you can always store those directly in a config management system like AWS' Parameter Store, doing so means you can't track configuration changes in source control. This application provides yet another simple and straightforward means of hiding config information within source control. + +[![CircleCI](https://circleci.com/gh/collegevine/confcrypt/tree/master.svg?style=svg)](https://circleci.com/gh/collegevine/confcrypt/tree/master) + +## Installing confcrypt +#### Mac OSX + + +## Using confcrypt +- create a config + `confcrypt create ` creates a new empty confcrypt config named `.econf`. Internally, it looks like this: + ``` + # confcrypt schema + # Configuration parameters may be either a String, Int, or Boolean + # Parameter schema take the following shape: + # schema := [term | value | comment] + # term := confname : type + # confname := [a-z,A-Z,_,0-9] + # type := String | Int | Boolean + # value := confname = String + # comment := # String + # + # For example: + # DB_CONN_STR : String + # DB_CONN_STR = Connection String + # USE_SSL : Boolean + # USE_SSL = True + # TIMEOUT_MS : Int + # TIMEOUT_MS = 300 + ``` +- read a config + `confcrypt read --key ` + This command reads in the provided file, decrypts the configuration variables using the provided key, then prints them to stdout. This allows you to pipe the results to other utilities. Returns 0 on success. +- add a parameter + `confcrypt add --key --name --type --vaue + Adds a new confguration parameter to the file. `--name` and `--value` are required, while `--type` is optional. If `--type` is provided, the schema record will be added immediately before the config variable. In total this adds two lines to the file. Returns 0 on sccess. +- remove a parameter + `confcrypt delete --name + Removes an existing config parameter & associated schema. Returns 0 on success or 1 if the parameter is not found in the file. +- edit a parameter in-place + `confcrypt edit --key --name --value --type ` + Modifies an existing configuration parameter in place, leaving all other lines unchanged. While this isn't how it's actually implemented, this operation is equivalent to piping `confcrypt read` to a new file, editing the parameter, then reencrypting it. +- validate a config + `confcrypt validate --key ` + Checks that each config parameter matches the type of its schema. All errors are accumulated and returned at the end, with a response code equal to the number of failures. + +- Using Amazon KMS instead of a local key + The `--use-aws` flag changes the behavior of the `--key` parameter to represent a KMS key id rather than an on-disk rsa key file. + +## The confcrypt file format + ``` + # confcrypt schema + # Configuration parameters may be either a String, Int, or Boolean + # Parameter schema take the following shape: + # schema := [term | value | comment] + # term := confname : type + # confname := [a-z,A-Z,_,0-9] + # type := String | Int | Boolean + # value := confname = String + # comment := # String + # + # For example: + # DB_CONN_STR : String + # DB_CONN_STR = Connection String + # USE_SSL : Boolean + # USE_SSL = True + # TIMEOUT_MS : Int + # TIMEOUT_MS = 300 + ``` + + While the default config created via `confcrypt new ...` places the schema on line `n` and parameters on `n+1`, there's no required ordering for the file. In fact, you can choose to entirely omit the schema and only store configuration paraemters in an `econf` file, but this will cause `confcrypt validate` to fail. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/app/ConfCrypt/CLI/API.hs b/app/ConfCrypt/CLI/API.hs new file mode 100644 --- /dev/null +++ b/app/ConfCrypt/CLI/API.hs @@ -0,0 +1,138 @@ +module ConfCrypt.CLI.API ( + KeyAndConf(..), + Conf(..), + KeyProvider(..), + AnyCommand(..), + cliParser +) where + +import ConfCrypt.Types (SchemaType(..)) +import ConfCrypt.Commands (AddConfCrypt(..), EditConfCrypt(..), DeleteConfCrypt(..)) + +import Options.Applicative +import qualified Data.Text as T + +data KeyAndConf = KeyAndConf {key :: FilePath, provider :: KeyProvider, conf :: FilePath} + deriving (Eq, Show) +newtype Conf = Conf FilePath + deriving (Eq, Show) + +data AnyCommand + = RC KeyAndConf + | AC KeyAndConf AddConfCrypt + | EC KeyAndConf EditConfCrypt + | DC Conf DeleteConfCrypt + | VC KeyAndConf + | NC + deriving (Eq, Show) + +data KeyProvider + = AWS + | LocalRSA + deriving (Eq, Show) + +cliParser :: ParserInfo AnyCommand +cliParser = info (commandParser <**> helper) $ + fullDesc <> + (header "confcrypt: a tool for sane configuration management") <> + (footer "confcrypt's documentation and source is avaiable at ") + + +commandParser :: Parser AnyCommand +commandParser = hsubparser + ( + command "add" add + <> + command "edit" edit + <> + command "delete" delete + <> + command "read" readConf + <> + command "validate" validate + <> + command "new" new + ) + +add :: ParserInfo AnyCommand +add = info ( AC <$> keyAndConf <*> (AddConfCrypt <$> onlyName <*> onlyValue <*> onlyType)) + (progDesc "Add a new parameter to the configuration file. New parameters are added to the end of the file." <> + fullDesc) + +edit :: ParserInfo AnyCommand +edit = info ( EC <$> keyAndConf <*> (EditConfCrypt <$> onlyName <*> onlyValue <*> onlyType)) + (progDesc "Modify an existing parameter in-place. This should preserve a clean diff." <> + fullDesc) + +delete :: ParserInfo AnyCommand +delete = info ( DC <$> getConf <*> (DeleteConfCrypt <$> onlyName)) + (progDesc "Removes an existing parameter from the configuration." <> + fullDesc) + +readConf :: ParserInfo AnyCommand +readConf = info ( RC <$> keyAndConf ) + (progDesc "Read in the provided config and decrypt it with the key. Results are printed to StdOut." <> + fullDesc) + +validate :: ParserInfo AnyCommand +validate = info ( VC <$> keyAndConf) + (progDesc "Check that the configuration is self-consistent and obeys the confcrypt rules." <> + fullDesc) + +new :: ParserInfo AnyCommand +new = info (pure NC) + (progDesc "Produce a new boilerplate confcrypt file. This should be piped into your desired config." <> + fullDesc) + +keyAndConf :: Parser KeyAndConf +keyAndConf = + KeyAndConf <$> + strOption ( + long "key" <> + short 'k' <> + metavar "KEY" <> + help "The path to the private RSA key used to encrypt this file." + ) <*> + getProvider <*> + onlyConf + +getConf :: Parser Conf +getConf = Conf <$> onlyConf + +onlyConf :: Parser FilePath +onlyConf = strArgument (metavar "CONFIG_FILE") + +onlyName :: Parser T.Text +onlyName = strOption ( + long "name" <> + short 'n' <> + metavar "PARAMETER_NAME" <> + help "The name of the configuration parameter. This must consist of consist solely of uppercase letters, digits, and the '_' (underscore) ASCII characters." + ) + +onlyValue :: Parser T.Text +onlyValue = strOption ( + long "value" <> + short 'v' <> + metavar "PARAMETER_VALUE" <> + help "The value to set in the config file. This can be any set of characters you want, but there may be issues with multi-byte code points in UTF-8." + ) + +onlyType :: Parser SchemaType +onlyType = + fromString <$> strOption ( + long "type" <> + short 't' <> + metavar "PARAMETER_TYPE" <> + help "The associated type for the variable" + ) + where + fromString = read . (:) 'C' + +getProvider :: Parser KeyProvider +getProvider = flag LocalRSA AWS ( + long "use-aws" <> + help "Toggles whether the --key indicates an RSA keyfile or an AWS KMS key identifer" + ) + + diff --git a/app/ConfCrypt/CLI/Engine.hs b/app/ConfCrypt/CLI/Engine.hs new file mode 100644 --- /dev/null +++ b/app/ConfCrypt/CLI/Engine.hs @@ -0,0 +1,107 @@ +module ConfCrypt.CLI.Engine ( + run + ) where + +import ConfCrypt.Types +import ConfCrypt.Commands +import ConfCrypt.Parser +import ConfCrypt.Encryption +import ConfCrypt.Default (emptyConfCryptFile) +import ConfCrypt.Providers.AWS +import ConfCrypt.CLI.API + +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 +import System.Exit (exitSuccess, exitFailure, exitWith, ExitCode(..)) + +-- | After command line arguments have been parsed, the following steps are performed. First, +-- read the config file and ensure it can be parsed. Next, inject the encryption/decryption context +-- into the environment. The context to inject is determined by the command line flags. Finally, evaluate +-- the command provided on the command line and return the results as a list of output lines. +-- +-- This wraps and drives the core ConfCrypt library. +run :: + AnyCommand -- ^ Command line arguments + -> IO [T.Text] +run NC = do + res <- runConfCrypt emptyConfCryptFile $ evaluate NewConfCrypt + either (\e -> print e *> exitFailure) + pure + res +run parsedArguments = do + let filePath = confFilePath parsedArguments + lines <- T.readFile filePath + configParsingResults <- parseConfCrypt filePath <$> pure lines + case configParsingResults of + --TODO print errors to stdErr + Left err -> print err *> exitFailure + Right parsedConfiguration -> do + result <- case parsedArguments of + + -- Requires Decryption + RC KeyAndConf {key, provider} -> + runConfCrypt parsedConfiguration $ runWithDecrypt key provider ReadConfCrypt + VC KeyAndConf {key, provider} -> + runConfCrypt parsedConfiguration $ runWithDecrypt key provider ValidateConfCrypt + + -- Requires Encryption + AC KeyAndConf {key, provider} cmd -> + runConfCrypt parsedConfiguration $ runWithEncrypt key provider cmd + EC KeyAndConf {key, provider} cmd -> + runConfCrypt parsedConfiguration $ runWithEncrypt key provider cmd + + -- Doesn't care about encryption + DC _ cmd -> + runConfCrypt parsedConfiguration $ evaluate cmd + either (\e -> print e *> exitFailure) pure result + where + + -- Inject an encryption context into the currently loaded environment. This varies dependng + -- on whether its a local RSA key or a KMS key + runWithEncrypt k AWS cmd = do + ctx <- loadAwsCtx (KMSKeyId $ T.pack k) + withReaderT (injectAWSCtx ctx) $ evaluate cmd + runWithEncrypt k LocalRSA cmd = do + rsaKey <- loadRSAKey k + withReaderT (injectPubKey rsaKey) $ evaluate cmd + + -- Inject a decryption context into the currently loaded environment. This varies dependng + -- on whether its a local RSA key or a KMS key + runWithDecrypt k AWS cmd = do + ctx <- loadAwsCtx (KMSKeyId $ T.pack k) + withReaderT (injectAWSCtx ctx) $ evaluate cmd + runWithDecrypt k LocalRSA cmd = do + rsaKey <- loadRSAKey k + withReaderT (injectPrivateKey rsaKey) $ evaluate cmd + + -- lensing functions + injectAWSCtx :: AWSCtx -> (ConfCryptFile, ()) -> (ConfCryptFile, RemoteKey AWSCtx) + injectAWSCtx ctx (conf, _) = (conf, RemoteKey ctx) + injectPubKey :: PublicKey -> (ConfCryptFile, ()) -> (ConfCryptFile, TextKey PublicKey) + injectPubKey key (conf, _) = (conf, TextKey key) + injectPrivateKey :: PrivateKey -> (ConfCryptFile, ()) -> (ConfCryptFile, TextKey PrivateKey) + injectPrivateKey key (conf, _) = (conf, TextKey key) + + + +runConfCrypt :: + ConfCryptFile + -> ConfCryptM IO () a + -> IO (Either ConfCryptError [T.Text]) +runConfCrypt file action = + runResourceT . runExceptT . execWriterT $ runReaderT action (file, ()) + +confFilePath :: AnyCommand -> FilePath +confFilePath (RC KeyAndConf {conf}) = conf +confFilePath (VC KeyAndConf {conf}) = conf +confFilePath (AC KeyAndConf {conf} _) = conf +confFilePath (EC KeyAndConf {conf} _) = conf +confFilePath (DC (Conf conf) _) = conf diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,14 @@ +module Main where + +import ConfCrypt.CLI.Engine (run) +import ConfCrypt.CLI.API (cliParser) +import System.Environment (getArgs) +import Data.Foldable (traverse_) +import Data.Text (Text, intercalate, unpack) +import Options.Applicative (execParser) + +main :: IO () +main = do + parsedArguments <- execParser cliParser + results <- run parsedArguments + traverse_ (putStrLn . unpack) results diff --git a/confcrypt.cabal b/confcrypt.cabal new file mode 100644 --- /dev/null +++ b/confcrypt.cabal @@ -0,0 +1,130 @@ +-- This file has been generated from package.yaml by hpack version 0.28.2. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: 2c9303345239b5c99d7178fd414d1bfd1a6bba670f523d8f11d8eb89dfcbc3e8 + +name: confcrypt +version: 0.1.0.0 +description: Please see the README on GitHub at +homepage: https://github.com/https://github.com/collegevine/confcrypt#readme +bug-reports: https://github.com/https://github.com/collegevine/confcrypt/issues +author: Chris Coffey +maintainer: chris@collegevine.com +copyright: 2018 Chris Coffey, CollegeVine +license: MIT +license-file: LICENSE +build-type: Simple +cabal-version: >= 1.10 +extra-source-files: + ChangeLog.md + README.md + +source-repository head + type: git + location: https://github.com/https://github.com/collegevine/confcrypt + +library + exposed-modules: + ConfCrypt.Types + ConfCrypt.Parser + ConfCrypt.Commands + ConfCrypt.Encryption + ConfCrypt.Validation + ConfCrypt.Default + ConfCrypt.Providers.AWS + other-modules: + Paths_confcrypt + hs-source-dirs: + src + default-extensions: MultiParamTypeClasses OverloadedStrings FlexibleContexts FlexibleInstances NamedFieldPuns TupleSections DeriveGeneric DeriveAnyClass FunctionalDependencies TypeApplications UndecidableInstances GADTs ConstraintKinds + build-depends: + amazonka + , amazonka-kms + , base >=4.7 && <5 + , base64-bytestring + , bytestring + , conduit + , containers + , crypto-pubkey-openssh + , crypto-pubkey-types + , cryptonite + , deepseq + , lens + , megaparsec + , mtl + , optparse-applicative + , parser-combinators + , text + , transformers + , async + default-language: Haskell2010 + +executable confcrypt + main-is: Main.hs + other-modules: + ConfCrypt.CLI.API + ConfCrypt.CLI.Engine + hs-source-dirs: + app + default-extensions: MultiParamTypeClasses OverloadedStrings FlexibleContexts FlexibleInstances NamedFieldPuns TupleSections ExistentialQuantification TypeApplications UndecidableInstances BangPatterns ViewPatterns + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: + amazonka + , amazonka-kms + , base >=4.7 && <5 + , base64-bytestring + , bytestring + , conduit + , confcrypt + , containers + , crypto-pubkey-openssh + , crypto-pubkey-types + , cryptonite + , deepseq + , lens + , megaparsec + , mtl + , optparse-applicative + , parser-combinators + , text + , transformers + default-language: Haskell2010 + +test-suite confcrypt-test + 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 + hs-source-dirs: + test + app + default-extensions: MultiParamTypeClasses OverloadedStrings FlexibleContexts FlexibleInstances NamedFieldPuns TupleSections + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: + HUnit + , QuickCheck + , amazonka + , amazonka-kms + , base >=4.7 && <5 + , base64-bytestring + , bytestring + , conduit + , confcrypt + , containers + , crypto-pubkey-openssh + , crypto-pubkey-types + , cryptonite + , deepseq + , lens + , megaparsec + , memory + , mtl + , optparse-applicative + , parser-combinators + , tasty + , tasty-hunit + , tasty-quickcheck + , text + , transformers + default-language: Haskell2010 diff --git a/src/ConfCrypt/Commands.hs b/src/ConfCrypt/Commands.hs new file mode 100644 --- /dev/null +++ b/src/ConfCrypt/Commands.hs @@ -0,0 +1,216 @@ +module ConfCrypt.Commands ( + -- * Commands + Command, + evaluate, + + -- * Supported Commands + ReadConfCrypt(..), + AddConfCrypt(..), + EditConfCrypt(..), + DeleteConfCrypt(..), + ValidateConfCrypt(..), + NewConfCrypt(..), + + -- * Utilities + FileAction(..), + -- ** Exported for testing + genNewFileState, + writeFullContentsToBuffer + ) where + +import ConfCrypt.Default (defaultLines) +import ConfCrypt.Types +import ConfCrypt.Encryption (MonadEncrypt, MonadDecrypt, encryptValue, decryptValue, TextKey(..), RemoteKey(..)) +import ConfCrypt.Validation (runAllRules) +import ConfCrypt.Providers.AWS (AWSCtx) + +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 (sortOn) +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 +data FileAction + = Add + | Edit + | Remove + +-- | All confcrypt commands can be generalized into an 'evaluate' call. In reality, instances likely +-- need to provide some environment, although that's not required as everything could be contained +-- as record fields of the command argument itself. +-- +-- 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 () + +-- | 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 +instance (Monad m, MonadDecrypt (ConfCryptM m key) key) => Command ReadConfCrypt (ConfCryptM m key) where + evaluate _ = do + (ccFile, ctx) <- ask + let params = parameters ccFile + transformed <- mapM (\p -> decryptedParam p <$> decryptValue ctx (paramValue p)) params + processReadLines transformed ccFile + where + 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 + processReadLines transformed ccFile = + writeFullContentsToBuffer False =<< genNewFileState (fileContents ccFile) transformedLines + where + transformedLines = [(p, Edit)| p <- transformed] + + +-- | Used to add a new config parameter to the file +data AddConfCrypt = AddConfCrypt {aName :: T.Text, aValue :: T.Text, aType :: SchemaType} + deriving (Eq, Read, Show, Generic) + +instance (Monad m, MonadRandom m, MonadEncrypt (ConfCryptM m key) key) => + Command AddConfCrypt (ConfCryptM m key) where + evaluate ac@AddConfCrypt {aName, aValue, aType} = do + (ccFile, ctx ) <- ask + encryptedValue <- encryptValue ctx aValue + let contents = fileContents ccFile + instructions = [(SchemaLine sl, Add), (ParameterLine (pl {pValue = encryptedValue}), Add)] + newcontents <- genNewFileState contents instructions + writeFullContentsToBuffer False newcontents + where + (pl, Just sl) = parameterToLines Parameter {paramName = aName, paramValue = aValue, paramType = Just aType} + +-- | Modify the value or type of a parameter in-place. This should result in a diff touching only the impacted lines. +-- Very important that this property holds to make reviews easier. +data EditConfCrypt = EditConfCrypt {eName:: T.Text, eValue :: T.Text, eType :: SchemaType} + deriving (Eq, Read, Show, Generic) + +instance (Monad m, MonadRandom m, MonadEncrypt (ConfCryptM m key) key) => + Command EditConfCrypt (ConfCryptM m key) where + evaluate ec@EditConfCrypt {eName, eValue, eType} = do + (ccFile, ctx) <- ask + + -- Editing an existing parameter requires that the file is inplace. Its not difficult to fall back into + -- 'add' behavior in the case where the parameter isn't present, but I'm not implementing that right now. + unless ( any ((==) eName . paramName) $ parameters ccFile) $ + throwError $ UnknownParameter eName + + rawEncrypted <- encryptValue ctx eValue + editOutput ccFile ec rawEncrypted + where + -- Editing consists of replacing the encrypted value assocaited and type assocaited with a given parameter + -- then writing the changes as in-place updates to the file. + editOutput ccFile EditConfCrypt {eName, eValue, eType} encryptedValue = do + let contents = fileContents ccFile + instructions = [(SchemaLine sl, Edit), + (ParameterLine (pl {pValue = encryptedValue}), Edit) + ] + newcontents <- genNewFileState contents instructions + writeFullContentsToBuffer False newcontents + where + (pl, Just sl) = parameterToLines Parameter {paramName = eName, paramValue = eValue, paramType = Just eType} + +-- | Removes a particular parameter and schema from the config file. This does not require an encryption key because the +-- 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 + evaluate DeleteConfCrypt {dName} = do + (ccFile, ()) <- ask + + unless (any ((==) dName . paramName) $ parameters ccFile) $ + throwError $ UnknownParameter dName + + let contents = fileContents ccFile + instructions = fmap (second (const Remove)) . M.toList $ M.filterWithKey findNamedLine contents + + newcontents <- genNewFileState contents instructions + writeFullContentsToBuffer False newcontents + where + findNamedLine (SchemaLine Schema {sName}) _ = dName == sName + findNamedLine (ParameterLine ParamLine {pName}) _ = dName == pName + findNamedLine _ _ = False + +-- | Run all of the rules in 'ConfCrypt.Validation' on this file. +data ValidateConfCrypt = ValidateConfCrypt +instance (Monad m, MonadDecrypt (ConfCryptM m key) key) => Command ValidateConfCrypt (ConfCryptM m key) where + evaluate _ = runAllRules + +-- | Dumps the contents of 'defaultLines' to the output buffer. This is the same example config used +-- in the readme. +data NewConfCrypt = NewConfCrypt +instance Monad m => Command NewConfCrypt (ConfCryptM m ()) where + evaluate _ = + writeFullContentsToBuffer False (fileContents defaultLines) + + +-- | Given a known file state and some edits, apply the edits and produce the new file contents +genNewFileState :: (Monad m, MonadError ConfCryptError m) => + M.Map ConfCryptElement LineNumber -- ^ initial file state + -> [(ConfCryptElement, FileAction)] -- ^ edits + -> m (M.Map ConfCryptElement LineNumber) -- ^ new file, with edits applied in-place +genNewFileState fileContents [] = pure fileContents +genNewFileState fileContents ((CommentLine _, _):rest) = genNewFileState fileContents rest +genNewFileState fileContents ((line, action):rest) = + case M.toList (mLine line) of + [] -> + case action of + Add -> let + nums = M.elems fileContents + LineNumber highestLineNum = if null nums then LineNumber 0 else maximum nums + fc' = M.insert line (LineNumber $ highestLineNum + 1) fileContents + in genNewFileState fc' rest + _ -> throwError $ MissingLine (T.pack $ show line) + [(key, lineNum@(LineNumber lnValue))] -> + case action of + Remove -> let + fc' = M.delete key fileContents + fc'' = (\(LineNumber l) -> if l > lnValue then LineNumber (l - 1) else LineNumber l) <$> fc' + in genNewFileState fc'' rest + Edit -> let + fc' = M.delete key fileContents + fc'' = M.insert line lineNum fc' + in genNewFileState fc'' rest + _ -> throwError $ WrongFileAction ((<> " is an Add, but the line already exists. Did you mean to edit?"). T.pack $ show line) + _ -> error "viloates map key uniqueness" + + where + mLine l = M.filterWithKey (\k _ -> k == l) fileContents + +-- | 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) => + Bool + -> M.Map ConfCryptElement LineNumber + -> m () +writeFullContentsToBuffer wrap contents = + traverse_ (tell . singleton . toDisplayLine wrap) sortedLines + where + sortedLines = fmap fst . sortOn snd $ M.toList contents + singleton x = [x] + + toDisplayLine :: + Bool + -> ConfCryptElement + -> T.Text + 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 +-- to embed end-of-line (eol) characters into the output value. This means rather than relying on eol +-- as our delimeter we need to explicitly wrap encrypted values in something very unlikely to occur w/in +-- an encrypted value. +wrapEncryptedValue :: + T.Text + -> T.Text +wrapEncryptedValue v = "BEGIN"<>v<>"END" diff --git a/src/ConfCrypt/Default.hs b/src/ConfCrypt/Default.hs new file mode 100644 --- /dev/null +++ b/src/ConfCrypt/Default.hs @@ -0,0 +1,56 @@ +-- | +-- Module: ConfCrypt.Default +-- Copyright: (c) 2018 Chris Coffey +-- (c) 2018 CollegeVine +-- License: MIT +-- Maintainer: Chris Coffey +-- Stability: experimental +-- Portability: portable + + +module ConfCrypt.Default ( + -- * Defaults + defaultConf, + defaultLines, + -- * Exported for testing + emptyConfCryptFile + ) where + +import ConfCrypt.Parser (parseConfCrypt) +import ConfCrypt.Types + +import Data.Either (fromRight) +import qualified Data.Map as M +import qualified Data.Text as T + +-- | Printed out on request as an example or starting point for new users. +defaultConf :: T.Text +defaultConf = "# confcrypt schema#more things\n\ + \# Configuration parameters may be either a String, Int, or Boolean\n\ + \# Parameter schema take the following shape:\n\ + \# schema := [term | value | comment]\n\ + \# term := confname : type\n\ + \# confname := [a-z,A-Z,_,0-9]\n\ + \# type := String | Int | Boolean\n\ + \# value := confname = String\n\ + \# comment := # String\n\ + + \# For example:\n\ + \DB_CONN_STR : String\n\ + \DB_CONN_STR = Connection String\n\ + \ USE_SSL : Boolean\n\ + \ USE_SSL = True\n\ + \ TIMEOUT_MS : Int\n\ + \ TIMEOUT_MS = 300" + +-- | The standard empty config +emptyConfCryptFile :: ConfCryptFile +emptyConfCryptFile = ConfCryptFile { + fileName = "empty", + fileContents = M.empty, + parameters = [] + } + +-- | Extracts the plaintext from 'defaultConf' into a populated config +defaultLines :: ConfCryptFile +defaultLines = fromRight emptyConfCryptFile $ parseConfCrypt "default Config" defaultConf diff --git a/src/ConfCrypt/Encryption.hs b/src/ConfCrypt/Encryption.hs new file mode 100644 --- /dev/null +++ b/src/ConfCrypt/Encryption.hs @@ -0,0 +1,213 @@ +-- | +-- Module: ConfCrypt.Encryption +-- Copyright: (c) 2018 Chris Coffey +-- (c) 2018 CollegeVine +-- License: MIT +-- Maintainer: Chris Coffey +-- Stability: experimental +-- Portability: portable +-- +-- This exposes the interface and instances for handling encryption/decryption. The interface for +-- each operation is intentionally split. + +module ConfCrypt.Encryption ( + + -- * Working with RSA keys + KeyProjection, + project, + TextKey(..), + + -- * Working with KMS keys + RemoteKey(..), + + -- * Working with values + Encrypted, + renderEncrypted, + MonadEncrypt, + encryptValue, + MonadDecrypt, + decryptValue, + + -- * Utilities + loadRSAKey, + + -- ** Exported for Testing + unpackPrivateRSAKey + ) where + +import ConfCrypt.Types +import ConfCrypt.Providers.AWS (AWSCtx(..), KMSKeyId(..)) + +import Control.Lens (view) +import Control.Monad.Trans (lift, liftIO, MonadIO) +import Control.Monad.Trans.Class (MonadTrans) +import Control.Monad.Except (MonadError, throwError, Except, ExceptT, runExcept) +import Conduit (MonadResource, MonadThrow) +import Crypto.PubKey.OpenSsh (OpenSshPublicKey(..), OpenSshPrivateKey(..), decodePublic, decodePrivate) +import qualified Crypto.PubKey.RSA.Types as RSA +import Crypto.Types.PubKey.RSA (PrivateKey(..), PublicKey(..)) +import Crypto.PubKey.RSA.PKCS15 (encrypt, decrypt) +import Crypto.Random.Types (MonadRandom, getRandomBytes) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as BSC +import qualified Data.ByteString.Base64 as B64 +import Data.Text as T +import Data.Text.Encoding as T +import qualified Control.Monad.Trans.AWS as AWS +import qualified Network.AWS.KMS.Encrypt as AWS +import qualified Network.AWS.KMS.Decrypt as AWS + +-- | Represents the textual contents of any key stored on the local machine +data TextKey key where + TextKey :: LocalKey key => key -> TextKey key + + +-- | This class provides the ability to extract specific parts of a keypair from a given RSA 'KeyPair' +class KeyProjection key where + project :: RSA.KeyPair -> key + +instance KeyProjection RSA.PublicKey where + project = RSA.toPublicKey + +instance LocalKey RSA.PublicKey + +instance KeyProjection RSA.PrivateKey where + project = RSA.toPrivateKey + +instance LocalKey RSA.PrivateKey + +-- | Given a file on disk that contains the textual representation of an RSA private key (as generated by openssh or ssh-keygen), +-- extract the key from the file and project it into the type of key required. +loadRSAKey :: (MonadIO m, Monad m, MonadError ConfCryptError m, KeyProjection key) => + FilePath + -> m key +loadRSAKey privateKey = do + prvBytes <- liftIO $ BS.readFile privateKey + project <$> unpackPrivateRSAKey prvBytes + +-- | A private function to actually unpack the RSA key. Only used for testing +unpackPrivateRSAKey :: (MonadError ConfCryptError m) => + BS.ByteString + -> m RSA.KeyPair +unpackPrivateRSAKey rawPrivateKey = + case decodePrivate rawPrivateKey of + Left errMsg -> throwError . KeyUnpackingError $ T.pack errMsg + Right (OpenSshPrivateKeyDsa _ _ ) -> throwError NonRSAKey + Right (OpenSshPrivateKeyRsa key ) -> pure $ toKeyPair key + where + -- The joys of a needlessly fragmented library ecosystem... + cryptonitePub key = RSA.PublicKey { + RSA.public_size = public_size key, + RSA.public_n = public_n key, + RSA.public_e = public_e key + } + toKeyPair key = RSA.KeyPair $ RSA.PrivateKey { + RSA.private_pub = cryptonitePub $ private_pub key, + RSA.private_d = private_d key, + RSA.private_p = private_p key, + RSA.private_q = private_q key, + RSA.private_dP = private_dP key, + RSA.private_dQ = private_dQ key, + RSA.private_qinv = private_qinv key + } + +-- TODO use this type in lieu of raw text +newtype Encrypted = Encrypted T.Text + deriving (Eq, Show) + +renderEncrypted :: Encrypted -> T.Text +renderEncrypted (Encrypted encText) = undefined + +toEncrypted :: T.Text -> Encrypted +toEncrypted = Encrypted + +-- | Decrypts an encrypted block of text +class (Monad m, MonadError ConfCryptError m) => MonadDecrypt m k where + -- | Given a key and some encrypted ciphertext, returns either the decrypted plaintext or + -- raises a 'ConfCryptError' + decryptValue :: k -> T.Text -> m T.Text + +instance (Monad m, MonadError ConfCryptError m) => MonadDecrypt m RSA.PrivateKey where + decryptValue _ "" = pure "" + decryptValue privateKey encryptedValue = + either (throwError . DecryptionError) + (pure . T.decodeUtf8) + (lMap (T.pack . show) . decrypt Nothing privateKey =<< unwrapBytes encryptedValue) + +instance (MonadError ConfCryptError m, Monad m) => MonadDecrypt m (TextKey RSA.PrivateKey) where + decryptValue (TextKey key) = decryptValue key + + +-- +-- Encryption +-- + +-- | The interface for encrypting a value is simply a function from a key + plaintext -> ciphertext. +class (Monad m, MonadError ConfCryptError m) => MonadEncrypt m k where + -- | Encrypts a value and either returns the ciphertext or throws a 'ConfCryptError' + encryptValue :: k -> T.Text -> m T.Text + +instance (Monad m, MonadRandom m, MonadError ConfCryptError m) => MonadEncrypt m RSA.PublicKey where + encryptValue _ "" = pure "" + encryptValue publicKey nakedValue = do + res <- encrypt publicKey $ T.encodeUtf8 nakedValue + either (throwError . EncryptionError) + (pure . wrapBytes) + res + +instance (MonadRandom m, MonadError ConfCryptError m, Monad m) => + MonadEncrypt m (TextKey RSA.PublicKey) where + encryptValue (TextKey key) = encryptValue key + +instance (MonadRandom m) => MonadRandom (ConfCryptM m k) where + getRandomBytes = lift . lift . lift . lift . getRandomBytes + +instance (MonadRandom m) => MonadRandom (ExceptT e m) where + getRandomBytes = lift . getRandomBytes + + +-- +-- KMS Support +-- + +-- | Represents a KMS key remotely managed by a third party service provider. +data RemoteKey key where + RemoteKey :: KMSKey key => key -> RemoteKey key + + +instance KMSKey AWSCtx +-- TODO can this constraint be cleaner? Duplicating 'key' is ugly +instance MonadDecrypt (ConfCryptM IO (RemoteKey AWSCtx)) (RemoteKey AWSCtx) where + decryptValue (RemoteKey AWSCtx {env}) rawValue = AWS.runAWST env $ do + -- Unwrap bytes + let decoded = unwrapBytes rawValue + rawBytes <- either (throwError . AWSDecryptionError) pure decoded + -- Decrypt them + decryptResponse <- AWS.send $ AWS.decrypt rawBytes + let status = view AWS.drsResponseStatus decryptResponse + plaintext = view AWS.drsPlaintext decryptResponse + decodedResult = T.decodeUtf8 <$> plaintext + -- TODO look into AWS status codes and fail on the failure cases + -- when (status) + maybe (throwError $ AWSDecryptionError "Unable to decrypt value") pure decodedResult + +instance MonadEncrypt (ConfCryptM IO (RemoteKey AWSCtx)) (RemoteKey AWSCtx) where + encryptValue (RemoteKey AWSCtx {env, kmsKey}) rawValue = AWS.runAWST env $ do + -- Encode bytes + let encryptRequest = AWS.encrypt (keyId kmsKey) $ T.encodeUtf8 rawValue + encryptResponse <- AWS.send encryptRequest + let status = view AWS.ersResponseStatus encryptResponse + plaintext = view AWS.ersCiphertextBlob encryptResponse + -- Wrap them up in B64 + decodedResult = wrapBytes <$> plaintext + maybe (throwError $ AWSEncryptionError "Unable to encrypt value") pure decodedResult + +unwrapBytes :: T.Text -> Either T.Text BS.ByteString +unwrapBytes = lMap T.pack . B64.decode . T.encodeUtf8 + +lMap :: (a -> b) -> Either a r -> Either b r +lMap f (Left v) = Left (f v) +lMap _ (Right v) = Right v + +wrapBytes :: BS.ByteString -> T.Text +wrapBytes = T.decodeUtf8 . B64.encode diff --git a/src/ConfCrypt/Parser.hs b/src/ConfCrypt/Parser.hs new file mode 100644 --- /dev/null +++ b/src/ConfCrypt/Parser.hs @@ -0,0 +1,130 @@ +-- | +-- 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 + +import ConfCrypt.Types + +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 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 +-- parameter names is officially undefined, but as implemented the last parameter read will be preserved. +-- DO NOT RELY ON THIS BEHAVIOR! +parseConfCrypt :: + FilePath + -> T.Text + -> Either ConfCryptError ConfCryptFile +parseConfCrypt filename contents = + case parse confCryptParser filename contents of + Left err -> Left $ ParserError (T.pack $ show err) + Right rawLines -> Right $ assembleConfCrypt rawLines + where + findParamSchema lines ParamLine {pName} = listToMaybe . fmap fst . M.toList $ M.filterWithKey (\s _ -> + Just True == ((==) pName . sName <$> unWrapSchema s) ) lines + assembleConfCrypt :: [(ConfCryptElement, LineNumber)] -> ConfCryptFile + assembleConfCrypt assocList = let + contentsMap = M.fromList assocList + rawParams = (\(ParameterLine p) -> p) <$> [p | p <- M.keys contentsMap, isParameter p] + params = [Parameter { + paramName = pName p, + paramValue = pValue p, + paramType = fmap sType $ unWrapSchema =<< findParamSchema contentsMap p} | p <- rawParams] + in ConfCryptFile { + fileName = T.pack filename, + fileContents = contentsMap, + parameters = params + } + + +confCryptParser :: Parser [(ConfCryptElement, LineNumber)] +confCryptParser = + many lineParser + where + lineParser = try parseComment <|> try parseSchema <|> try parseParameter + +parseComment :: Parser (ConfCryptElement, LineNumber) +parseComment = do + lineNum <- parseLineNum + _ <- space + _ <- char '#' + _ <- char ' ' + line <- T.pack <$> manyTill anyChar eol + _ <- many eol + pure (CommentLine line, lineNum) + +parseSchema :: Parser (ConfCryptElement, LineNumber) +parseSchema = do + (lineNum, name) <- beginsWithName + _ <- char ':' + _ <- char ' ' + tpe <- parseType + _ <- many eol + pure (SchemaLine Schema {sName= name, sType= tpe}, lineNum) + +parseType :: Parser SchemaType +parseType = let + tryString = do + _ <- try $ string' "String" + pure CString + tryInt = do + _ <- try $ string' "Int" + pure CInt + tryBoolean = do + _ <- try $ string' "Boolean" + pure CBoolean + in tryString <|> tryInt <|> tryBoolean + +parseParameter :: Parser (ConfCryptElement, LineNumber) +parseParameter = do + (lineNum, name) <- beginsWithName + _ <- char '=' + _ <- char ' ' + value <- validValue + _ <- many eol + pure (ParameterLine ParamLine {pName= name, pValue = value}, lineNum) + +beginsWithName :: Parser (LineNumber, T.Text) +beginsWithName = do + lineNum <- parseLineNum + _ <- space + name <- validName + _ <- space + pure (lineNum, name) + +parseLineNum :: Parser LineNumber +parseLineNum = + LineNumber . unPos . sourceLine <$> getPosition + +validName :: Parser T.Text +validName = + T.pack <$> many (letterChar <|> digitChar <|> char '_') + +validValue :: Parser T.Text +validValue = + try wrapped <|> try standard + where + wrapped = do + _ <- string "BEGIN" + value <- manyTill anyChar (string "END") + pure $ T.pack value + standard = T.pack <$> manyTill anyChar eol diff --git a/src/ConfCrypt/Providers/AWS.hs b/src/ConfCrypt/Providers/AWS.hs new file mode 100644 --- /dev/null +++ b/src/ConfCrypt/Providers/AWS.hs @@ -0,0 +1,33 @@ +module ConfCrypt.Providers.AWS ( + AWSCtx(..), + KMSKeyId(..), + loadAwsCtx + ) where + +import ConfCrypt.Types + +import Control.Monad.Trans.AWS as AWS +import qualified Data.Text as T +import Control.Lens (lens) + +-- | Wraps a KMS key id. For more on KMS keys, see https://docs.aws.amazon.com/kms/latest/developerguide/crypto-intro.html +newtype KMSKeyId = KMSKeyId {keyId :: T.Text} + deriving (Show, Eq) + +-- | Confcrypt reqires the pair of 'KMSKeyId' and 'AWS.Env' to run any operations in an AWS context. +data AWSCtx = + AWSCtx {env :: AWS.Env, kmsKey :: KMSKeyId} + +instance HasEnv (ConfCryptFile, AWSCtx) where + environment = lens getEnv setEnv + where + getEnv :: (ConfCryptFile, AWSCtx) -> AWS.Env + getEnv (_, AWSCtx {env}) = env + setEnv :: (ConfCryptFile, AWSCtx) -> AWS.Env -> (ConfCryptFile, AWSCtx) + setEnv (file, ctx) env' = (file, ctx {env = env'}) + +-- | Load the 'AWSCtx'. It first checks for configuration in environment variables, then a local config file. The +-- discovery logic is described in 'AWs' +loadAwsCtx keyId = do + env <- AWS.newEnv AWS.Discover + pure AWSCtx {env = env, kmsKey = keyId} diff --git a/src/ConfCrypt/Types.hs b/src/ConfCrypt/Types.hs new file mode 100644 --- /dev/null +++ b/src/ConfCrypt/Types.hs @@ -0,0 +1,166 @@ +-- | +-- Module: ConfCrypt.Types +-- Copyright: (c) 2018 Chris Coffey +-- (c) 2018 CollegeVine +-- License: MIT +-- Maintainer: Chris Coffey +-- Stability: experimental +-- Portability: portable +-- +-- Core types and some small helper functions used to construct ConfCrypt. +module ConfCrypt.Types ( + -- * Core types + ConfCryptM, + -- ** Errors + ConfCryptError(..), + -- ** Runtime Environment + ConfCryptFile(..), + Parameter(..), + -- ** File Format + ConfCryptElement(..), + LineNumber(..), + SchemaType(..), + ParamLine(..), + Schema(..), + + -- ** Key constraints + LocalKey, + KMSKey, + + -- * Helpers + unWrapSchema, + isParameter, + typeToOutputString, + parameterToLines +) where + +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) +import qualified Data.Text as T +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. +type ConfCryptM m ctx = + ReaderT (ConfCryptFile, ctx) ( + WriterT [T.Text] ( + ExceptT ConfCryptError ( + ResourceT m) + ) + ) + +-- | The possible errors produced during a confcrypt operation. +data ConfCryptError + = ParserError T.Text + | NonRSAKey + | KeyUnpackingError T.Text + | DecryptionError T.Text + | AWSDecryptionError T.Text + | AWSEncryptionError T.Text + | EncryptionError RSA.Error + | MissingLine T.Text + | UnknownParameter T.Text + | WrongFileAction T.Text + | CleanupError T.Text + deriving (Show, Generic, Eq, Ord) + +instance Ord RSA.Error where + (<=) l r = show l <= show r + +-- | As indicated in the Readme, a ConfCrypt file +data ConfCryptFile = + ConfCryptFile { + fileName :: T.Text, + fileContents :: M.Map ConfCryptElement LineNumber, + parameters :: [Parameter] + } deriving (Show, Generic, NFData) + +-- | The syntax used to describe a confcrypt file. A line in a confcrypt file may be one of 'Schema', +-- 'ParamLine', or comment. The grammar itself is described in the readme and 'Confcrypt.Parser'. +data ConfCryptElement + = SchemaLine Schema + | CommentLine {cText ::T.Text} + | ParameterLine ParamLine + deriving (Show, Generic, NFData) + +-- | this implementation means that there can only be a single parameter or schema with the same name. +-- Attempting to add multiple with the same name is undefined behavior and will result in missing data. +instance Eq ConfCryptElement where + (==) (SchemaLine l) (SchemaLine r) = sName l == sName r + (==) (ParameterLine l) (ParameterLine r) = pName l == pName r + (==) (CommentLine l) (CommentLine r) = l == r + (==) _ _ = False + +-- | In order to +instance Ord ConfCryptElement where + (<=) (SchemaLine l) (SchemaLine r) = sName l <= sName r + (<=) (SchemaLine l) (CommentLine _) = False + (<=) (SchemaLine l) (ParameterLine _) = True + (<=) (ParameterLine l) (ParameterLine r) = pName l <= pName r + (<=) (ParameterLine l) (CommentLine _) = False + (<=) (ParameterLine l) (SchemaLine _) = False + (<=) (CommentLine l) (CommentLine r) = l <= r + (<=) (CommentLine l) (ParameterLine _) = True + (<=) (CommentLine l) (SchemaLine _) = True + +-- | A parameter consists of both a 'ParamLine' and 'Schema' line from the confcr +data Parameter = Parameter {paramName :: T.Text, paramValue :: T.Text, paramType :: Maybe SchemaType} + deriving (Eq, Ord, Show, Generic, NFData) + +-- | A parsed parameter line from a confcrypt file +data ParamLine = ParamLine {pName :: T.Text, pValue :: T.Text} + deriving (Eq, Ord, Show, Generic, NFData) + +-- | A parsed schema line from a confcrypt file +data Schema = Schema {sName :: T.Text, sType :: SchemaType} + deriving (Eq, Ord, Show, Generic, NFData) + +-- | Self explanitory +newtype LineNumber = LineNumber Int + deriving (Eq, Ord, Show, Generic, NFData) + +-- | Indicates which types a +data SchemaType + = CString -- ^ Maps to 'String' + | CInt -- ^ Maps to 'Int' + | CBoolean -- ^ Maps to 'Bool' + deriving (Eq, Ord, Show, Generic, NFData, Read) + + +-- | A special purpose 'Show' function for convert +typeToOutputString :: + SchemaType + -> T.Text +typeToOutputString CString = "String" +typeToOutputString CInt = "Int" +typeToOutputString CBoolean = "Boolean" + +-- | Convert a parameter into a 'ParameterLine' and 'SchemaLine' if possible. +parameterToLines :: + Parameter + -> (ParamLine, Maybe Schema) +parameterToLines Parameter {paramName, paramValue, paramType} = + (ParamLine paramName paramValue, Schema paramName <$> paramType) + +-- | Checks whether the provided line from a confcrypt file is a 'Parameter' +isParameter :: ConfCryptElement -> Bool +isParameter (ParameterLine _) = True +isParameter _ = False + +-- | Attempts to unwrap a line from a confcrypt file into a 'Schema' +unWrapSchema :: ConfCryptElement -> Maybe Schema +unWrapSchema (SchemaLine s) = Just s +unWrapSchema _ = Nothing + +-- | This constraint provides a type-level check that the wrapped key type is local to the +-- current machine. For use with things like RSA keys. +class LocalKey key + +-- | This constraint provides a type-level check that the wrapped key type exists off-system inside +-- an externally provided Key Management System (KMS). For use with AWS KMS or Azure KMS. +class KMSKey key diff --git a/src/ConfCrypt/Validation.hs b/src/ConfCrypt/Validation.hs new file mode 100644 --- /dev/null +++ b/src/ConfCrypt/Validation.hs @@ -0,0 +1,92 @@ +-- | +-- Module: ConfCrypt.Validation +-- Copyright: (c) 2018 Chris Coffey +-- (c) 2018 CollegeVine +-- License: MIT +-- Maintainer: Chris Coffey +-- Stability: experimental +-- Portability: portable + + +module ConfCrypt.Validation ( + -- * Rule validation + runAllRules, + + -- ** Individual rules + parameterTypesMatchSchema, + logMissingSchemas, + logMissingParameters + ) where + +import ConfCrypt.Types +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, + MonadReader (ConfCryptFile, key) m) => + m () +runAllRules = do + (ccf, privateKey) <- ask + parameterTypesMatchSchema privateKey ccf + logMissingSchemas ccf + logMissingParameters ccf + +-- | 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) => + key + -> ConfCryptFile + -> m () +parameterTypesMatchSchema key ConfCryptFile {parameters} = + traverse_ decryptAndCompare parameters + where + decryptAndCompare Parameter {paramName, paramValue, paramType} = + catchError (runRule paramType paramName =<< decryptValue key paramValue) + (const $ tell ["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] + +-- | Raise an error if there are parameters without a schema +logMissingSchemas :: (Monad m, MonadWriter [T.Text] m) => + ConfCryptFile + -> m () +logMissingSchemas ConfCryptFile {parameters} = + traverse_ logMissingSchema parameters + where + logMissingSchema Parameter {paramName, paramType} + | isNothing paramType = tell ["Error: " <> paramName <> " does not have a scheam"] + | otherwise = pure () + +-- | Raise an error if there are schema without a parameter +logMissingParameters :: (Monad m, MonadWriter [T.Text] m) => + ConfCryptFile + -> m () +logMissingParameters ConfCryptFile {fileContents} = + traverse_ logMissingParameter . M.toList $ M.filterWithKey (\k _ -> isSchema k) fileContents + where + isSchema (SchemaLine _) = True + isSchema _ = False + paramForName name (ParameterLine ParamLine {pName}) = name == pName + 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 () + diff --git a/test/ConfCrypt/CLI/API/Tests.hs b/test/ConfCrypt/CLI/API/Tests.hs new file mode 100644 --- /dev/null +++ b/test/ConfCrypt/CLI/API/Tests.hs @@ -0,0 +1,257 @@ +module ConfCrypt.CLI.API.Tests ( + cliAPITests + ) where + +import ConfCrypt.CLI.API +import ConfCrypt.Commands (AddConfCrypt(..), EditConfCrypt(..), DeleteConfCrypt(..)) +import ConfCrypt.Types + +import ConfCrypt.Common + +import Options.Applicative (execParserPure, ParserResult(..), defaultPrefs) +import Test.Tasty +import Test.Tasty.HUnit + +localTestConf :: KeyAndConf +localTestConf = KeyAndConf "testKey" LocalRSA "test.econf" + +cliAPITests :: TestTree +cliAPITests = testGroup "cli api" [ + apiTests + ] + +apiTests :: TestTree +apiTests = testGroup "specific cases" [ + readCases, + addCases, + editCases, + deleteCases, + validateCases + ] + +readCases :: TestTree +readCases = testGroup "read" [ + testCase "read requires a key" $ do + let args = ["read", "test.econf"] + res = execParserPure defaultPrefs cliParser args + case res of + Failure _ -> assertBool "can't fail" True + Success a -> assertFailure ("Incorrectly parsed: "<> show a) + CompletionInvoked _ -> assertFailure "Incorrectly triggered completion" + ,testCase "read requires a config file" $ do + let args = ["read", "--key", "testKey"] + res = execParserPure defaultPrefs cliParser args + case res of + Failure _ -> assertBool "can't fail" True + Success a -> assertFailure ("Incorrectly parsed: "<> show a) + CompletionInvoked _ -> assertFailure "Incorrectly triggered completion" + ,testCase "read preserves the provided key file with -k" $ do + let args = ["read", "-k", "testKey", "test.econf"] + res = execParserPure defaultPrefs cliParser args + case res of + Success (RC (KeyAndConf "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 = ["read", "--key", "testKey","test.econf"] + res = execParserPure defaultPrefs cliParser args + case res of + Success (RC (KeyAndConf "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" + ] + +addCases :: TestTree +addCases = testGroup "add" [ + testCase "requires a key" $ do + let args = ["add", "--name", "test", "--type", "String", "--value", "foo", "test.econf"] + res = execParserPure defaultPrefs cliParser args + case res of + Failure _ -> assertBool "can't fail" True + Success a -> assertFailure ("Incorrectly parsed: "<> show a) + CompletionInvoked _ -> assertFailure "Incorrectly triggered completion" + + ,testCase "requires a name" $ do + let args = ["add", "--key", "testKey", "--type", "String", "--value", "foo", "test.econf"] + res = execParserPure defaultPrefs cliParser args + case res of + Failure _ -> assertBool "can't fail" True + Success a -> assertFailure ("Incorrectly parsed: "<> show a) + CompletionInvoked _ -> assertFailure "Incorrectly triggered completion" + + ,testCase "requires a type" $ do + let args = ["add", "--key", "testKey", "--name", "test", "--value", "foo", "test.econf"] + res = execParserPure defaultPrefs cliParser args + case res of + Failure _ -> assertBool "can't fail" True + Success a -> assertFailure ("Incorrectly parsed: "<> show a) + CompletionInvoked _ -> assertFailure "Incorrectly triggered completion" + + ,testCase "requires a value" $ do + let args = ["add", "--key", "testKey", "--name", "test", "--type", "String", "test.econf"] + res = execParserPure defaultPrefs cliParser args + case res of + Failure _ -> assertBool "can't fail" True + Success a -> assertFailure ("Incorrectly parsed: "<> show a) + CompletionInvoked _ -> assertFailure "Incorrectly triggered completion" + + ,testCase "requires a config file" $ do + let args = ["add", "--key", "testKey", "--name", "test", "--type", "String", "--value", "foo"] + res = execParserPure defaultPrefs cliParser args + case res of + Failure _ -> assertBool "can't fail" True + Success a -> assertFailure ("Incorrectly parsed: "<> show a) + CompletionInvoked _ -> assertFailure "Incorrectly triggered completion" + + ,testCase "preserves the provided arguments " $ do + let args = ["add", "--key", "testKey", "--name", "test", "--type", "String", "--value", "foo", "test.econf"] + res = execParserPure defaultPrefs cliParser args + case res of + Success (AC (KeyAndConf "testKey" LocalRSA "test.econf") (AddConfCrypt "test" "foo" CString)) -> assertBool "can't fail" True + Success a -> assertFailure ("Incorrectly parsed: "<> show a) + Failure _ -> assertFailure "Should have parsed an AC" + CompletionInvoked _ -> assertFailure "Incorrectly triggered completion" + + ,testCase "supports alternative argument labels" $ do + let args = ["add", "-k", "testKey", "-n", "test", "-t", "String", "-v", "foo", "test.econf"] + res = execParserPure defaultPrefs cliParser args + case res of + Success (AC (KeyAndConf "testKey" LocalRSA "test.econf") (AddConfCrypt "test" "foo" CString)) -> assertBool "can't fail" True + Success a -> assertFailure ("Incorrectly parsed: "<> show a) + Failure _ -> assertFailure "Should have parsed an AC" + CompletionInvoked _ -> assertFailure "Incorrectly triggered completion" + ] + +editCases :: TestTree +editCases = testGroup "edit" [ + testCase "requires a key" $ do + let args = ["edit", "--name", "test", "--type", "String", "--value", "foo", "test.econf"] + res = execParserPure defaultPrefs cliParser args + case res of + Failure _ -> assertBool "can't fail" True + Success a -> assertFailure ("Incorrectly parsed: "<> show a) + CompletionInvoked _ -> assertFailure "Incorrectly triggered completion" + + ,testCase "requires a name" $ do + let args = ["edit", "--key", "testKey", "--type", "String", "--value", "foo", "test.econf"] + res = execParserPure defaultPrefs cliParser args + case res of + Failure _ -> assertBool "can't fail" True + Success a -> assertFailure ("Incorrectly parsed: "<> show a) + CompletionInvoked _ -> assertFailure "Incorrectly triggered completion" + + ,testCase "requires a type" $ do + let args = ["edit", "--key", "testKey", "--name", "test", "--value", "foo", "test.econf"] + res = execParserPure defaultPrefs cliParser args + case res of + Failure _ -> assertBool "can't fail" True + Success a -> assertFailure ("Incorrectly parsed: "<> show a) + CompletionInvoked _ -> assertFailure "Incorrectly triggered completion" + + ,testCase "requires a value" $ do + let args = ["edit", "--key", "testKey", "--name", "test", "--type", "String", "test.econf"] + res = execParserPure defaultPrefs cliParser args + case res of + Failure _ -> assertBool "can't fail" True + Success a -> assertFailure ("Incorrectly parsed: "<> show a) + CompletionInvoked _ -> assertFailure "Incorrectly triggered completion" + + ,testCase "requires a config file" $ do + let args = ["edit", "--key", "testKey", "--name", "test", "--type", "String", "--value", "foo"] + res = execParserPure defaultPrefs cliParser args + case res of + Failure _ -> assertBool "can't fail" True + Success a -> assertFailure ("Incorrectly parsed: "<> show a) + CompletionInvoked _ -> assertFailure "Incorrectly triggered completion" + + ,testCase "preserves the provided arguments " $ do + let args = ["edit", "--key", "testKey", "--name", "test", "--type", "String", "--value", "foo", "test.econf"] + res = execParserPure defaultPrefs cliParser args + case res of + Success (EC (KeyAndConf "testKey" LocalRSA "test.econf") (EditConfCrypt "test" "foo" CString)) -> assertBool "can't fail" True + Success a -> assertFailure ("Incorrectly parsed: "<> show a) + Failure _ -> assertFailure "Should have parsed an AC" + CompletionInvoked _ -> assertFailure "Incorrectly triggered completion" + + ,testCase "supports alternative argument labels" $ do + let args = ["edit", "-k", "testKey", "-n", "test", "-t", "String", "-v", "foo", "test.econf"] + res = execParserPure defaultPrefs cliParser args + case res of + Success (EC (KeyAndConf "testKey" LocalRSA "test.econf") (EditConfCrypt "test" "foo" CString)) -> assertBool "can't fail" True + Success a -> assertFailure ("Incorrectly parsed: "<> show a) + Failure _ -> assertFailure "Should have parsed an AC" + CompletionInvoked _ -> assertFailure "Incorrectly triggered completion" + ] + +deleteCases :: TestTree +deleteCases = testGroup "delete" [ + testCase "requires a name" $ do + let args = ["delete", "test.econf"] + res = execParserPure defaultPrefs cliParser args + case res of + Failure _ -> assertBool "can't fail" True + Success a -> assertFailure ("Incorrectly parsed: "<> show a) + CompletionInvoked _ -> assertFailure "Incorrectly triggered completion" + + ,testCase "requires a config file" $ do + let args = ["delete", "--name", "test", "--value", "foo"] + res = execParserPure defaultPrefs cliParser args + case res of + Failure _ -> assertBool "can't fail" True + Success a -> assertFailure ("Incorrectly parsed: "<> show a) + CompletionInvoked _ -> assertFailure "Incorrectly triggered completion" + + ,testCase "preserves the provided arguments " $ do + let args = ["delete", "--name", "test", "test.econf"] + res = execParserPure defaultPrefs cliParser args + case res of + Success (DC (Conf "test.econf") (DeleteConfCrypt "test")) -> assertBool "can't fail" True + Success a -> assertFailure ("Incorrectly parsed: "<> show a) + Failure _ -> assertFailure "Should have parsed a DC" + CompletionInvoked _ -> assertFailure "Incorrectly triggered completion" + + ,testCase "supports alternative argument labels" $ do + let args = ["delete", "-n", "test", "test.econf"] + res = execParserPure defaultPrefs cliParser args + case res of + Success (DC (Conf "test.econf") (DeleteConfCrypt "test")) -> assertBool "can't fail" True + Success a -> assertFailure ("Incorrectly parsed: "<> show a) + Failure _ -> assertFailure "Should have parsed a DC" + CompletionInvoked _ -> assertFailure "Incorrectly triggered completion" + ] + +validateCases :: TestTree +validateCases = testGroup "validate" [ + testCase "validate requires a key" $ do + let args = ["validate", "test.econf"] + res = execParserPure defaultPrefs cliParser args + case res of + Failure _ -> assertBool "can't fail" True + Success a -> assertFailure ("Incorrectly parsed: "<> show a) + CompletionInvoked _ -> assertFailure "Incorrectly triggered completion" + ,testCase "validate requires a config file" $ do + let args = ["validate", "--key", "testKey"] + res = execParserPure defaultPrefs cliParser args + case res of + Failure _ -> assertBool "can't fail" True + Success a -> assertFailure ("Incorrectly parsed: "<> show a) + CompletionInvoked _ -> assertFailure "Incorrectly triggered completion" + ,testCase "validate preserves the provided key file with -k" $ do + let args = ["validate", "-k", "testKey", "test.econf"] + res = execParserPure defaultPrefs cliParser args + case res of + Success (VC (KeyAndConf "testKey" LocalRSA "test.econf") ) -> assertBool "can't fail" True + Success a -> assertFailure ("Incorrectly parsed: "<> show a) + Failure _ -> assertFailure "Should have parsed an VC" + CompletionInvoked _ -> assertFailure "Incorrectly triggered completion" + ,testCase "validate preserves the provided key file with --key" $ do + let args = ["validate", "--key", "testKey","test.econf"] + res = execParserPure defaultPrefs cliParser args + case res of + Success (VC (KeyAndConf "testKey" LocalRSA "test.econf") ) -> assertBool "can't fail" True + Success a -> assertFailure ("Incorrectly parsed: "<> show a) + Failure _ -> assertFailure "Should have parsed an VC" + CompletionInvoked _ -> assertFailure "Incorrectly triggered completion" + ] diff --git a/test/ConfCrypt/Commands/Tests.hs b/test/ConfCrypt/Commands/Tests.hs new file mode 100644 --- /dev/null +++ b/test/ConfCrypt/Commands/Tests.hs @@ -0,0 +1,156 @@ +module ConfCrypt.Commands.Tests ( + commandTests + ) where + +import ConfCrypt.Types +import ConfCrypt.Commands +import ConfCrypt.Parser +import ConfCrypt.Default +import ConfCrypt.Encryption (unpackPrivateRSAKey, project, TextKey(..)) + +import ConfCrypt.Common + +import Conduit (runResourceT) +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 ((<>)) +import Data.List (sort, nub) +import Test.Tasty +import Test.Tasty.QuickCheck +import Test.QuickCheck (NonEmptyList(..)) +import Test.Tasty.HUnit +import qualified Data.Text as T +import qualified Data.Map as M + +commandTests :: TestTree +commandTests = testGroup "command tests" [ + modifyFileProperties, + bufferWriteProperties, + readTests, + addTests + ] + +modifyFileProperties :: TestTree +modifyFileProperties = testGroup "modify file properties" [ + testProperty "genNewFileState f [] == f" $ \ccf -> let + res = runExcept $ genNewFileState (fileContents ccf) [] :: Either ConfCryptError (M.Map ConfCryptElement LineNumber) + in res == Right (fileContents ccf) + + ,testProperty "genNewFileState f [delete all in f] == []" $ \ccf -> let + contents = fileContents ccf + deletes = (,Remove) <$> M.keys contents + res = runExcept $ genNewFileState contents deletes + in either (const False) + (all isComment . M.keys) + res + + ,testProperty "genNewFileState [] additions == additions" $ \paramPairs -> let + schemata = SchemaLine . fst <$> paramPairs + params = (\p -> ParameterLine $ ParamLine (paramName p) (paramValue p)) . snd <$> paramPairs + edits = (,Add) <$> nub (schemata <> params) + res = runExcept $ genNewFileState M.empty edits + in null edits || either (const False) + (\m -> length edits == M.size m) -- rather weak check + res + + ] + +bufferWriteProperties :: TestTree +bufferWriteProperties = testGroup "Buffer write" [ + testProperty "parse (writerBuffer xs) == xs" $ \(ValidCCF ccf)-> let + fc = fileContents ccf + output = (<> "\n") . T.intercalate "\n" . execWriter $ writeFullContentsToBuffer True fc + parseRes = parseConfCrypt "" output + in either (const False) + (\ccf' -> fileContents ccf' == fc) + parseRes + ] + +readTests :: TestTree +readTests = testGroup "Read" [ + testCase "reading produces decrypted results" $ do + let testLines = parseConfCrypt "test file" testFile + res <- getReadResult testLines + case res of + Left e -> + assertFailure $ show e + Right lines -> + lines @=? ["Test : String" :: T.Text,"Test = Foobar", "Test2 : Int", "Test2 = 42"] + + ,testCase "reading an empty file is an empty file" $ do + let testLines = parseConfCrypt "empty test file" "# just a comment" + res <- getReadResult testLines + case res of + Left e -> + assertFailure $ show e + Right lines -> + lines @=? [] + + -- 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 + 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]) + + +addTests :: TestTree +addTests = testGroup "Add" [ + {- testCase "add x [] == [x]" $ do + probablyKP <- runExceptT $ unpackPrivateRSAKey dangerousTestKey + publicKey <- either (assertFailure . show) (pure . project ) probablyKP :: IO RSA.PublicKey + let dummyAdd = AddConfCrypt {aName= "Test", aValue = "Foo", aType = CString} + res <- runResourceT . runExceptT . execWriterT $ runReaderT (evaluate dummyAdd) (emptyConfCryptFile, TextKey publicKey) :: IO ( Either ConfCryptError [T.Text] ) + case res of + Left e -> + assertFailure $ show e + Right lines -> + lines @=? ["Test : String" :: T.Text,"Test = y7wDxwsamscCOlqEcR0MgatspFf0NG0Wv32flD8cyh80tkN30g1iLlobxJhf/qfgm8ISRgtSSsxEsh5ujg7DS8d5oMhoFZcZnK0QuRcBDuoG8gRNiF1LHh4hhUJWksqdd8HNmuNHr45a97Alezj8GF8abTs3RoVCTV46PYmSP0avd0Oudfjn9iTF2C/q+S74fH64TSDKmgWrrexGpA07Yc8vjMW1MuFoS3NpONsuYwUr2pSCuvWCdfbs2ZfGqGG3CY0E/lfTJTOnw7J5HKelRuvE54Ey32bLLiSRd6Ot+O2WJLBGi0I0rkn0ZP3l9vP/URu9Wft4j3a/yLOeAM/NUmI/1SQrXjq8a1sTZGcC2+H4RfyLuV1sFPjTZ6zr/gWCasLgSRyRpvlX98H5GlPrjLPfHp493C2CiHljrSxXE8zvJO5/MXwenVqWShq7PXFGZs8NnwLMl6moXYGFJGooLKvslgSwNYX1BB15BJBhMbDIQoplTNhZUXgMhwJau5DBtWpt0x235vCRBK94Ryba8KLzWnIUKydSbdNGqNc0oaPhXOdGqSIex4PDwhepQ8c8+r/cyKBQDoGLS09q2Vx3ZPIAJYrsEreOH0PFRUIdkumBEXR9GdDot5MG0OmM29nHbuh86rDauXl2oXK/GWoqAq7yKNYAY/+JdpRhsDXP7lE="] + -} + testCase "add x [x] == Error case" $ do + probablyKP <- runExceptT $ unpackPrivateRSAKey dangerousTestKey + publicKey <- either (assertFailure . show) (pure . project ) probablyKP :: IO RSA.PublicKey + let dummyAdd = AddConfCrypt {aName= "Test", aValue = "Foo", aType = CString} + ccf = ConfCryptFile "containsX" + (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]) + case res of + Left (WrongFileAction _) -> assertBool "hmm" True + _ -> assertFailure "Expected a WrongFileAction error" + + {-,testCase "add x [y] == [y,x] (ordering matters)" $ do + probablyKP <- runExceptT $ unpackPrivateRSAKey dangerousTestKey + publicKey <- either (assertFailure . show) (pure . project ) probablyKP :: IO RSA.PublicKey + let dummyAdd = AddConfCrypt {aName= "Test", aValue = "Foo", aType = CString} + ccf = ConfCryptFile "containsY" + (M.fromList [(SchemaLine Schema {sName= "Fizz", sType = CString},LineNumber 1), + (ParameterLine ParamLine {pName ="Fizz", pValue="Foo"},LineNumber 2)]) + [Parameter "Test" "Fizz" (Just CString)] + res <- runResourceT . runExceptT . execWriterT $ runReaderT (evaluate dummyAdd) (ccf, TextKey publicKey) :: IO (Either ConfCryptError [T.Text]) + case res of + Left e -> + assertFailure $ show e + Right lines -> + lines @=? ["Fizz : String", "Fizz = Foo","Test : String" :: T.Text,"Test = y7wDxwsamscCOlqEcR0MgatspFf0NG0Wv32flD8cyh80tkN30g1iLlobxJhf/qfgm8ISRgtSSsxEsh5ujg7DS8d5oMhoFZcZnK0QuRcBDuoG8gRNiF1LHh4hhUJWksqdd8HNmuNHr45a97Alezj8GF8abTs3RoVCTV46PYmSP0avd0Oudfjn9iTF2C/q+S74fH64TSDKmgWrrexGpA07Yc8vjMW1MuFoS3NpONsuYwUr2pSCuvWCdfbs2ZfGqGG3CY0E/lfTJTOnw7J5HKelRuvE54Ey32bLLiSRd6Ot+O2WJLBGi0I0rkn0ZP3l9vP/URu9Wft4j3a/yLOeAM/NUmI/1SQrXjq8a1sTZGcC2+H4RfyLuV1sFPjTZ6zr/gWCasLgSRyRpvlX98H5GlPrjLPfHp493C2CiHljrSxXE8zvJO5/MXwenVqWShq7PXFGZs8NnwLMl6moXYGFJGooLKvslgSwNYX1BB15BJBhMbDIQoplTNhZUXgMhwJau5DBtWpt0x235vCRBK94Ryba8KLzWnIUKydSbdNGqNc0oaPhXOdGqSIex4PDwhepQ8c8+r/cyKBQDoGLS09q2Vx3ZPIAJYrsEreOH0PFRUIdkumBEXR9GdDot5MG0OmM29nHbuh86rDauXl2oXK/GWoqAq7yKNYAY/+JdpRhsDXP7lE="] + -} + + ] + +isComment (CommentLine _) = True +isComment _ = False + +testFile :: T.Text +testFile = "Test : String\n\ + \Test = Ld5RCo+QrF8ts8dRVJOEuHjwS8zU/K21qR0Oy/SaS4FTEmpr42jzesaaVEprYTIqRkGi0QrS9oEHlYRHU377KWVs0N/Oh65BaUT8XSEOi+XK2eyLHjYZOj/3ARbpxgCWsK5VXN5KZHPY2guYLrotDFgF87qQEPfAI9E06R3sNKlgPrbXnfhwVe+SqAj2/1m/TVf2MjAY+ar9sb2sX8Zt072LGH/uUXFqdkc4nGjx0TDDnnNWIh4TnYNNpnPB0uQKg1EfJD5C5uwBO13BdCDP9v5GNaeAoRBs0bJpiM8X5q2VJaiBC73abs8txw+MW6ASJkHDUyi/RLf0TWEPqTzK5/BSCHZDeiA6RFQEhrL1yGZ4Uc0QA6C6H/n6W0DcimMS5tk088XSPLpi1onaL0ZR3WsMV0zwxXpAmnr/h4tr9komxSOBmLgX1mAdshGfQmPQMmVBL2eY4ohconSoP2r4mWuHBWD5AmgHwhnndSSborNdUkgFxKm5++44nHIoXCgoMfgW4rJBD9f2OZcJb/hUradf2iIWhwUnnPPpMvzFGYjWhyjkiI73luv31i3VtUcamA0aU3U3IGjc5+yuNM85olFIAgdA2lOWAgNOsfrzDTjeJ+xB7fyvb//ViQzyKSDrqm53hfeF4DxLwhxNM608eVlA+UzLqYZUirq5xpuJgFQ=\n\ + \Test2 : Int\n\ + \Test2 = ADRg4daslh0ZDXVrHpSn1AQwReck2UKzjei+Zn34VzbqlvBI4rq9DzYDyWYiOpl+4lP6J6sHT+IbV/ObMC4Z6qELmIDergo/OuoZEEIfn1HWMSHwbxajzPjGvjWehCf0I8lO2+9QXhDvi3kF24ehWRaIIvcQaCV7ALPfucqjgAoxZ7l01RUTiMdy5mpkExWsADMzU5WLbuQJ80SCxJHPNtjLdy2ajwVVmC6WhVZWPH5lGjp6W9XLbyod2u8uYj2Y12VctjuECZxctqEsZbT9kJU/Wh+nDEQmOedQLEIWK7+U7wU6kE0bQhQqNXnh+958dkSMkzh+4lUjg5EW1ykLXalm+sulf7j4NkLCjsR3oARlUO02JvHriZbfGSdOPm1T6TC2J7IAQwDCQQWv/ls/y9wsKUTemAx/jO+I1iObJ+jsXrMTZVCczFbcC2bBwI8PLn9cVtQEAh7ZToel111r10aoD4yLbizgvrE18sL2Kj+dKjPxVEafGatLz//wb5gK/Pn1VVW02nv9AWLAeN21ymV1VKWsyj+P2JQjd/jiWS9WuEGhuWL3HtvZIqTjsng4HFdORSvx05oU6slYdhQ2f+w/1/1F5I0pefmOoTr8yVl3kcmmCxgyWjQlFjRa4/nbwJvW+hu8Br+p1YJn6rq5kQhUlOxp/NJ+S0ui+M2mwLE=\n" diff --git a/test/ConfCrypt/Common.hs b/test/ConfCrypt/Common.hs new file mode 100644 --- /dev/null +++ b/test/ConfCrypt/Common.hs @@ -0,0 +1,166 @@ +module ConfCrypt.Common where + +import ConfCrypt.Types + +import Control.Arrow +import Control.Monad.Identity (Identity) +import Data.Char (isAlphaNum, isPrint, isSpace, isAscii, isLatin1) +import Data.List (nub) +import Data.ByteArray (pack) +import qualified Data.Map as M +import qualified Data.Text as T +import qualified Data.ByteString as BS +import Crypto.Random (withDRG, drgNewSeed, seedFromInteger, MonadRandom(..)) +import Test.QuickCheck + +instance Arbitrary Parameter where + arbitrary = + Parameter <$> arbitrary <*> arbitrary <*> arbitrary + +instance Arbitrary Schema where + arbitrary = + Schema <$> arbitrary <*> arbitrary + +instance Arbitrary SchemaType where + arbitrary = elements [CString, CInt, CBoolean] + +instance {-# OVERLAPPING #-} Arbitrary (Schema, Parameter) where + arbitrary = do + schema <- arbitrary + value <- arbitrary + pure (schema, Parameter {paramName = sName schema, + paramValue = value, + paramType = Just $ sType schema} + ) + +instance Arbitrary ConfCryptFile where + arbitrary = do + fName <- arbitrary + sp <- arbitrary + comments <- commentLineGen + extraParams <- arbitrary + let extraParams' = ParameterLine . fst . parameterToLines <$> extraParams + initialLines = comments <> extraParams' + lines = second LineNumber <$> zip (foldr linearize initialLines sp) [1..] + params = snd <$> sp + pure ConfCryptFile { + fileName = fName, + fileContents = M.fromList lines, + parameters = params<>extraParams + } + where + linearize (s,p) acc = SchemaLine s : toPl p : acc + +newtype ValidCCF = ValidCCF ConfCryptFile deriving Show +newtype ValidSchema = ValidSchema Schema + +instance Arbitrary ValidSchema where + arbitrary = + fmap ValidSchema $ Schema <$> arbitrary `suchThat` validIdentifier <*> arbitrary + +instance {-# OVERLAPPING #-} Arbitrary (ValidSchema, Parameter) where + arbitrary = do + (ValidSchema s) <- arbitrary + value <- arbitrary `suchThat` printableNonEmpty + pure (ValidSchema s, Parameter {paramName = sName s, + paramValue = value, + paramType = Just $ sType s} + ) + +commentLineGen = fmap CommentLine <$> arbitrary `suchThat` all printableNonEmpty + +printableNonEmpty :: T.Text -> Bool +printableNonEmpty line = + ((> 0) $ T.length line) && all isPrint (T.unpack line) && not (all isSpace $ T.unpack line) + +instance Arbitrary ValidCCF where + arbitrary = do + sp <- arbitrary + fName <- arbitrary + comments <- commentLineGen + let rawLines = nub $ foldr linearize comments sp + lines = second LineNumber <$> zip rawLines [1..] + params = snd <$> sp + pure . ValidCCF $ ConfCryptFile { + fileName = fName, + fileContents = M.fromList lines, + parameters = params + } + where + linearize (ValidSchema s,p) acc = SchemaLine s : toPl p : acc + +validIdentifier :: T.Text -> Bool +validIdentifier t = let + properChars = all (\c -> c == '_' || (isAscii c && isAlphaNum c)) $ T.unpack t + nonEmpty = T.length t > 0 + in nonEmpty && properChars + +toPl p = ParameterLine $ ParamLine {pName = paramName p, pValue = paramValue p} + +instance Arbitrary ConfCryptElement where + arbitrary = oneof [CommentLine <$> arbitrary, SchemaLine <$> arbitrary, toPl <$> arbitrary] + +instance Arbitrary T.Text where + arbitrary = T.pack <$> arbitrary + +newtype Latin1Text = Latin1Text T.Text deriving Show +instance Arbitrary Latin1Text where + arbitrary = Latin1Text <$> arbitrary `suchThat` (all isLatin1 . T.unpack) + +-- This is a key for testing only. Please, please don't be stupid enough to ever use this to +-- actually encrypt something in the real world. +dangerousTestKey :: BS.ByteString +dangerousTestKey = "-----BEGIN RSA PRIVATE KEY-----\n\ +\MIIJKAIBAAKCAgEA1AneDC0yM7Dh9mc5WTcFrx+9F5hoZVevTMkfmtChQZPBttM2\n\ +\oBmgi5dg5D9m7dCaQ5QrCflASooMA4BX9gl6vCXP1f3lZONy1ATKrTMBulWIx0PA\n\ +\XlzJ5cbzReibW4xh5QdpEUl3kXdEP1aN0CMpSixSjSkr2PJ0Ev38QVsZ7LBZIXI5\n\ +\fUG4LKmkQntAPlnRIO39Zaub6mVDQ6CKaudT20zV1Vifyn75BUertjKsYoKBE+dM\n\ +\tBycauprdHabjz9H53Y07GyXhx9mFu8Mb9YDuvfYkvUtFYTZYyodPjNXaQIqbrjy\n\ +\VEvuW1Qz5N6+OW1imotaiorN3ir5YFGo8ICzTjL3yg154GEuzUav4SHhihoohfQJ\n\ +\3jMcUpW8vZykvIO1BOZzvbkuB4INIY53YpLCear+kk6LGF4y9sRsciVeJ8O6xdeY\n\ +\Zt2cZoYsZ00IbsV5o+K/DAiMQt6BLJpY/9vFQYu6Liq9L+e0nxYeAV/SqA0TA7Zg\n\ +\EWX8fqUhyW2iuE1UHy+VoHXZTcG3jK86j/yPw5a8O2gUCvZEtl3A93ZCEwwaizWf\n\ +\PNQo1ORsjL4lKZShXTnRz0aqsf7VWlFVREUFBsxsUGQoyTiyZ9Ty/LiW4IEtMdpN\n\ +\evaLz1RRMvf2I3n+ECsaOBz9NqSFj/JNKAtv3AlIt68Q6lGSlaz0ys4kAf0CAwEA\n\ +\AQKCAgAil8mGKwl5rW3wCT8t8vAWdhMfelntzrRmzpk9ZLQqQrTj4umSjRvIKlZA\n\ +\ZqegPNwuEkpDQkre3k6/c3zmQv2nHHQf8WAvaXweYvm98AhkIfhCqicEPhciSab+\n\ +\zMgr02dVOjRGAbpkHRUhUDmqr1HZLAn7xa/FoSiWwKEa+IXuO4cPEdeXO9WUU8jc\n\ +\n8cHZRfdS3Z/09OIFiU3L0Xl0v+3U32/ZMoM+1IdLmgxPWsqVyg/2wiEifZq6vvE\n\ +\8GTIpgZRGNPhjoXaIaFCNJXO2ReatTy8HQvR6u6cYw6KS04Db7sEfV/rqMemVsJw\n\ +\oHZgYBwqInoPCD419MTile/97MFTwK8Q8HiyxXCwQ4vfg7vLZnijxTT717oF8URq\n\ +\P+unhr8bm9UdSoOujm9JSpwTBR4A8tPAcrwUTN1x0IrLvx6M/KCNdi/NdU8OfoCW\n\ +\hFfcCf+00+lv0yAKElFiGzKirOKggJWJTticCFYv7aNkAfnsszuBipI1oiZ0t6Oc\n\ +\2+jiI6TaG5FR1i1ibL0cP/iO91V0uGABa9lxBWqWqpMeNe6pER6JyJgTDUAoVIbV\n\ +\c10VAzVmWZGXyDKcTKjRIo1UjNIhQYwbOQw5TIibzKYLFwFZn3o+eeuElEcoCaf2\n\ +\UGCWZrwZ+O0KULlFK9Evj7+GqlewErd0DNmSqubnK2MfWwmVgQKCAQEA6nTTJHTT\n\ +\z5dZ7Ky56/bGxeUbpkc5JEPBfcHjAMrHxaUU5IvugcRplL0P7I2iuLhbBk2OpTjT\n\ +\FG5ymK0KZgi9XmVY4Ih2WgYvjCSUa8f8sE4YQDltG/jtvSvl1ASHDCtI4Uh1KMiY\n\ +\N20NHd3pO0NC9yP83xW1VK3btjr2B9u1jBw/QtOF2Qn+kF5AUxGnyhFEWStdYLW9\n\ +\RM4IV/BthHAPhZDSaeAmdArMoCeW5UJwtYWDdHpJ7Qf4isue0WOqlKeSH20vamAQ\n\ +\bTmHJ+foGBcW99oBZoJ9UKIGtzt0dvFFmcY7nRLSGUohZhGSp+kiieTwHELX1id9\n\ +\ZStlSccdV4EjWQKCAQEA54Wz+e6oDVe4luudmEq/caogIa/ZJCiXuA4dpDvZS0OA\n\ +\pjve7pol35K7rdoZd16Kp6TF1B57FvdnMzQMnzHhpv8uKyHbg2IF/+UIrof6g5oY\n\ +\VXdz6Kbv8B58AqYe/N7k9J5/ufv+bgwvVARK9x4grSdSjB1v+sxptPONNS3SR/6P\n\ +\j8bb5MDt1ke/jGjolTm7Jnei2EaH80THwfcFRkVZDkHSrNz6F0DbC7AVHLpMESPb\n\ +\tgUHRUZKwfhayN0H3yI39rV2FwIIjiHP+z7N03CLXDgidzFoV/Xwb39JRS/+W+Vy\n\ +\8B+lqTRUno1iTunzEq1wCM7uNLgEtiiBEZ8BsQjzRQKCAQEAtmESLfXDHmS5yuXB\n\ +\6tAYZ7CFBZ+5z3/1cAH2t5MGO7Tiv7YqXj+PcehwDq9OuSqPhCOoptXBPM99zU4u\n\ +\HJkH1fo4XNFKX1UYf4ek/QKgifT14F/LhErrhJA1Q+wRsWGqW7SljogcAGGQJn+N\n\ +\AlCcMuuHtXGJkMl9dBABerNqUgdXHoC0SdUAdQUcPIIrZ4BvDn4xMR2ukWtECkQ4\n\ +\rSEOsfOp+jonL3WHH74sH0LDsjCdxWmrP/tHV5B1hqRk+SYxAMlKbRE1NgHeJSi8\n\ +\3qB3eW3YUQmIucSQPNC/FBcy8R/HF7SgQpPrzx40WvF7sJCqRxGoHCqz3JMZQ37k\n\ +\UEFgYQKCAQAJm+L8XItdAmcG3ICN8YxAi28J9uJsPcMOQIe6aUF7fjG4tINsI7mu\n\ +\rchcTtD/w0y96HjNdPZm3Z3K4j4j3U4gQDcKUz1pFohpNnhFxh7/l0WrRmnpHgSX\n\ +\UqyS75IZrKaUAIAMmAjXSGoucn8qAnYYuakTZ6VeI12/xNv3eQ9hLY+HyBkYRWmZ\n\ +\myC4EyKUDvFVh2Ga2FKMJi6kPjxZzkcD8Hdt9T3r+SUeNxCpQJIno/VaeJr0pRY1\n\ +\NrmN3J6XBDSOaLmd+tegDoczRkgEnocqLKpBiCtseyifeAjydit4ZO2ASc/2VdWt\n\ +\PvD1lYAhJlGgC/aW+Yw4gzXYJWFMl7KBAoIBAGYEBt5wwklJXCRZzDbdpKs2oyfV\n\ +\OFyOePfF7cTpTF7JSxylarw1AzKR377Bq3jfwSWIJjbqDZ5CgHnFZiz9+Kilud0j\n\ +\angYLtmYUTw8wxdhkBi0Y12ab6+7NM1qPJwR38oC7oI59Kre7vfEcS5HmYPf869O\n\ +\JzKP3nlIwvmqGRwfW8dY5ZufiO/8UmFRYHgNkQRrpud1l1ZQ7uaV7rKQ6pYn0bSm\n\ +\q7RzVeUyT1tX9nhtG0qewfJwG+uiJegpFHiR8h/0Q1UeKDoPF5h7cEHHpEdIK6Jk\n\ +\EDnXHO70xbl3lTjZEMcGbEucW3dtciTnPpXGru/pu6EVBVETiyqe/uxnmBQ=\n\ +\-----END RSA PRIVATE KEY-----" + +instance MonadRandom Identity where + getRandomBytes n = pure . pack . BS.unpack $ BS.replicate n 42 diff --git a/test/ConfCrypt/Encryption/Tests.hs b/test/ConfCrypt/Encryption/Tests.hs new file mode 100644 --- /dev/null +++ b/test/ConfCrypt/Encryption/Tests.hs @@ -0,0 +1,49 @@ +module ConfCrypt.Encryption.Tests ( + encryptionTests + ) where + +import ConfCrypt.Types +import ConfCrypt.Encryption + +import ConfCrypt.Common + +import Control.Monad.Except (runExcept, runExceptT) +import Data.Monoid ((<>)) +import Data.List (sort, nub) +import Test.Tasty +import Test.Tasty.QuickCheck +import Test.Tasty.HUnit +import Test.QuickCheck (NonEmptyList(..), ioProperty) +import qualified Crypto.PubKey.RSA.Types as RSA +import Crypto.Types.PubKey.RSA +import Crypto.Random +import qualified Data.Text as T +import qualified Data.ByteString as BS + + +encryptionTests :: TestTree +encryptionTests = testGroup "encryption" [ + testProperty "decrypt . encrypt == id" $ \(Latin1Text value) -> let + drg = drgNewSeed $ seedFromInteger 42 + in case runExcept (unpackPrivateRSAKey dangerousTestKey) of + Left err -> ioProperty $ pure False + Right keyPair -> ioProperty $ do + rawEncrypted <- runExceptT $ encryptValue (project keyPair :: RSA.PublicKey) value + encrypted <- either (error "fail to encrypt") pure rawEncrypted + decrypted <- pure . runExcept $ decryptValue (TextKey $ project keyPair :: TextKey RSA.PrivateKey) encrypted + pure $ either (const False) + (== value) + decrypted + + ,testCase "can encrypt and decrypt the term Foobar" $ + case runExcept (unpackPrivateRSAKey dangerousTestKey) of + Left err -> assertFailure "Could not unpack RSA Key" + Right keyPair -> do + rawEncrypted <- runExceptT $ encryptValue (project keyPair :: RSA.PublicKey) "Foobar" + encrypted <- either (const $ assertFailure "Could not enrypt") pure rawEncrypted + let decrypted = runExcept $ decryptValue (TextKey $ project keyPair :: TextKey RSA.PrivateKey) encrypted + either (const (assertFailure "Could not decrypt")) + (@=? "Foobar") + decrypted + + ] diff --git a/test/ConfCrypt/Parser/Tests.hs b/test/ConfCrypt/Parser/Tests.hs new file mode 100644 --- /dev/null +++ b/test/ConfCrypt/Parser/Tests.hs @@ -0,0 +1,117 @@ +module ConfCrypt.Parser.Tests ( + parserTests + ) where + +import ConfCrypt.Types +import ConfCrypt.Parser (parseConfCrypt) + +import Data.Either (isRight) +import qualified Data.Text as T +import qualified Data.Map as M +import Test.Tasty +import Test.Tasty.QuickCheck +import Test.Tasty.HUnit + + +parserTests :: TestTree +parserTests = testGroup "config file parser" [ + properties, + explicitFiles + ] +properties :: TestTree +properties = testGroup "parser properties" [ + ] + +explicitFiles :: TestTree +explicitFiles = testGroup "specific test files" [ + testCase "default config" $ do + let res = parseConfCrypt "default config" defaultConf + isRight res @=? True + + ,testCase "empty config" $ do + let res = parseConfCrypt "empty conf" "" + isRight res @=? True + + ,testCase "all comments" $ do + let res = parseConfCrypt "all comments" allComments + isRight res @=? True + + ,testCase "multiple line breaks" $ do + let res = parseConfCrypt "line breaks" multipleLineBreaks + isRight res @=? True + + ,testCase "requires a trailing newline" $ do + let Right res = parseConfCrypt "No newline" "# {" + Right res' = parseConfCrypt "No newline" "# {\n" + M.size (fileContents res) @=? 0 + M.size (fileContents res') @=? 1 + + ,testCase "Can parse simple param schema pair" $ do + let simplePair = "T : INT\n\ + \T = D\n\ + \Y : INT\n\ + \Y = l\499890\n" + Right res = parseConfCrypt "simple pairs" simplePair + M.size (fileContents res) @=? 4 + length (parameters res) @=? 2 + + ,testCase "Types are case insensitive" $ do + let simplePair = "T : InT\n\ + \T = D\n\ + \Y : int\n\ + \Y = l\499890\n" + Right res = parseConfCrypt "simple pairs" simplePair + M.size (fileContents res) @=? 4 + length (parameters res) @=? 2 + + ,testCase "Wrapped parameters are parsed" $ do + let res = parseConfCrypt "wrapped" wrappedParameter + param <- either (const $ assertFailure "Could not parse a wrapped parameter") + (pure . head . parameters) + res + paramValue param @=? "foobar" + ] + + + +defaultConf :: T.Text +defaultConf = "# confcrypt schema#more things\n\ + \# Configuration parameters may be either a String, Int, or Boolean\n\ + \# Parameter schema take the following shape:\n\ + \# schema := [term | value | comment]\n\ + \# term := confname : type\n\ + \# confname := [a-z,A-Z,_,0-9]\n\ + \# type := String | Int | Boolean\n\ + \# value := confname = String\n\ + \# comment := # String\n\ + + \# For example:\n\ + \DB_CONN_STR : String\n\ + \DB_CONN_STR = Connection String\n\ + \ USE_SSL : Boolean\n\ + \ USE_SSL = True\n\ + \ TIMEOUT_MS : Int\n\ + \ TIMEOUT_MS = 300" + +allComments :: T.Text +allComments = "# Configuration parameters may be either a String, Int, or Boolean\n\ + \# Parameter schema take the following shape:\n\ + \# schema := [term | value | comment]\n\ + \# term := confname : type\n\ + \# confname := [a-z,A-Z,_,0-9]\n\ + \# type := String | Int | Boolean\n\ + \# value := confname = String\n\ + \# comment := # String\n" + +multipleLineBreaks :: T.Text +multipleLineBreaks = "# For example:\n\n\n\ + \DB_CONN_STR : String\n\n\ + \DB_CONN_STR = Connection String\n\ + \ USE_SSL : Boolean\n\n\n\n\ + \ USE_SSL = True\n\n\ + \ TIMEOUT_MS : Int\n\ + \ TIMEOUT_MS = 300" + +wrappedParameter:: T.Text +wrappedParameter = "Test : String\n\ + \Test = BEGINfoobarEND\n" diff --git a/test/Tests.hs b/test/Tests.hs new file mode 100644 --- /dev/null +++ b/test/Tests.hs @@ -0,0 +1,23 @@ +import ConfCrypt.Parser.Tests (parserTests) +import ConfCrypt.Commands.Tests (commandTests) +import ConfCrypt.Encryption.Tests (encryptionTests) +import ConfCrypt.CLI.API.Tests (cliAPITests) +import Test.Tasty (TestTree, defaultMain, testGroup) + +main :: IO () +main = defaultMain $ testGroup "all tests" [ + appTests, + libraryTests + ] + +appTests :: TestTree +appTests = testGroup "all application tests" [ + cliAPITests + ] + +libraryTests :: TestTree +libraryTests = testGroup "all library tests"[ + parserTests, + commandTests, + encryptionTests + ]