SpecTest.hs

{-# LANGUAGE CPP                 #-}
{-# LANGUAGE NoImplicitPrelude   #-}
{-# LANGUAGE OverloadedLists     #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
module System.Etc.SpecTest (tests) where

import           RIO
import qualified RIO.HashMap as HashMap

import Test.Tasty       (TestTree, testGroup)
import Test.Tasty.HUnit (assertBool, assertEqual, assertFailure, testCase)

import qualified Data.Aeson as JSON

import System.Etc.Internal.Spec.Types
import System.Etc.Spec

#ifdef WITH_YAML
import qualified Data.Yaml as YAML
import           Paths_etc (getDataFileName)
#endif

getConfigValue :: [Text] -> HashMap Text (ConfigValue cmd) -> Maybe (ConfigValue cmd)
getConfigValue keys hsh =
  -- NOTE: For some reason, pattern matching doesn't work on lts-6, using
  -- if/else instead
                          if null keys
  then Nothing
  else do
    let (k : ks) = keys
    cv <- HashMap.lookup k hsh
    case cv of
      SubConfig hsh1 -> getConfigValue ks hsh1
      value          -> if null ks then Just value else Nothing


general_tests :: TestTree
general_tests = testGroup
  "general"
  [ testCase "does not fail when etc/entries is not defined" $ do
    let input = "{}"

    case parseConfigSpec input of
      Nothing -> assertFailure "should not fail if no etc/entries key is present"
      Just (_ :: ConfigSpec ()) -> assertBool "" True
  , testCase "entries cannot finish in an empty map" $ do
    let input = "{\"etc/entries\":{\"greeting\":{}}}"

    case parseConfigSpec input of
      Just (result :: ConfigSpec ()) ->
        assertFailure $ "entries should not accept empty maps as values " ++ show result
      Nothing -> assertBool "" True
  , testCase "entries cannot finish in an array" $ do
    let input = "{\"etc/entries\":{\"greeting\":[]}}"

    case parseConfigSpec input of
      Just (result :: ConfigSpec ()) ->
        assertFailure $ "entries should not accept arrays as values " ++ show result
      Nothing -> assertBool "" True
  , testCase "entries that finish with raw values sets them as default value" $ do
    let input = "{\"etc/entries\":{\"greeting\":123}}"
        keys  = ["greeting"]

    config <- parseConfigSpec input

    case getConfigValue keys (specConfigValues config) of
      Nothing -> assertFailure
        (show keys ++ " should map to a config value, got sub config map instead")
      Just (value :: ConfigValue ()) -> assertEqual "should contain default value"
                                                    (Just (JSON.Number 123))
                                                    (defaultValue value)
  , testCase "entries can have many levels of nesting" $ do
    let input = "{\"etc/entries\":{\"english\":{\"greeting\":\"hello\"}}}"
        keys  = ["english", "greeting"]

    config <- parseConfigSpec input

    case getConfigValue keys (specConfigValues config) of
      Nothing -> assertFailure
        (show keys ++ " should map to a config value, got sub config map instead")
      Just (value :: ConfigValue ()) -> assertEqual "should contain default value"
                                                    (Just (JSON.String "hello"))
                                                    (defaultValue value)
  , testCase "spec map cannot be empty object" $ do
    let input = "{\"etc/entries\":{\"greeting\":{\"etc/spec\":{}}}"

    case parseConfigSpec input of
      Just (result :: ConfigSpec ()) ->
        assertFailure $ "etc/spec map should not be an empty object " ++ show result
      Nothing -> assertBool "" True
  , testCase "spec map cannot be a JSON array" $ do
    let input = "{\"etc/entries\":{\"greeting\":{\"etc/spec\":[]}}"

    case parseConfigSpec input of
      Just (result :: ConfigSpec ()) ->
        assertFailure $ "etc/spec map should not be an array " ++ show result
      Nothing -> assertBool "" True
  , testCase "spec map cannot be a JSON bool" $ do
    let input = "{\"etc/entries\":{\"greeting\":{\"etc/spec\":true}}"

    case parseConfigSpec input of
      Just (result :: ConfigSpec ()) ->
        assertFailure $ "etc/spec map should not be a boolean " ++ show result
      Nothing -> assertBool "" True
  , testCase "spec map cannot be a JSON string" $ do
    let input = "{\"etc/entries\":{\"greeting\":{\"etc/spec\":\"hello\"}}}"

    case parseConfigSpec input of
      Just (result :: ConfigSpec ()) ->
        assertFailure $ "etc/spec map should not be a string " ++ show result
      Nothing -> assertBool "" True
  , testCase "spec map cannot be a JSON number" $ do
    let input = "{\"etc/entries\":{\"greeting\":{\"etc/spec\":123}}}"

    case parseConfigSpec input of
      Just (result :: ConfigSpec ()) ->
        assertFailure $ "etc/spec map should not be a number " ++ show result
      Nothing -> assertBool "" True
  , testCase "spec map cannot have any other key that is not etc/spec" $ do
    let
      input
        = "{\"etc/entries\":{\"greeting\":{\"etc/spec\":{\"default\":\"hello\"},\"foobar\":123}}}"

    case parseConfigSpec input of
      Just (result :: ConfigSpec ()) ->
        assertFailure $ "etc/spec map should not contain more than one key " ++ show result
      Nothing -> assertBool "" True
  ]

#ifdef WITH_CLI
cli_tests :: TestTree
cli_tests =
  testGroup "cli"
  [
    testCase "cli entry settings requires an input" $ do
      let
        input = "{\"etc/entries\":{\"greeting\":{\"etc/spec\":{\"cli\":{}}}}}"

      case parseConfigSpec input of
        Just (result :: ConfigSpec ()) ->
          assertFailure $ "cli entry should require a type " ++ show result
        Nothing ->
          assertBool "" True

  , testCase "cli option entry requires either short or long" $ do
      let
        input = "{\"etc/entries\":{\"greeting\":{\"etc/spec\":{\"cli\":{\"input\":\"option\"}}}}}"

      case parseConfigSpec input of
        Just (result :: ConfigSpec ()) ->
          assertFailure $ "cli entry should require a type " ++ show result
        Nothing ->
          assertBool "" True

  , testCase "cli option entry works when setting short and type" $ do
      let
        input = "{\"etc/entries\":{\"greeting\":{\"etc/spec\":{\"cli\":{\"input\":\"option\",\"short\":\"g\",\"type\":\"string\"}}}}}"
        keys  = ["greeting"]

      (config :: ConfigSpec ()) <- parseConfigSpec input

      let
        result = do
          value    <- getConfigValue keys (specConfigValues config)
          PlainEntry metadata <- cliEntry (configSources value)
          short <- optShort metadata
          valueType <- pure $ optValueType metadata
          return (short, valueType)

      case result of
        Nothing ->
          assertFailure (show keys ++ " should map to a config value, got sub config map instead")
        Just (short, valueType) -> do
          assertEqual "should contain short" "g" short
          assertEqual "should contain option type" StringOpt valueType

  , testCase "cli option entry works when setting long and type" $ do
      let
        input = "{\"etc/entries\":{\"greeting\":{\"etc/spec\":{\"cli\":{\"input\":\"option\",\"long\":\"greeting\",\"type\":\"string\"}}}}}"
        keys  = ["greeting"]

      (config :: ConfigSpec ()) <- parseConfigSpec input

      let
        result = do
          value    <- getConfigValue keys (specConfigValues config)
          PlainEntry metadata <- cliEntry (configSources value)
          long <- optLong metadata
          valueType <- pure $ optValueType metadata
          return (long, valueType)

      case result of
        Nothing ->
          assertFailure (show keys ++ " should map to a config value, got sub config map instead")
        Just (long, valueType) -> do
          assertEqual "should contain long" "greeting" long
          assertEqual "should contain option type" StringOpt valueType

  , testCase "cli entry accepts command" $ do
      let
        input = "{\"etc/entries\":{\"greeting\":{\"etc/spec\":{\"cli\":{\"input\":\"option\",\"long\":\"greeting\",\"type\":\"string\",\"commands\":[\"foo\"]}}}}}"
        keys  = ["greeting"]

      (config :: ConfigSpec Text) <- parseConfigSpec input

      let
        result = do
          value <- getConfigValue keys (specConfigValues config)
          CmdEntry cmd metadata <- cliEntry (configSources value)
          long <- optLong metadata
          valueType <- pure $ optValueType metadata
          return (cmd, long, valueType)

      case result of
        Nothing ->
          assertFailure (show config)
        Just (cmd, long, valueType) -> do
          assertEqual "should contain cmd" ["foo"] cmd
          assertEqual "should contain long" "greeting" long
          assertEqual "should contain option type" StringOpt valueType

  , testCase "cli entry does not accept unrecognized keys" $ do
      let
        -- error is a typo on key command (instead of command_s_)
        input = "{\"etc/entries\":{\"greeting\":{\"etc/spec\":{\"cli\":{\"input\":\"option\",\"long\":\"greeting\",\"type\":\"string\",\"command\":[\"foo\"]}}}}}"

      case parseConfigSpec input of
        Just (result :: ConfigSpec ()) ->
          assertFailure $ "cli entry should fail on invalid entry " ++ show result
        Nothing ->
          assertBool "" True

  ]
#endif

envvar_tests :: TestTree
envvar_tests = testGroup
  "env"
  [ testCase "env key creates an ENV source" $ do
      let input = "{\"etc/entries\":{\"greeting\":{\"etc/spec\":{\"env\":\"GREETING\"}}}}"
          keys  = ["greeting"]

      (config :: ConfigSpec ()) <- parseConfigSpec input

      case getConfigValue keys (specConfigValues config) of
        Nothing -> assertFailure
          (show keys ++ " should map to a config value, got sub config map instead")
        Just value -> assertEqual "should contain EnvVar value"
                                  (ConfigSources (Just "GREETING") Nothing)
                                  (configSources value)
  ]

#ifdef WITH_YAML
yaml_tests :: TestTree
yaml_tests =
  testGroup "yaml parser"
  [
    testCase "should work with Aeson instances" $ do
      let
        keys  = ["greeting"]
      path   <- getDataFileName "test/fixtures/config.spec.yaml"
      econfig <- YAML.decodeFileEither path

      case econfig of
        Left err ->
          assertFailure $ "yaml file did not have a configuration spec: " <> show err

        Right (config :: ConfigSpec ()) ->
          case getConfigValue keys (specConfigValues config) of
            Nothing ->
              assertFailure (show keys ++ " should map to a config value, got sub config map instead")

            Just value ->
              assertEqual "should contain EnvVar value"
                          (ConfigSources (Just "GREETING") Nothing)
                          (configSources value)
  ]
#endif

tests :: TestTree
tests = testGroup
  "spec"
  [ general_tests
#ifdef WITH_YAML
  , yaml_tests
#endif
  , envvar_tests
#ifdef WITH_CLI
  , cli_tests
#endif
  ]