mmzk-env-0.6.0.0: test/ValidateEnvSpec.hs

module ValidateEnvSpec (spec) where

import Data.Char (toUpper)
import Data.Env
import Data.Env.ExtractFields
import Data.Env.RecordParserW
import Data.Map qualified as M
import GHC.Generics
import System.Environment
import Test.Hspec

--------------------------------------------------------------------------------
-- Test records
--------------------------------------------------------------------------------

-- ^ Plain record for 'validateEnv' tests.
data PlainConfig = PlainConfig
  { plainHost  :: String
  , plainPort  :: Int
  , plainDebug :: Maybe Bool
  }
  deriving (Show, Eq, Generic, EnvSchema)

-- ^ Schema record for 'validateEnvW' tests.
data SchemaConfig c = SchemaConfig
  { schemaHost :: Col c String
  , schemaPort :: Col c Int
  , schemaDebug :: Col c Bool
  }
  deriving (Generic)

deriving stock instance Show (SchemaConfig 'Res)
deriving stock instance Eq (SchemaConfig 'Res)

instance EnvSchemaW (SchemaConfig 'Dec)

--------------------------------------------------------------------------------
-- camelToUpperSnake unit tests
--------------------------------------------------------------------------------

specCamelToUpperSnake :: Spec
specCamelToUpperSnake = describe "camelToUpperSnake" do
  it "converts simple camelCase" do
    camelToUpperSnake "plainHost" `shouldBe` "PLAIN_HOST"
  it "converts single-word lowercase" do
    camelToUpperSnake "host" `shouldBe` "HOST"
  it "leaves consecutive uppercase together" do
    camelToUpperSnake "myHTTPClient" `shouldBe` "MY_HTTPCLIENT"
  it "handles digit before uppercase" do
    camelToUpperSnake "http2Client" `shouldBe` "HTTP2_CLIENT"
  it "passes through literal underscores" do
    camelToUpperSnake "my_host" `shouldBe` "MY_HOST"
  it "handles leading underscore" do
    camelToUpperSnake "_host" `shouldBe` "_HOST"
  it "handles single character" do
    camelToUpperSnake "x" `shouldBe` "X"

--------------------------------------------------------------------------------
-- validateEnv tests
--------------------------------------------------------------------------------

specValidateEnv :: Spec
specValidateEnv = describe "validateEnv" do
  it "reads valid env vars" do
    setEnv "PLAIN_HOST" "localhost"
    setEnv "PLAIN_PORT" "8080"
    setEnv "PLAIN_DEBUG" "True"
    result <- validateEnv @PlainConfig
    unsetEnv "PLAIN_HOST"
    unsetEnv "PLAIN_PORT"
    unsetEnv "PLAIN_DEBUG"
    result `shouldBe` Right (PlainConfig "localhost" 8080 (Just True))

  it "succeeds with missing optional field" do
    setEnv "PLAIN_HOST" "localhost"
    setEnv "PLAIN_PORT" "3000"
    unsetEnv "PLAIN_DEBUG"
    result <- validateEnv @PlainConfig
    unsetEnv "PLAIN_HOST"
    unsetEnv "PLAIN_PORT"
    result `shouldBe` Right (PlainConfig "localhost" 3000 Nothing)

  it "fails when required var is missing" do
    setEnv "PLAIN_HOST" "localhost"
    unsetEnv "PLAIN_PORT"
    unsetEnv "PLAIN_DEBUG"
    result <- validateEnv @PlainConfig
    unsetEnv "PLAIN_HOST"
    case result of
      Left (ParseError errs) -> length errs `shouldBe` 1
      Right _ -> expectationFailure "expected Left"

  it "fails on invalid port value" do
    setEnv "PLAIN_HOST" "localhost"
    setEnv "PLAIN_PORT" "not-a-number"
    unsetEnv "PLAIN_DEBUG"
    result <- validateEnv @PlainConfig
    unsetEnv "PLAIN_HOST"
    unsetEnv "PLAIN_PORT"
    case result of
      Left (ParseError errs) -> length errs `shouldBe` 1
      Right _ -> expectationFailure "expected Left"

  it "collects errors from multiple fields" do
    setEnv "PLAIN_HOST" ""
    setEnv "PLAIN_PORT" "bad"
    setEnv "PLAIN_DEBUG" "bad"
    result <- validateEnv @PlainConfig
    unsetEnv "PLAIN_HOST"
    unsetEnv "PLAIN_PORT"
    unsetEnv "PLAIN_DEBUG"
    case result of
      Left (ParseError errs) -> length errs `shouldBe` 3
      Right _ -> expectationFailure "expected Left"

--------------------------------------------------------------------------------
-- validateEnvWith tests
--------------------------------------------------------------------------------

specValidateEnvWith :: Spec
specValidateEnvWith = describe "validateEnvWith" do
  it "uses custom mapping toUpper" do
    setEnv "PLAINHOST" "example.com"
    setEnv "PLAINPORT" "443"
    unsetEnv "PLAINDDEBUG"
    result <- validateEnvWith @PlainConfig (map toUpper)
    unsetEnv "PLAINHOST"
    unsetEnv "PLAINPORT"
    result `shouldBe` Right (PlainConfig "example.com" 443 Nothing)

--------------------------------------------------------------------------------
-- validateEnvFromMap / validateEnvFromMapWith tests
--------------------------------------------------------------------------------

specValidateEnvFromMap :: Spec
specValidateEnvFromMap = describe "validateEnvFromMap" do
  it "reads valid values from a simulated environment, no real env vars touched" do
    let simulatedEnv = M.fromList
          [ ("PLAIN_HOST", "localhost")
          , ("PLAIN_PORT", "8080")
          , ("PLAIN_DEBUG", "True")
          ]
    validateEnvFromMap @PlainConfig simulatedEnv
      `shouldBe` Right (PlainConfig "localhost" 8080 (Just True))

  it "succeeds with missing optional field" do
    let simulatedEnv = M.fromList [("PLAIN_HOST", "localhost"), ("PLAIN_PORT", "3000")]
    validateEnvFromMap @PlainConfig simulatedEnv
      `shouldBe` Right (PlainConfig "localhost" 3000 Nothing)

  it "fails when required var is missing" do
    let simulatedEnv = M.fromList [("PLAIN_HOST", "localhost")]
    case validateEnvFromMap @PlainConfig simulatedEnv of
      Left (ParseError errs) -> length errs `shouldBe` 1
      Right _ -> expectationFailure "expected Left"

  it "collects errors from multiple fields" do
    let simulatedEnv = M.fromList
          [ ("PLAIN_HOST", "")
          , ("PLAIN_PORT", "bad")
          , ("PLAIN_DEBUG", "bad")
          ]
    case validateEnvFromMap @PlainConfig simulatedEnv of
      Left (ParseError errs) -> length errs `shouldBe` 3
      Right _ -> expectationFailure "expected Left"

  it "does not read from the real process environment" do
    setEnv "PLAIN_HOST" "real-host"
    let simulatedEnv = M.fromList [("PLAIN_HOST", "fake-host"), ("PLAIN_PORT", "1")]
    result <- pure $ validateEnvFromMap @PlainConfig simulatedEnv
    unsetEnv "PLAIN_HOST"
    result `shouldBe` Right (PlainConfig "fake-host" 1 Nothing)

specValidateEnvFromMapWith :: Spec
specValidateEnvFromMapWith = describe "validateEnvFromMapWith" do
  it "uses custom mapping toUpper" do
    let simulatedEnv = M.fromList [("PLAINHOST", "example.com"), ("PLAINPORT", "443")]
    validateEnvFromMapWith @PlainConfig (map toUpper) simulatedEnv
      `shouldBe` Right (PlainConfig "example.com" 443 Nothing)

--------------------------------------------------------------------------------
-- validateEnvW tests
--------------------------------------------------------------------------------

specValidateEnvW :: Spec
specValidateEnvW = describe "validateEnvW" do
  let schema :: SchemaConfig 'Dec
      schema = SchemaConfig
        { schemaHost = typeParser @String
        , schemaPort = typeParser @Int `orElse` 5432
        , schemaDebug = typeParser @Bool `orElse` False
        }

  it "reads valid env vars" do
    setEnv "SCHEMA_HOST" "localhost"
    setEnv "SCHEMA_PORT" "9090"
    setEnv "SCHEMA_DEBUG" "True"
    result <- validateEnvW schema
    unsetEnv "SCHEMA_HOST"
    unsetEnv "SCHEMA_PORT"
    unsetEnv "SCHEMA_DEBUG"
    result `shouldBe` Right (SchemaConfig "localhost" 9090 True)

  it "applies runtime defaults for missing vars" do
    setEnv "SCHEMA_HOST" "localhost"
    unsetEnv "SCHEMA_PORT"
    unsetEnv "SCHEMA_DEBUG"
    result <- validateEnvW schema
    unsetEnv "SCHEMA_HOST"
    result `shouldBe` Right (SchemaConfig "localhost" 5432 False)

  it "fails on invalid required field" do
    unsetEnv "SCHEMA_HOST"
    setEnv "SCHEMA_PORT" "8080"
    setEnv "SCHEMA_DEBUG" "True"
    result <- validateEnvW schema
    unsetEnv "SCHEMA_PORT"
    unsetEnv "SCHEMA_DEBUG"
    case result of
      Left (ParseError errs) -> length errs `shouldBe` 1
      Right _ -> expectationFailure "expected Left"

  it "orElse does not swallow parse errors" do
    setEnv "SCHEMA_HOST" "localhost"
    setEnv "SCHEMA_PORT" "bad"
    setEnv "SCHEMA_DEBUG" "True"
    result <- validateEnvW schema
    unsetEnv "SCHEMA_HOST"
    unsetEnv "SCHEMA_PORT"
    unsetEnv "SCHEMA_DEBUG"
    case result of
      Left (ParseError errs) -> length errs `shouldBe` 1
      Right _ -> expectationFailure "expected Left"

--------------------------------------------------------------------------------
-- validateEnvWFromMap / validateEnvWFromMapWith tests
--------------------------------------------------------------------------------

specValidateEnvWFromMap :: Spec
specValidateEnvWFromMap = describe "validateEnvWFromMap" do
  let schema :: SchemaConfig 'Dec
      schema = SchemaConfig
        { schemaHost = typeParser @String
        , schemaPort = typeParser @Int `orElse` 5432
        , schemaDebug = typeParser @Bool `orElse` False
        }

  it "reads valid values from a simulated environment" do
    let simulatedEnv = M.fromList
          [ ("SCHEMA_HOST", "localhost")
          , ("SCHEMA_PORT", "9090")
          , ("SCHEMA_DEBUG", "True")
          ]
    validateEnvWFromMap schema simulatedEnv `shouldBe` Right (SchemaConfig "localhost" 9090 True)

  it "applies runtime defaults for missing vars" do
    let simulatedEnv = M.fromList [("SCHEMA_HOST", "localhost")]
    validateEnvWFromMap schema simulatedEnv
      `shouldBe` Right (SchemaConfig "localhost" 5432 False)

  it "fails on invalid required field" do
    let simulatedEnv = M.fromList [("SCHEMA_PORT", "8080"), ("SCHEMA_DEBUG", "True")]
    case validateEnvWFromMap schema simulatedEnv of
      Left (ParseError errs) -> length errs `shouldBe` 1
      Right _ -> expectationFailure "expected Left"

specValidateEnvWFromMapWith :: Spec
specValidateEnvWFromMapWith = describe "validateEnvWFromMapWith" do
  it "uses custom mapping toUpper" do
    let schema :: SchemaConfig 'Dec
        schema = SchemaConfig
          { schemaHost = typeParser @String
          , schemaPort = typeParser @Int `orElse` 5432
          , schemaDebug = typeParser @Bool `orElse` False
          }
        simulatedEnv = M.fromList [("SCHEMAHOST", "example.com"), ("SCHEMAPORT", "443")]
    validateEnvWFromMapWith (map toUpper) schema simulatedEnv
      `shouldBe` Right (SchemaConfig "example.com" 443 False)

--------------------------------------------------------------------------------
-- validateEnvWDefault tests
--------------------------------------------------------------------------------

specValidateEnvWDefault :: Spec
specValidateEnvWDefault = describe "validateEnvWDefault" do
  it "auto-derives schema from TypeParser instances" do
    setEnv "SCHEMA_HOST" "auto"
    setEnv "SCHEMA_PORT" "7000"
    setEnv "SCHEMA_DEBUG" "True"
    result <- validateEnvWDefault @SchemaConfig
    unsetEnv "SCHEMA_HOST"
    unsetEnv "SCHEMA_PORT"
    unsetEnv "SCHEMA_DEBUG"
    result `shouldBe` Right (SchemaConfig "auto" 7000 True)

--------------------------------------------------------------------------------
-- validateEnvWDefaultFromMap tests
--------------------------------------------------------------------------------

specValidateEnvWDefaultFromMap :: Spec
specValidateEnvWDefaultFromMap = describe "validateEnvWDefaultFromMap" do
  it "auto-derives schema from TypeParser instances" do
    let simulatedEnv = M.fromList
          [ ("SCHEMA_HOST", "auto")
          , ("SCHEMA_PORT", "7000")
          , ("SCHEMA_DEBUG", "True")
          ]
    validateEnvWDefaultFromMap @SchemaConfig simulatedEnv
      `shouldBe` Right (SchemaConfig "auto" 7000 True)

--------------------------------------------------------------------------------
-- Top-level spec
--------------------------------------------------------------------------------

spec :: Spec
spec = do
  specCamelToUpperSnake
  specValidateEnv
  specValidateEnvWith
  specValidateEnvFromMap
  specValidateEnvFromMapWith
  specValidateEnvW
  specValidateEnvWFromMap
  specValidateEnvWFromMapWith
  specValidateEnvWDefault
  specValidateEnvWDefaultFromMap