packages feed

bloodhound-1.0.0.0: src/Database/Bloodhound/Internal/Utils/Secret.hs

{-# LANGUAGE GeneralisedNewtypeDeriving #-}

-- |
-- Module      : Database.Bloodhound.Internal.Utils.Secret
-- Description : 'Show'-redacting newtypes for secret-bearing fields
--
-- Elasticsearch request and response types routinely carry plaintext
-- credentials: API keys, passwords, OAuth2 tokens, SAML assertions,
-- cloud-provider secret keys, and the like. A stock @deriving stock
-- (Eq, Show)@ leaks these to anyone reading debug output, test diffs,
-- exception rendering, or log lines.
--
-- 'SecretText' and 'SecretValue' wrap the leaf field types so that
-- 'show' always renders @"***"@ regardless of the payload. 'Eq',
-- 'Ord', 'ToJSON', 'FromJSON', and 'IsString' derive through the
-- newtype, so:
--
-- * Wire JSON is byte-identical to the unwrapped @Text@ \/ @Value@ —
--   the wrapper is invisible on the network.
-- * Equality comparison still works (returns 'Bool'; never reveals
--   the value).
-- * Tests using @OverloadedStrings@ literals (@Just \"sk-xxx\"@) keep
--   compiling — the literal coerces to 'SecretText' via 'IsString'.
--
-- The intended use is to replace @Text@ (or @Maybe Text@) on any
-- field whose value is a credential. This makes the redaction
-- compiler-enforced: every construction site is forced to wrap the
-- value, and no @show@-rendered debug path can leak it.
module Database.Bloodhound.Internal.Utils.Secret
  ( SecretText (..),
    SecretValue (..),
  )
where

import Data.Aeson
import Data.String (IsString)
import Data.Text (Text)
import Database.Bloodhound.Internal.Utils.Imports (Hashable)

-- | A 'Text' whose 'Show' instance always renders @"***"@. Use for
-- API keys, passwords, access tokens, refresh tokens, SAML
-- assertions, and any other opaque credential string carried over
-- the wire.
--
-- @since 0.1
newtype SecretText = SecretText {unSecretText :: Text}
  deriving newtype
    ( Eq,
      Ord,
      Hashable,
      Semigroup,
      Monoid,
      IsString,
      ToJSON,
      FromJSON,
      ToJSONKey,
      FromJSONKey
    )

-- | Always @"***"@ — never the underlying credential.
instance Show SecretText where
  show _ = "***"

-- | An aeson 'Value' whose 'Show' instance always renders @"***"@.
-- Use for opaque secret blobs whose shape is not statically known
-- (e.g. @CustomServiceSettings.secret_parameters@, where the caller
-- may pass arbitrary nested key\/value pairs containing credentials
-- for an arbitrary backend).
--
-- @since 0.1
newtype SecretValue = SecretValue {unSecretValue :: Value}
  deriving newtype (Eq, ToJSON, FromJSON)

-- | Always @"***"@ — never the underlying blob.
instance Show SecretValue where
  show _ = "***"