diff options
Diffstat (limited to 'walint-cli')
| -rw-r--r-- | walint-cli/Main.hs | 108 | ||||
| -rw-r--r-- | walint-cli/Version.hs | 17 | ||||
| -rw-r--r-- | walint-cli/default.nix | 18 | ||||
| -rw-r--r-- | walint-cli/walint-cli.cabal | 27 |
4 files changed, 170 insertions, 0 deletions
diff --git a/walint-cli/Main.hs b/walint-cli/Main.hs new file mode 100644 index 0000000..4bbc670 --- /dev/null +++ b/walint-cli/Main.hs @@ -0,0 +1,108 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +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/walint-cli/Version.hs b/walint-cli/Version.hs new file mode 100644 index 0000000..1748512 --- /dev/null +++ b/walint-cli/Version.hs @@ -0,0 +1,17 @@ +{-# 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) ++ + ")" diff --git a/walint-cli/default.nix b/walint-cli/default.nix new file mode 100644 index 0000000..938bc4f --- /dev/null +++ b/walint-cli/default.nix @@ -0,0 +1,18 @@ +{ mkDerivation, aeson, aeson-pretty, base, bytestring +, getopt-generics, lib, process, template-haskell, text, universum +, walint +}: +mkDerivation { + pname = "walint-cli"; + version = "0.1"; + src = ./.; + isLibrary = false; + isExecutable = true; + executableHaskellDepends = [ + aeson aeson-pretty base bytestring getopt-generics process + template-haskell text universum walint + ]; + homepage = "https://stuebinm.eu/git/walint"; + license = "unknown"; + mainProgram = "walint"; +} diff --git a/walint-cli/walint-cli.cabal b/walint-cli/walint-cli.cabal new file mode 100644 index 0000000..6ca10bd --- /dev/null +++ b/walint-cli/walint-cli.cabal @@ -0,0 +1,27 @@ +cabal-version: 3.0 +name: walint-cli +version: 0.1 +author: stuebinm +maintainer: stuebinm@disroot.org +copyright: 2023 stuebinm +homepage: https://stuebinm.eu/git/walint + +executable walint + main-is: Main.hs + other-modules: + Version + default-extensions: + NoImplicitPrelude + ghc-options: -Wall -Wno-name-shadowing -Wno-unticked-promoted-constructors + build-depends: + aeson + , aeson-pretty + , base + , bytestring + , getopt-generics + , process + , template-haskell + , text + , universum + , walint + default-language: GHC2021 |