{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE InstanceSigs      #-}
{-# LANGUAGE OverloadedStrings #-}
{-|
Module      : Instana.SDK.Internal.Secrets
Description : Secrets scrubbing
-}
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 ((|>))


-- |The available secret matcher modes.
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)


-- |Secrets matcher for each mode.
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


-- |The default matcher.
defaultSecretsMatcher :: SecretsMatcher
defaultSecretsMatcher :: SecretsMatcher
defaultSecretsMatcher =
  [Text] -> SecretsMatcher
ContainsIgnoreCaseMatcher ["key", "pass", "secret"]


-- |Returns true if and only if the given text matches the given matcher.
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 =
  -- The Java regex matcher only matches if the whole string is a match,
  -- Haskell regexes RegExp.test matches if the regex is found as a substring.
  -- To achieve parity with the Java functionality, we enclose the regex in
  -- '^' and '$'.
  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 '$'