{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE OverloadedStrings #-}
module Instana.SDK.Internal.Secrets
( MatcherMode(..)
, SecretsMatcher(..)
, defaultSecretsMatcher
, isSecret
) where
import Data.Aeson (FromJSON, Value, (.:))
import qualified Data.Aeson as Aeson
import Data.Aeson.Types (Parser)
import qualified Data.Either as Either
import qualified Data.List as List
import qualified Data.Maybe as Maybe
import Data.Text (Text)
import qualified Data.Text as T
import GHC.Generics
import qualified Text.Regex.Base.RegexLike as RegexBase
import qualified Text.Regex.TDFA as Regex
import Text.Regex.TDFA.String (Regex)
import qualified Text.Regex.TDFA.String as RegexString
import Instana.SDK.Internal.Util ((|>))
data MatcherMode =
Equals
| EqualsIgnoreCase
| Contains
| ContainsIgnoreCase
| Regex
| None
deriving (MatcherMode -> MatcherMode -> Bool
(MatcherMode -> MatcherMode -> Bool)
-> (MatcherMode -> MatcherMode -> Bool) -> Eq MatcherMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MatcherMode -> MatcherMode -> Bool
$c/= :: MatcherMode -> MatcherMode -> Bool
== :: MatcherMode -> MatcherMode -> Bool
$c== :: MatcherMode -> MatcherMode -> Bool
Eq, Int -> MatcherMode -> ShowS
[MatcherMode] -> ShowS
MatcherMode -> String
(Int -> MatcherMode -> ShowS)
-> (MatcherMode -> String)
-> ([MatcherMode] -> ShowS)
-> Show MatcherMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MatcherMode] -> ShowS
$cshowList :: [MatcherMode] -> ShowS
show :: MatcherMode -> String
$cshow :: MatcherMode -> String
showsPrec :: Int -> MatcherMode -> ShowS
$cshowsPrec :: Int -> MatcherMode -> ShowS
Show, (forall x. MatcherMode -> Rep MatcherMode x)
-> (forall x. Rep MatcherMode x -> MatcherMode)
-> Generic MatcherMode
forall x. Rep MatcherMode x -> MatcherMode
forall x. MatcherMode -> Rep MatcherMode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MatcherMode x -> MatcherMode
$cfrom :: forall x. MatcherMode -> Rep MatcherMode x
Generic)
instance FromJSON MatcherMode where
parseJSON :: Value -> Parser MatcherMode
parseJSON :: Value -> Parser MatcherMode
parseJSON = String
-> (Text -> Parser MatcherMode) -> Value -> Parser MatcherMode
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText "secrets matcher mode string" ((Text -> Parser MatcherMode) -> Value -> Parser MatcherMode)
-> (Text -> Parser MatcherMode) -> Value -> Parser MatcherMode
forall a b. (a -> b) -> a -> b
$
\matcherModeText :: Text
matcherModeText ->
case Text
matcherModeText of
"equals-ignore-case" -> MatcherMode -> Parser MatcherMode
forall (m :: * -> *) a. Monad m => a -> m a
return MatcherMode
EqualsIgnoreCase
"equals" -> MatcherMode -> Parser MatcherMode
forall (m :: * -> *) a. Monad m => a -> m a
return MatcherMode
Equals
"contains-ignore-case" -> MatcherMode -> Parser MatcherMode
forall (m :: * -> *) a. Monad m => a -> m a
return MatcherMode
ContainsIgnoreCase
"contains" -> MatcherMode -> Parser MatcherMode
forall (m :: * -> *) a. Monad m => a -> m a
return MatcherMode
Contains
"regex" -> MatcherMode -> Parser MatcherMode
forall (m :: * -> *) a. Monad m => a -> m a
return MatcherMode
Regex
"none" -> MatcherMode -> Parser MatcherMode
forall (m :: * -> *) a. Monad m => a -> m a
return MatcherMode
None
_ ->
String -> Parser MatcherMode
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser MatcherMode) -> String -> Parser MatcherMode
forall a b. (a -> b) -> a -> b
$ "unknown secrets matcher mode: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Text -> String
T.unpack Text
matcherModeText)
data SecretsMatcher =
EqualsMatcher [Text]
| EqualsIgnoreCaseMatcher [Text]
| ContainsMatcher [Text]
| ContainsIgnoreCaseMatcher [Text]
| RegexMatcher [Regex]
| NoneMatcher
instance FromJSON SecretsMatcher where
parseJSON :: Value -> Parser SecretsMatcher
parseJSON = String
-> (Object -> Parser SecretsMatcher)
-> Value
-> Parser SecretsMatcher
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject "SecretsMatcher" ((Object -> Parser SecretsMatcher)
-> Value -> Parser SecretsMatcher)
-> (Object -> Parser SecretsMatcher)
-> Value
-> Parser SecretsMatcher
forall a b. (a -> b) -> a -> b
$ Object -> Parser SecretsMatcher
parseSecretsConfig
instance Eq SecretsMatcher where
(==) :: SecretsMatcher -> SecretsMatcher -> Bool
s1 :: SecretsMatcher
s1 == :: SecretsMatcher -> SecretsMatcher -> Bool
== s2 :: SecretsMatcher
s2 =
case (SecretsMatcher
s1, SecretsMatcher
s2) of
(RegexMatcher _, _) -> Bool
False
(_, RegexMatcher _) -> Bool
False
_ -> SecretsMatcher
s1 SecretsMatcher -> SecretsMatcher -> Bool
forall a. Eq a => a -> a -> Bool
== SecretsMatcher
s2
instance Show SecretsMatcher where
show :: SecretsMatcher -> String
show :: SecretsMatcher -> String
show s :: SecretsMatcher
s =
case SecretsMatcher
s of
RegexMatcher _ -> "RegexMatcher"
_ -> SecretsMatcher -> String
forall a. Show a => a -> String
show SecretsMatcher
s
parseSecretsConfig :: Aeson.Object -> Parser SecretsMatcher
parseSecretsConfig :: Object -> Parser SecretsMatcher
parseSecretsConfig object :: Object
object =
(Object
object Object -> Text -> Parser MatcherMode
forall a. FromJSON a => Object -> Text -> Parser a
.: "matcher") Parser MatcherMode
-> (MatcherMode -> Parser SecretsMatcher) -> Parser SecretsMatcher
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
(\matcherMode :: MatcherMode
matcherMode ->
(Object
object Object -> Text -> Parser [Text]
forall a. FromJSON a => Object -> Text -> Parser a
.: "list") Parser [Text]
-> ([Text] -> Parser SecretsMatcher) -> Parser SecretsMatcher
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MatcherMode -> [Text] -> Parser SecretsMatcher
postProcessList MatcherMode
matcherMode
)
where
postProcessList :: MatcherMode -> [Text] -> Parser SecretsMatcher
postProcessList :: MatcherMode -> [Text] -> Parser SecretsMatcher
postProcessList matcherMode :: MatcherMode
matcherMode secretsList :: [Text]
secretsList =
case MatcherMode
matcherMode of
Equals ->
SecretsMatcher -> Parser SecretsMatcher
forall (m :: * -> *) a. Monad m => a -> m a
return (SecretsMatcher -> Parser SecretsMatcher)
-> SecretsMatcher -> Parser SecretsMatcher
forall a b. (a -> b) -> a -> b
$ [Text] -> SecretsMatcher
EqualsMatcher [Text]
secretsList
EqualsIgnoreCase ->
SecretsMatcher -> Parser SecretsMatcher
forall (m :: * -> *) a. Monad m => a -> m a
return (SecretsMatcher -> Parser SecretsMatcher)
-> SecretsMatcher -> Parser SecretsMatcher
forall a b. (a -> b) -> a -> b
$ [Text] -> SecretsMatcher
EqualsIgnoreCaseMatcher ([Text] -> SecretsMatcher) -> [Text] -> SecretsMatcher
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
List.map Text -> Text
T.toLower [Text]
secretsList
Contains ->
SecretsMatcher -> Parser SecretsMatcher
forall (m :: * -> *) a. Monad m => a -> m a
return (SecretsMatcher -> Parser SecretsMatcher)
-> SecretsMatcher -> Parser SecretsMatcher
forall a b. (a -> b) -> a -> b
$ [Text] -> SecretsMatcher
ContainsMatcher [Text]
secretsList
ContainsIgnoreCase ->
SecretsMatcher -> Parser SecretsMatcher
forall (m :: * -> *) a. Monad m => a -> m a
return (SecretsMatcher -> Parser SecretsMatcher)
-> SecretsMatcher -> Parser SecretsMatcher
forall a b. (a -> b) -> a -> b
$ [Text] -> SecretsMatcher
ContainsIgnoreCaseMatcher ([Text] -> SecretsMatcher) -> [Text] -> SecretsMatcher
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
List.map Text -> Text
T.toLower [Text]
secretsList
Regex ->
SecretsMatcher -> Parser SecretsMatcher
forall (m :: * -> *) a. Monad m => a -> m a
return (SecretsMatcher -> Parser SecretsMatcher)
-> SecretsMatcher -> Parser SecretsMatcher
forall a b. (a -> b) -> a -> b
$ [Regex] -> SecretsMatcher
RegexMatcher ([Regex] -> SecretsMatcher) -> [Regex] -> SecretsMatcher
forall a b. (a -> b) -> a -> b
$
(Text -> Either String Regex) -> [Text] -> [Either String Regex]
forall a b. (a -> b) -> [a] -> [b]
List.map Text -> Either String Regex
preProcessRegexPattern [Text]
secretsList
[Either String Regex]
-> ([Either String Regex] -> [Regex]) -> [Regex]
forall a b. a -> (a -> b) -> b
|> [Either String Regex] -> [Regex]
forall a b. [Either a b] -> [b]
Either.rights
None ->
SecretsMatcher -> Parser SecretsMatcher
forall (m :: * -> *) a. Monad m => a -> m a
return (SecretsMatcher -> Parser SecretsMatcher)
-> SecretsMatcher -> Parser SecretsMatcher
forall a b. (a -> b) -> a -> b
$ SecretsMatcher
NoneMatcher
defaultSecretsMatcher :: SecretsMatcher
defaultSecretsMatcher :: SecretsMatcher
defaultSecretsMatcher =
[Text] -> SecretsMatcher
ContainsIgnoreCaseMatcher ["key", "pass", "secret"]
isSecret :: SecretsMatcher -> Text -> Bool
isSecret :: SecretsMatcher -> Text -> Bool
isSecret (EqualsMatcher secretsList :: [Text]
secretsList) potentialSecret :: Text
potentialSecret =
Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Text
potentialSecret [Text]
secretsList
isSecret (EqualsIgnoreCaseMatcher secretsList :: [Text]
secretsList) potentialSecret :: Text
potentialSecret =
Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Text -> Text
T.toLower Text
potentialSecret) [Text]
secretsList
isSecret (ContainsMatcher secretsList :: [Text]
secretsList) potentialSecret :: Text
potentialSecret =
(Text -> Bool) -> [Text] -> Maybe Text
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find ((Text -> Text -> Bool) -> Text -> Text -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Text -> Bool
T.isInfixOf Text
potentialSecret) [Text]
secretsList Maybe Text -> (Maybe Text -> Bool) -> Bool
forall a b. a -> (a -> b) -> b
|> Maybe Text -> Bool
forall a. Maybe a -> Bool
Maybe.isJust
isSecret (ContainsIgnoreCaseMatcher secretsList :: [Text]
secretsList) potentialSecret :: Text
potentialSecret =
let
potentialSecret' :: Text
potentialSecret' = Text -> Text
T.toLower Text
potentialSecret
in
(Text -> Bool) -> [Text] -> Maybe Text
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find ((Text -> Text -> Bool) -> Text -> Text -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Text -> Bool
T.isInfixOf Text
potentialSecret') [Text]
secretsList Maybe Text -> (Maybe Text -> Bool) -> Bool
forall a b. a -> (a -> b) -> b
|> Maybe Text -> Bool
forall a. Maybe a -> Bool
Maybe.isJust
isSecret (RegexMatcher patterns :: [Regex]
patterns) potentialSecret :: Text
potentialSecret =
let
potentialSecret' :: String
potentialSecret' = Text -> String
T.unpack Text
potentialSecret
in
(Regex -> Bool) -> [Regex] -> Maybe Regex
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find
(\pattern :: Regex
pattern -> Regex -> String -> Bool
forall regex source target.
RegexContext regex source target =>
regex -> source -> target
RegexBase.match Regex
pattern String
potentialSecret') [Regex]
patterns
Maybe Regex -> (Maybe Regex -> Bool) -> Bool
forall a b. a -> (a -> b) -> b
|> Maybe Regex -> Bool
forall a. Maybe a -> Bool
Maybe.isJust
isSecret (SecretsMatcher
NoneMatcher) _ =
Bool
False
preProcessRegexPattern :: Text -> Either String Regex
preProcessRegexPattern :: Text -> Either String Regex
preProcessRegexPattern pattern :: Text
pattern =
Text
pattern
Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
|> Text -> Text
prependCaret
Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
|> Text -> Text
appendDollar
Text -> (Text -> String) -> String
forall a b. a -> (a -> b) -> b
|> Text -> String
T.unpack
String -> (String -> Either String Regex) -> Either String Regex
forall a b. a -> (a -> b) -> b
|> CompOption -> ExecOption -> String -> Either String Regex
RegexString.compile
CompOption
forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
compOpt
Regex.defaultCompOpt
ExecOption
forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
execOpt
Regex.defaultExecOpt
prependCaret :: Text -> Text
prependCaret :: Text -> Text
prependCaret t :: Text
t =
if Text -> Bool
T.null Text
t then Text
t
else if (Text -> Char
T.head Text
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '^') then Text
t
else Char -> Text -> Text
T.cons '^' Text
t
appendDollar :: Text -> Text
appendDollar :: Text -> Text
appendDollar t :: Text
t =
if Text -> Bool
T.null Text
t then Text
t
else if (Text -> Char
T.last Text
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '$') then Text
t
else Text -> Char -> Text
T.snoc Text
t '$'