{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE DeriveAnyClass      #-}
{-# LANGUAGE DeriveGeneric       #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Main where

import           Universum

import           Data.Aeson               (eitherDecodeFileStrict', encode)
import           Data.Aeson.Encode.Pretty (encodePretty)
import           Data.Aeson.KeyMap        (coercionToHashMap)
import           WithCli                  (HasArguments, withCli)

import           CheckDir                 (recursiveCheckDir, resultIsFatal)
import           LintConfig               (ConfigKind (..), LintConfig (..),
                                           patchConfig)
import           System.Exit              (ExitCode (ExitFailure))
import           Types                    (Level (..))
import           Util                     (printPretty)
import qualified Version                  as V (version)
import           WriteRepo                (writeAdjustedRepository)

-- | the options this cli tool can take
data Options = Options
  { repository :: Maybe String
  -- ^ path to the repository containing maps to lint
  , entrypoint :: Maybe String
  -- ^ entrypoint in that repository
  , json       :: Bool
  -- ^ emit json if --json was given
  , lintlevel  :: Maybe Level
  -- ^ maximum lint level to print
  , pretty     :: Bool
  -- ^ pretty-print the json to make it human-readable
  , out        :: Maybe String
  -- ^ path to write the (possibly adjusted) maps to after linting
  , configFile :: Maybe FilePath
  -- ^ path to a config file. Currently required.
  , config     :: Maybe (LintConfig Patch)
  -- ^ a "patch" for the configuration file
  , version    :: Bool
  , dot        :: Bool
  } deriving (Show, Generic, HasArguments)


main :: IO ()
main = withCli run

run :: Options -> IO ()
run Options { .. } = do
  aesonWarning

  if version then
    putStrLn V.version
  else do
    let repo = fromMaybe "." repository
    let entry = fromMaybe "main.json" entrypoint
    let level = fromMaybe Suggestion lintlevel
    configFile' <- case configFile of
      Nothing -> do
        hPutStrLn stderr ("option --config-file=FILEPATH required" :: Text)
        exitFailure
      Just path -> pure path

    lintconfig <- eitherDecodeFileStrict' configFile' >>= \case
      Left  err  -> error $ "config file invalid: " <> toText err
      Right file -> pure (patchConfig file config)

    lints <- recursiveCheckDir lintconfig repo entry

    if json
      then putText
      $ decodeUtf8 (if pretty then encodePretty lints else encode lints)
      else printPretty (level, lints)

    case out of
      Nothing
        | resultIsFatal lintconfig lints -> exitWith (ExitFailure 1)
        | otherwise -> exitSuccess
      Just outpath -> do
        c <- writeAdjustedRepository lintconfig repo outpath lints
        unless json $
          case c of
            ExitFailure 1 ->
              putTextLn "\nMap failed linting!"
            ExitFailure 2 ->
              putTextLn "\nOutpath already exists, not writing anything."
            _ -> pass
        exitWith c


-- if Aesons's internal map and HashMap are the same type, then coercionToHashMap
-- will contain a proof of that, and we can print a warning. Otherwise we're not
-- using HashMaps in Aeson and everything is fine.
--
-- cf. https://frasertweedale.github.io/blog-fp/posts/2021-10-12-aeson-hash-flooding-protection.html
aesonWarning :: IO ()
aesonWarning = case coercionToHashMap of
  Just _ -> hPutStrLn stderr
    ("Warning: this program was compiled using an older version of the Aeson Library\n\
    \used for parsing JSON, which is susceptible to hash flooding attacks.\n\
    \n\
    \Recompiling with a newer version is recommended when handling untrusted inputs.\n\
    \n\
    \See https://cs-syd.eu/posts/2021-09-11-json-vulnerability for details." :: Text)
  _ -> pass