module ConfCrypt.Types (
ConfCryptM,
ConfCryptError(..),
ConfCryptFile(..),
Parameter(..),
ConfCryptElement(..),
LineNumber(..),
SchemaType(..),
ParamLine(..),
Schema(..),
LocalKey,
KMSKey,
unWrapSchema,
isParameter,
typeToOutputString,
parameterToLines
) where
import Conduit (ResourceT)
import Control.Monad.Reader (MonadReader, ReaderT, runReaderT)
import Control.Monad.Except (MonadError, ExceptT, runExceptT)
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
import Text.Megaparsec.Error (ShowErrorComponent, showErrorComponent)
type ConfCryptM m ctx =
ReaderT (ConfCryptFile, ctx) (
ExceptT ConfCryptError (
ResourceT m
)
)
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
| FormatParseError T.Text
deriving (Generic, Eq, Ord)
instance Show ConfCryptError where
show (ParserError msg) = "ParserError: "<> T.unpack msg
show NonRSAKey = "NonRSAKey"
show (KeyUnpackingError msg) = "KeyUnpackingError: "<> T.unpack msg
show (DecryptionError msg) = "DecryptionError: "<> T.unpack msg
show (AWSDecryptionError msg) = "AWSDecryptionError: "<> T.unpack msg
show (AWSEncryptionError msg) = "AWSEncryptionError: "<> T.unpack msg
show (EncryptionError err) = "EncryptionError: "<> show err
show (MissingLine msg) = "MissingLine: "<> T.unpack msg
show (UnknownParameter msg) = "UnknownParameter: "<> T.unpack msg
show (WrongFileAction msg) = "WrongFileAction: "<> T.unpack msg
show (CleanupError msg) = "CleanupError: "<> T.unpack msg
show (FormatParseError msg) = "Format parse error: "<> T.unpack msg
instance ShowErrorComponent ConfCryptError where
showErrorComponent (ParserError msg) = T.unpack msg
showErrorComponent _ = "Not a parsable error"
instance Ord RSA.Error where
(<=) l r = show l <= show r
data ConfCryptFile =
ConfCryptFile {
fileName :: T.Text,
fileContents :: M.Map ConfCryptElement LineNumber,
parameters :: [Parameter]
} deriving (Show, Generic, NFData)
data ConfCryptElement
= SchemaLine Schema
| CommentLine {cText ::T.Text}
| ParameterLine ParamLine
deriving (Show, Generic, NFData)
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
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
data Parameter = Parameter {paramName :: T.Text, paramValue :: T.Text, paramType :: Maybe SchemaType}
deriving (Eq, Ord, Show, Generic, NFData)
data ParamLine = ParamLine {pName :: T.Text, pValue :: T.Text}
deriving (Eq, Ord, Show, Generic, NFData)
data Schema = Schema {sName :: T.Text, sType :: SchemaType}
deriving (Eq, Ord, Show, Generic, NFData)
newtype LineNumber = LineNumber Int
deriving (Eq, Ord, Show, Generic, NFData)
data SchemaType
= CString
| CInt
| CBoolean
deriving (Eq, Ord, Show, Generic, NFData, Read)
typeToOutputString ::
SchemaType
-> T.Text
typeToOutputString CString = "String"
typeToOutputString CInt = "Int"
typeToOutputString CBoolean = "Boolean"
parameterToLines ::
Parameter
-> (ParamLine, Maybe Schema)
parameterToLines Parameter {paramName, paramValue, paramType} =
(ParamLine paramName paramValue, Schema paramName <$> paramType)
isParameter :: ConfCryptElement -> Bool
isParameter (ParameterLine _) = True
isParameter _ = False
unWrapSchema :: ConfCryptElement -> Maybe Schema
unWrapSchema (SchemaLine s) = Just s
unWrapSchema _ = Nothing
class LocalKey key
class KMSKey key