{-# LANGUAGE DeriveAnyClass    #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE NamedFieldPuns    #-}
{-# LANGUAGE OverloadedStrings #-}

module Main where

import           Universum

import           Data.Aeson               (eitherDecode, encode)
import           Data.Aeson.Encode.Pretty (encodePretty)
import           Data.Aeson.KeyMap        (coercionToHashMap)
import qualified Data.ByteString.Lazy     as LB
import qualified Data.Text.Encoding       as T
import qualified Data.Text.IO             as T
import           WithCli                  (HasArguments, withCli)

import           CheckDir                 (recursiveCheckDir, resultIsFatal)
import           LintConfig               (LintConfig (..), patchConfig)
import           Types                    (Level (..))
import           Util                     (printPretty)
import           WriteRepo                (writeAdjustedRepository)

import           System.Exit              (ExitCode (ExitFailure, ExitSuccess))
import qualified Version                  as V (version)

-- | 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 Maybe)
  -- ^ a "patch" for the configuration file
  , version    :: Bool
  } deriving (Show, Generic, HasArguments)


main :: IO ()
main = withCli run

run :: Options -> IO ()
run options = do
  aesonWarning

  when (version options) $ do
    putStrLn V.version
    exitSuccess

  let repo = fromMaybe "." (repository options)
  let entry = fromMaybe "main.json" (entrypoint options)
  let level = fromMaybe Suggestion (lintlevel options)

  lintconfig <- case configFile options of
    Nothing -> error "Need a config file!"
    Just path -> LB.readFile path >>= \res ->
      case eitherDecode res :: Either String (LintConfig Identity) of
        Left err   -> error $ "config file invalid: " <> toText err
        Right file -> pure (patchConfig file (config options))

  lints <- recursiveCheckDir lintconfig repo entry

  if json options
    then printLB
    $ if pretty options then encodePretty lints else encode lints
    else printPretty (level, lints)

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




-- | haskell's many string types are FUN …
printLB :: LB.ByteString -> IO ()
printLB a = T.putStrLn $ T.decodeUtf8 $ LB.toStrict a


-- 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