summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Main.hs111
-rw-r--r--src/Version.hs17
2 files changed, 0 insertions, 128 deletions
diff --git a/src/Main.hs b/src/Main.hs
deleted file mode 100644
index 9628e1e..0000000
--- a/src/Main.hs
+++ /dev/null
@@ -1,111 +0,0 @@
-{-# 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
diff --git a/src/Version.hs b/src/Version.hs
deleted file mode 100644
index 1748512..0000000
--- a/src/Version.hs
+++ /dev/null
@@ -1,17 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-
-
-module Version ( version ) where
-
-import Universum
-
-import qualified Language.Haskell.TH as TH
-import System.Process (readProcess)
-
-version :: String
-version = "walint generic 2022 (" <>
- $(do
- hash <- liftIO $ catchAny (readProcess "git" ["rev-parse", "HEAD"] "")
- (\_ -> pure "[unknown]")
- pure . TH.LitE . TH.StringL $ take 40 hash) ++
- ")"