From 423e8bf09b977795d0a21afb5e1b2c0a2a154fd1 Mon Sep 17 00:00:00 2001 From: Jeffrey Huynh Date: Mon, 15 Jan 2024 16:26:49 -0800 Subject: [PATCH 01/17] adding new effect/carriers for err (help, support, doc) --- src/Control/Carrier/Diagnostics.hs | 6 ++ src/Control/Effect/Diagnostics.hs | 21 ++++++ src/Data/Error.hs | 111 +++++++++++++++++++++++++++++ src/Diag/Monad.hs | 56 +++++++++++++-- src/Diag/Result.hs | 65 +++++++++++++++-- 5 files changed, 245 insertions(+), 14 deletions(-) create mode 100644 src/Data/Error.hs diff --git a/src/Control/Carrier/Diagnostics.hs b/src/Control/Carrier/Diagnostics.hs index a36adc9523..8eab0a5170 100644 --- a/src/Control/Carrier/Diagnostics.hs +++ b/src/Control/Carrier/Diagnostics.hs @@ -69,6 +69,12 @@ instance Has Stack sig m => Algebra (Diag :+: sig) (DiagnosticsC m) where ResultT.warnOnErrT (Result.SomeWarn w) $ runDiagnosticsC $ hdl (act <$ ctx) L (ErrCtx c act) -> ResultT.errCtxT (Result.ErrCtx c) $ runDiagnosticsC $ hdl (act <$ ctx) + L (ErrHelp h act) -> + ResultT.errHelpT (Result.ErrHelp h) $ runDiagnosticsC $ hdl (act <$ ctx) + L (ErrSupport s act) -> + ResultT.errSupportT (Result.ErrSupport s) $ runDiagnosticsC $ hdl (act <$ ctx) + L (ErrDoc d act) -> + ResultT.errDocT (Result.ErrDoc d) $ runDiagnosticsC $ hdl (act <$ ctx) L (Fatal diag) -> do stack <- lift getStack ResultT.fatalT (Result.Stack stack) (Result.SomeErr diag) diff --git a/src/Control/Effect/Diagnostics.hs b/src/Control/Effect/Diagnostics.hs index a9351d7da5..ba2948cb73 100644 --- a/src/Control/Effect/Diagnostics.hs +++ b/src/Control/Effect/Diagnostics.hs @@ -15,6 +15,9 @@ module Control.Effect.Diagnostics ( fatal, recover, errCtx, + errHelp, + errSupport, + errDoc, errorBoundary, rethrow, warn, @@ -80,6 +83,9 @@ data Diag m k where Fatal :: ToDiagnostic diag => diag -> Diag m a Recover :: m a -> Diag m (Maybe a) ErrCtx :: ToDiagnostic ctx => ctx -> m a -> Diag m a + ErrHelp :: ToDiagnostic hlp => hlp -> m a -> Diag m a + ErrSupport :: ToDiagnostic supp => supp -> m a -> Diag m a + ErrDoc :: ToDiagnostic doc => doc -> m a -> Diag m a ErrorBoundary :: m a -> Diag m (Result a) Rethrow :: Result a -> Diag m a Warn :: ToDiagnostic warn => warn -> Diag m () @@ -99,6 +105,21 @@ recover = send . Recover errCtx :: (ToDiagnostic ctx, Has Diagnostics sig m) => ctx -> m a -> m a errCtx ctx m = send (ErrCtx ctx m) +-- | When the provided action fails, annotate its error with the provided +-- help +errHelp :: (ToDiagnostic hlp, Has Diagnostics sig m) => hlp -> m a -> m a +errHelp hlp m = send (ErrHelp hlp m) + +-- | When the provided action fails, annotate its error with the provided +-- support +errSupport :: (ToDiagnostic supp, Has Diagnostics sig m) => supp -> m a -> m a +errSupport supp m = send (ErrSupport supp m) + +-- | When the provided action fails, annotate its error with the provided +-- doc +errDoc :: (ToDiagnostic doc, Has Diagnostics sig m) => doc -> m a -> m a +errDoc doc m = send (ErrDoc doc m) + -- | Nearly identical to @runDiagnostics@, run an action, returning its -- underlying 'Result'. Most often, you'll want to use 'recover' instead. -- diff --git a/src/Data/Error.hs b/src/Data/Error.hs new file mode 100644 index 0000000000..f5948a5c17 --- /dev/null +++ b/src/Data/Error.hs @@ -0,0 +1,111 @@ +{-# LANGUAGE ImplicitParams #-} +{-# LANGUAGE RecordWildCards #-} + +module Data.Error ( + SourceLocation (..), + getSourceLocation, + buildErrorMessage, + buildHelpMessage, + buildDocumentationMessage, + buildContextMessage, + createBlock, + createBody, + createError, + renderErrors, +) where + +import Algebra.Graph.Export (render) +import Data.Maybe (fromMaybe) +import Data.Text (Text) +import Data.Text.Lazy qualified as TL +import Errata (Block (..), Pointer (..), blockSimple, errataSimple, prettyErrors) +import Errata.Source (Source (emptySource)) +import Errata.Styles (basicPointer, basicStyle, fancyRedPointer, fancyRedStyle, fancyStyle) +import Errata.Types (Errata (..)) +import GHC.Generics (Generic) +import GHC.Stack (CallStack, SrcLoc (..), getCallStack) + +-- SourceLocation captures the file path, line, and col at a given call site +-- SourceLocation will be used in conjuction with our errors +data SourceLocation = SourceLocation + { filePath :: FilePath + , line :: Int + , col :: Int + } + deriving (Eq, Ord, Show, Generic) + +-- getSourceLocation returns SourceLocation with the filePath, line, col of the call site +getSourceLocation :: (?callStack :: CallStack) => SourceLocation +getSourceLocation = case getCallStack ?callStack of + (_, loc) : _ -> SourceLocation (srcLocFile loc) (srcLocStartLine loc) (srcLocStartCol loc) + _ -> SourceLocation "Unknown" 0 0 + +createError :: Maybe Text -> [Block] -> Maybe Text -> Errata +createError = Errata + +-- wrapper to create an Errata block +createBlock :: SourceLocation -> Maybe Text -> Maybe Text -> Block +createBlock SourceLocation{..} maybeHeader = + Block + fancyStyle + (filePath, line, col) + maybeHeader + [] + +createBody :: Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Text +createBody maybeContent maybeDocumentation maybeSupport maybeHelp maybeContext = do + let content = fromMaybe "" maybeContent + documentation = maybe "" buildDocumentationMessage maybeDocumentation + support = maybe "" buildSupportMessage maybeSupport + help = maybe "" buildHelpMessage maybeHelp + context = maybe "" buildContextMessage maybeContext + + content <> documentation <> support <> help <> context + +-- red ANSI escape code +errorColor :: Text +errorColor = "\x1b[31m" + +-- yellow ANSI escape code +warningColor :: Text +warningColor = "\x1b[33m" + +-- blue ANSI escape code +supportColor :: Text +supportColor = "\x1b[34m" + +-- magenta ANSI escape code +documentationColor :: Text +documentationColor = "\x1b[35m" + +-- cyan ANSI escape code +helpColor :: Text +helpColor = "\x1b[36m" + +-- green ANSI escape code +contextColor :: Text +contextColor = "\x1b[32m" + +-- ANSI escape code to reset foreground text color +resetColor :: Text +resetColor = "\x1b[39m" + +buildErrorMessage :: Text -> Text +buildErrorMessage msg = errorColor <> "Error:" <> resetColor <> " " <> msg + +buildSupportMessage :: Text -> Text +buildSupportMessage msg = supportColor <> "Support:" <> resetColor <> " " <> msg <> "\n" + +buildDocumentationMessage :: Text -> Text +buildDocumentationMessage msg = documentationColor <> "Documentation:" <> resetColor <> " " <> msg <> "\n" + +buildHelpMessage :: Text -> Text +buildHelpMessage msg = helpColor <> "Help:" <> resetColor <> " " <> msg <> "\n" + +buildContextMessage :: Text -> Text +buildContextMessage msg = contextColor <> "Context:" <> resetColor <> " " <> msg + +renderErrors :: [Errata] -> TL.Text +renderErrors = + prettyErrors @String + emptySource \ No newline at end of file diff --git a/src/Diag/Monad.hs b/src/Diag/Monad.hs index 0da1fea5e1..cc965a6db9 100644 --- a/src/Diag/Monad.hs +++ b/src/Diag/Monad.hs @@ -10,13 +10,16 @@ module Diag.Monad ( rethrowT, warnOnErrT, errCtxT, + errHelpT, + errSupportT, + errDocT, (<||>), ) where import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Trans.Class (MonadTrans, lift) import Data.List.NonEmpty qualified as NE -import Diag.Result (EmittedWarn (..), ErrCtx (..), ErrGroup (..), ErrWithStack (..), Result (..), SomeErr (..), SomeWarn (..), Stack (..)) +import Diag.Result (EmittedWarn (..), ErrCtx (..), ErrDoc, ErrGroup (..), ErrHelp, ErrSupport, ErrWithStack (..), Result (..), SomeErr (..), SomeWarn (..), Stack (..)) -- | A monad transformer that adds error-/warning-reporting capabilities to -- other monads @@ -110,6 +113,24 @@ errCtxT :: Functor m => ErrCtx -> ResultT m a -> ResultT m a errCtxT c = ResultT . fmap (errCtxR c) . runResultT {-# INLINE errCtxT #-} +-- | Attach error help to the ErrGroup of a possibly-failing computation. +-- No-op on Success +errHelpT :: Functor m => ErrHelp -> ResultT m a -> ResultT m a +errHelpT h = ResultT . fmap (errHelpR h) . runResultT +{-# INLINE errHelpT #-} + +-- | Attach error support to the ErrGroup of a possibly-failing computation. +-- No-op on Success +errSupportT :: Functor m => ErrSupport -> ResultT m a -> ResultT m a +errSupportT s = ResultT . fmap (errSupportR s) . runResultT +{-# INLINE errSupportT #-} + +-- | Attach error doc to the ErrGroup of a possibly-failing computation. +-- No-op on Success +errDocT :: Functor m => ErrDoc -> ResultT m a -> ResultT m a +errDocT d = ResultT . fmap (errDocR d) . runResultT +{-# INLINE errDocT #-} + -- | Try both actions, returning the value of the first to succeed. -- -- Similar to the Applicative instance, this accumulates errors from encountered @@ -137,7 +158,7 @@ ResultT ma <||> ResultT ma' = ResultT $ do -- | Fail with the given stacktrace and error fatalR :: Stack -> SomeErr -> Result a -fatalR stack e = Failure [] (ErrGroup [] [] (ErrWithStack stack e NE.:| [])) +fatalR stack e = Failure [] (ErrGroup [] [] [] [] [] (ErrWithStack stack e NE.:| [])) {-# INLINE fatalR #-} -- | Emit a standalone warning @@ -155,25 +176,46 @@ recoverR (Success ws a) = Success ws (Just a) -- | Attach a warning to the ErrGroup of a possibly-failing computation. No-op -- on Success warnOnErrR :: SomeWarn -> Result a -> Result a -warnOnErrR w (Failure ws (ErrGroup sws ectx es)) = Failure ws (ErrGroup (w : sws) ectx es) +warnOnErrR w (Failure ws (ErrGroup sws ectx ehlp esup edoc es)) = Failure ws (ErrGroup (w : sws) ectx ehlp esup edoc es) warnOnErrR _ (Success ws a) = Success ws a {-# INLINE warnOnErrR #-} -- | Attach error context to the ErrGroup of a possibly-failing computation. -- No-op on Success errCtxR :: ErrCtx -> Result a -> Result a -errCtxR c (Failure ws (ErrGroup sws ectx es)) = Failure ws (ErrGroup sws (c : ectx) es) +errCtxR c (Failure ws (ErrGroup sws ectx ehlp esup edoc es)) = Failure ws (ErrGroup sws (c : ectx) ehlp esup edoc es) errCtxR _ (Success ws a) = Success ws a {-# INLINE errCtxR #-} +-- | Attach error help to the ErrGroup of a possibly-failing computation. +-- No-op on Success +errHelpR :: ErrHelp -> Result a -> Result a +errHelpR h (Failure ws (ErrGroup sws ectx ehlp esup edoc es)) = Failure ws (ErrGroup sws ectx (h : ehlp) esup edoc es) +errHelpR _ (Success ws a) = Success ws a +{-# INLINE errHelpR #-} + +-- | Attach error support to the ErrGroup of a possibly-failing computation. +-- No-op on Success +errSupportR :: ErrSupport -> Result a -> Result a +errSupportR s (Failure ws (ErrGroup sws ectx ehlp esup edoc es)) = Failure ws (ErrGroup sws ectx ehlp (s : esup) edoc es) +errSupportR _ (Success ws a) = Success ws a +{-# INLINE errSupportR #-} + +-- | Attach error context to the ErrGroup of a possibly-failing computation. +-- No-op on Success +errDocR :: ErrDoc -> Result a -> Result a +errDocR d (Failure ws (ErrGroup sws ectx ehlp esup edoc es)) = Failure ws (ErrGroup sws ectx ehlp esup (d : edoc) es) +errDocR _ (Success ws a) = Success ws a +{-# INLINE errDocR #-} + -- | Convert an ErrGroup into an EmittedWarn, for the purpose of emitting a -- warning when recovering from a Failure -- -- When the ErrGroup contains no warnings, this produces 'IgnoredErrGroup'. -- Otherwise, this produces 'WarnOnErrGroup' errGroupToWarning :: ErrGroup -> EmittedWarn -errGroupToWarning (ErrGroup sws ectx es) = +errGroupToWarning (ErrGroup sws ectx ehlp esup edoc es) = case NE.nonEmpty sws of - Nothing -> IgnoredErrGroup ectx es - Just sws' -> WarnOnErrGroup sws' ectx es + Nothing -> IgnoredErrGroup ectx ehlp esup edoc es + Just sws' -> WarnOnErrGroup sws' ectx ehlp esup edoc es {-# INLINE errGroupToWarning #-} diff --git a/src/Diag/Result.hs b/src/Diag/Result.hs index ae7c7f2d15..abc5221fee 100644 --- a/src/Diag/Result.hs +++ b/src/Diag/Result.hs @@ -23,6 +23,9 @@ module Diag.Result ( SomeErr (..), SomeWarn (..), ErrCtx (..), + ErrHelp (..), + ErrSupport (..), + ErrDoc (..), -- * Helpers resultToMaybe, @@ -74,18 +77,18 @@ data Result a = Failure [EmittedWarn] ErrGroup | Success [EmittedWarn] a -- contains no warnings data EmittedWarn = StandaloneWarn SomeWarn - | WarnOnErrGroup (NonEmpty SomeWarn) [ErrCtx] (NonEmpty ErrWithStack) - | IgnoredErrGroup [ErrCtx] (NonEmpty ErrWithStack) + | WarnOnErrGroup (NonEmpty SomeWarn) [ErrCtx] [ErrHelp] [ErrSupport] [ErrDoc] (NonEmpty ErrWithStack) + | IgnoredErrGroup [ErrCtx] [ErrHelp] [ErrSupport] [ErrDoc] (NonEmpty ErrWithStack) deriving (Show) -- | An error, or group of errors, that occurred during a computation that led -- to a Failure. An ErrGroup can have warnings and error context attached. -data ErrGroup = ErrGroup [SomeWarn] [ErrCtx] (NonEmpty ErrWithStack) +data ErrGroup = ErrGroup [SomeWarn] [ErrCtx] [ErrHelp] [ErrSupport] [ErrDoc] (NonEmpty ErrWithStack) deriving (Show) instance Semigroup ErrGroup where (<>) :: ErrGroup -> ErrGroup -> ErrGroup - ErrGroup sws ectx nee <> ErrGroup sws' ectx' nee' = ErrGroup (sws <> sws') (ectx <> ectx') (nee <> nee') + ErrGroup sws ectx ehlp esup edoc nee <> ErrGroup sws' ectx' ehlp' esup' edoc' nee' = ErrGroup (sws <> sws') (ectx <> ectx') (ehlp <> ehlp') (esup <> esup') (edoc <> edoc') (nee <> nee') -- | An error with an associated stacktrace data ErrWithStack = ErrWithStack Stack SomeErr @@ -141,6 +144,27 @@ data ErrCtx where instance Show ErrCtx where showsPrec p (ErrCtx c) = showParen (p > 10) $ showString "ErrCtx " . diagToShowS c +-- | Some error help type. Right now, this just requries a ToDiagnostics instance for the type. +data ErrHelp where + ErrHelp :: ToDiagnostic diag => diag -> ErrHelp + +instance Show ErrHelp where + showsPrec p (ErrHelp h) = showParen (p > 10) $ showString "ErrHelp " . diagToShowS h + +-- | Some error support type. Right now, this just requries a ToDiagnostics instance for the type. +data ErrSupport where + ErrSupport :: ToDiagnostic diag => diag -> ErrSupport + +instance Show ErrSupport where + showsPrec p (ErrSupport s) = showParen (p > 10) $ showString "ErrSupport " . diagToShowS s + +-- | Some error doc type. Right now, this just requries a ToDiagnostics instance for the type. +data ErrDoc where + ErrDoc :: ToDiagnostic diag => diag -> ErrDoc + +instance Show ErrDoc where + showsPrec p (ErrDoc d) = showParen (p > 10) $ showString "ErrDoc " . diagToShowS d + diagToShowS :: ToDiagnostic diag => diag -> ShowS diagToShowS = showWrapped '"' . showLitString . show . renderDiagnostic where @@ -160,7 +184,7 @@ resultToMaybe (Failure _ _) = Nothing -- -- renderFailure displays all types of emitted warnings. renderFailure :: [EmittedWarn] -> ErrGroup -> Doc AnsiStyle -> Doc AnsiStyle -renderFailure ws (ErrGroup _ ectx es) headerDoc = header headerDoc <> renderedCtx <> renderedErrs <> renderedPossibleErrs +renderFailure ws (ErrGroup _ ectx ehlp esup edoc es) headerDoc = header headerDoc <> renderedCtx <> renderedHelp <> renderedSupport <> renderedDoc <> renderedErrs <> renderedPossibleErrs where renderedCtx :: Doc AnsiStyle renderedCtx = @@ -168,6 +192,24 @@ renderFailure ws (ErrGroup _ ectx es) headerDoc = header headerDoc <> renderedCt [] -> emptyDoc _ -> section "Details" (vsep (map (\ctx -> renderErrCtx ctx <> line) ectx)) + renderedHelp :: Doc AnsiStyle + renderedHelp = + case ehlp of + [] -> emptyDoc + _ -> section "Help" (vsep (map (\hlp -> renderErrHelp hlp <> line) ehlp)) + + renderedSupport :: Doc AnsiStyle + renderedSupport = + case esup of + [] -> emptyDoc + _ -> section "Support" (vsep (map (\s -> renderErrSupport s <> line) esup)) + + renderedDoc :: Doc AnsiStyle + renderedDoc = + case edoc of + [] -> emptyDoc + _ -> section "Documentation" (vsep (map (\d -> renderErrDoc d <> line) edoc)) + renderedErrs :: Doc AnsiStyle renderedErrs = section "Relevant errors" $ @@ -209,6 +251,15 @@ renderSuccess ws headerDoc = renderErrCtx :: ErrCtx -> Doc AnsiStyle renderErrCtx (ErrCtx ctx) = renderDiagnostic ctx +renderErrHelp :: ErrHelp -> Doc AnsiStyle +renderErrHelp (ErrHelp hlp) = renderDiagnostic hlp + +renderErrSupport :: ErrSupport -> Doc AnsiStyle +renderErrSupport (ErrSupport supp) = renderDiagnostic supp + +renderErrDoc :: ErrDoc -> Doc AnsiStyle +renderErrDoc (ErrDoc doc) = renderDiagnostic doc + renderErrWithStack :: ErrWithStack -> Doc AnsiStyle renderErrWithStack (ErrWithStack (Stack stack) (SomeErr err)) = renderDiagnostic err @@ -221,7 +272,7 @@ renderErrWithStack (ErrWithStack (Stack stack) (SomeErr err)) = _ -> indent 2 (vsep (map (pretty . ("- " <>)) stack)) renderEmittedWarn :: EmittedWarn -> Doc AnsiStyle -renderEmittedWarn (IgnoredErrGroup ectx es) = renderedCtx <> renderedErrors +renderEmittedWarn (IgnoredErrGroup ectx ehlp esup edoc es) = renderedCtx <> renderedErrors where renderedCtx = case ectx of @@ -234,7 +285,7 @@ renderEmittedWarn (IgnoredErrGroup ectx es) = renderedCtx <> renderedErrors "Relevant errors" $ subsection "Error" (map renderErrWithStack (NE.toList es)) renderEmittedWarn (StandaloneWarn (SomeWarn warn)) = renderDiagnostic warn -renderEmittedWarn (WarnOnErrGroup ws ectx es) = renderedWarnings <> renderedCtx <> renderedErrors +renderEmittedWarn (WarnOnErrGroup ws ectx ehlp esup edoc es) = renderedWarnings <> renderedCtx <> renderedErrors where renderedWarnings = vsep (map (\w -> renderSomeWarn w <> line) (NE.toList ws)) <> line From 4e6c0cee6bfdc982ff6ea92f921a2a209a8c213b Mon Sep 17 00:00:00 2001 From: Jeffrey Huynh Date: Mon, 15 Jan 2024 16:30:08 -0800 Subject: [PATCH 02/17] Initial implemenation for error structure changes --- spectrometer.cabal | 5 +- src/App/Fossa/Analyze.hs | 133 +++++++++++++----- src/App/Fossa/BinaryDeps/Jar.hs | 6 +- src/App/Fossa/Config/Container/Common.hs | 19 ++- src/App/Fossa/Config/Report.hs | 30 ++-- src/App/Fossa/Container/Scan.hs | 11 +- src/App/Fossa/LicenseScan.hs | 33 +++-- src/App/Fossa/ManualDeps.hs | 23 +-- src/App/Fossa/ProjectInference.hs | 29 +++- src/App/Fossa/VSI/DynLinked.hs | 15 +- .../Fossa/VSI/DynLinked/Internal/Binary.hs | 7 +- .../Fossa/VSI/DynLinked/Internal/Lookup.hs | 10 +- src/App/Fossa/VSI/Types.hs | 17 +-- src/Control/Carrier/Diagnostics.hs | 3 +- src/Control/Carrier/Git.hs | 5 +- src/Data/Error.hs | 111 +++++++++++++++ src/Diag/Common.hs | 17 ++- src/Diag/Diagnostic.hs | 47 +++++-- src/Strategy/AlpineLinux/Parser.hs | 13 +- src/Strategy/Carthage.hs | 15 +- src/Strategy/Conan/ConanGraph.hs | 15 +- src/Strategy/Conan/Enrich.hs | 69 ++++----- src/Strategy/Conda/CondaEnvCreate.hs | 4 +- src/Strategy/Leiningen.hs | 5 +- src/Strategy/Maven/PluginStrategy.hs | 14 +- src/Strategy/Nim/NimbleLock.hs | 9 +- src/Strategy/Python/Pip.hs | 9 +- src/Strategy/Python/ReqTxt.hs | 15 +- src/Strategy/Ruby/Errors.hs | 23 +-- src/Strategy/Swift/Errors.hs | 22 +-- src/Strategy/Swift/Xcode/Pbxproj.hs | 6 +- 31 files changed, 496 insertions(+), 244 deletions(-) create mode 100644 src/Data/Error.hs diff --git a/spectrometer.cabal b/spectrometer.cabal index bbf76f06f9..4e435b5988 100644 --- a/spectrometer.cabal +++ b/spectrometer.cabal @@ -99,10 +99,11 @@ common deps , containers ^>=0.6.0 , cpio-conduit ^>=0.7.0 , crypton ^>=0.33 - , deepseq ^>=1.4 + , deepseq ^>=1.4 , direct-sqlite ^>=2.3.27 , directory ^>=1.3.6.1 , either ^>=5.0.2 + , errata ^>=0.4.0.2 , file-embed ^>=0.0.15 , filepath ^>=1.4.2.1 , filepattern ^>=0.1.2 @@ -111,6 +112,7 @@ common deps , git-config ^>=0.1.2 , githash ^>=0.1.4.0 , hashable >=1.0.0.1 + , haskell-src >=1.0.4 , hedn ^>=0.3.0.1 , http-client ^>=0.7.1 , http-conduit ^>=2.3.0 @@ -325,6 +327,7 @@ library Control.Timeout.Internal Data.Aeson.Extra Data.Conduit.Extra + Data.Error Data.FileEmbed.Extra Data.FileTree.IndexFileTree Data.Flag diff --git a/src/App/Fossa/Analyze.hs b/src/App/Fossa/Analyze.hs index fc2fadf7fa..26e170c726 100644 --- a/src/App/Fossa/Analyze.hs +++ b/src/App/Fossa/Analyze.hs @@ -92,12 +92,14 @@ import Control.Monad (join, unless, void, when) import Data.Aeson ((.=)) import Data.Aeson qualified as Aeson import Data.ByteString.Lazy qualified as BL +import Data.Error (SourceLocation, createBlock, createBody, getSourceLocation) import Data.Flag (Flag, fromFlag) import Data.Foldable (traverse_) import Data.List.NonEmpty qualified as NE import Data.Maybe (fromMaybe, mapMaybe) import Data.String.Conversion (decodeUtf8, toText) import Data.Text.Extra (showT) +import Diag.Diagnostic as DI import Diag.Result (resultToMaybe) import Discovery.Archive qualified as Archive import Discovery.Filters (AllFilters, MavenScopeFilters, applyFilters, filterIsVSIOnly, ignoredPaths, isDefaultNonProductionPath) @@ -106,14 +108,16 @@ import Effect.Exec (Exec) import Effect.Logger ( Logger, Severity (..), + logDebug, logInfo, logStdout, + renderIt, ) import Effect.ReadFS (ReadFS) +import Errata qualified as E import Path (Abs, Dir, Path, toFilePath) import Path.IO (makeRelative) import Prettyprinter ( - Doc, Pretty (pretty), annotate, viaShow, @@ -256,7 +260,10 @@ analyze :: m Aeson.Value analyze cfg = Diag.context "fossa-analyze" $ do capabilities <- sendIO getNumCapabilities - + logDebug "highihi" + -- sendIO execute + logInfo "After --------" + Diag.fatal $ ErrOnlyKeywordSearchResultsFound getSourceLocation let maybeApiOpts = case destination of OutputStdout -> Nothing UploadScan opts _ -> Just opts @@ -391,14 +398,46 @@ analyze cfg = Diag.context "fossa-analyze" $ do let keywordSearchResultsFound = (maybe False (not . null . lernieResultsKeywordSearches) lernieResults) let outputResult = buildResult includeAll additionalSourceUnits filteredProjects' licenseSourceUnits + -- logInfo "This is the pErrors &&&&&&&&&&" + -- let pErrors = + -- prettyErrors @String + -- emptySource + -- [ E.Errata + -- (Just "Relevant Errors") + -- [ Block + -- fancyRedStyle + -- ("src/App/Fossa/Analyze.hs", 1, 10) + -- (Just "\x1b[31mError: No Analysis Targets Found") + -- [] + -- (Just ("\n\x1b[36mHint:\x1b[0m Make sure your project is supported. \n\x1b[35mDocumentation: \x1b[0m" <> userGuideUrl)) + -- , Block + -- fancyRedStyle + -- ("src/App/Fossa/Analyze.hs", 1, 10) + -- (Just "Block Header 2") + -- [] + -- (Just "block body 2") + -- ] + -- (Just "\x1b[36mThis si the Errata Body") + -- , E.Errata + -- (Just "Errata Header 2") + -- [ Block + -- fancyRedStyle + -- ("src/App/Fossa/Analyze.hs", 1, 10) + -- (Just "Block Header 3") + -- [] + -- (Just "Block Body 3") + -- ] + -- (Just ("\x1b[36mHint:\x1b[0m Make sure your project is supported. \n\x1b[35mDocumentation: \x1b[0m" <> userGuideUrl)) + -- ] + -- logInfo (pretty pErrors) -- If we find nothing but keyword search, we exit with an error, but explain that the error may be ignorable. -- We do not want to succeed, because nothing gets uploaded to the API for keyword searches, so `fossa test` will fail. -- So the solution is to still fail, but give a hopefully useful explanation that the error can be ignored if all you were expecting is keyword search results. case (keywordSearchResultsFound, checkForEmptyUpload includeAll projectScans filteredProjects' additionalSourceUnits licenseSourceUnits) of - (False, NoneDiscovered) -> Diag.fatal ErrNoProjectsDiscovered - (True, NoneDiscovered) -> Diag.fatal ErrOnlyKeywordSearchResultsFound - (False, FilteredAll) -> Diag.fatal ErrFilteredAllProjects - (True, FilteredAll) -> Diag.fatal ErrOnlyKeywordSearchResultsFound + (False, NoneDiscovered) -> Diag.fatal $ ErrNoProjectsDiscovered getSourceLocation + (True, NoneDiscovered) -> Diag.fatal $ ErrOnlyKeywordSearchResultsFound getSourceLocation + (False, FilteredAll) -> Diag.fatal $ ErrFilteredAllProjects getSourceLocation + (True, FilteredAll) -> Diag.fatal $ ErrOnlyKeywordSearchResultsFound getSourceLocation (_, CountedScanUnits scanUnits) -> doUpload outputResult iatAssertion destination basedir jsonOutput revision scanUnits pure outputResult where @@ -412,6 +451,20 @@ analyze cfg = Diag.context "fossa-analyze" $ do locator <- uploadSuccessfulAnalysis (BaseDir basedir) metadata jsonOutput revision scanUnits doAssertRevisionBinaries iatAssertion locator +-- toErrata :: AnalyzeError -> E.Errata +-- toErrata analyzeError = +-- errataSimple +-- (Just "An error occured!") +-- ( blockSimple +-- basicStyle +-- basicPointer +-- sampleFilePath +-- (Just "error: No analysis targets found in directory.") +-- (1, 3, 0, Just "this one") +-- (Just "Make sure your project is supported. See the user guide for details:") +-- ) +-- Nothing + toProjectResult :: DiscoveredProjectScan -> Maybe ProjectResult toProjectResult (SkippedDueToProvidedFilter _) = Nothing toProjectResult (SkippedDueToDefaultProductionFilter _) = Nothing @@ -489,38 +542,46 @@ doAnalyzeDynamicLinkedBinary root (DynamicLinkInspect (Just target)) = analyzeDy doAnalyzeDynamicLinkedBinary _ _ = pure Nothing data AnalyzeError - = ErrNoProjectsDiscovered - | ErrFilteredAllProjects - | ErrOnlyKeywordSearchResultsFound + = ErrNoProjectsDiscovered (SourceLocation) + | ErrFilteredAllProjects (SourceLocation) + | ErrOnlyKeywordSearchResultsFound (SourceLocation) + +-- instance Error.toErrata AnalyzeError where instance Diag.ToDiagnostic AnalyzeError where - renderDiagnostic :: AnalyzeError -> Doc ann - renderDiagnostic ErrNoProjectsDiscovered = - vsep - [ "No analysis targets found in directory." - , "" - , "Make sure your project is supported. See the user guide for details:" - , " " <> pretty userGuideUrl - , "" - ] - renderDiagnostic (ErrFilteredAllProjects) = - vsep - [ "Filtered out all projects. This may be occurring because: " - , "" - , " * No manual or vendor dependencies were provided with `fossa-deps` file." - , " * Exclusion filters were used, filtering out discovered projects. " - , " * Discovered projects resided in following ignored path by default:" - , vsep $ map (\i -> pretty $ " * " <> toText i) ignoredPaths - , "" - , "See the user guide for details:" - , " " <> pretty userGuideUrl - , "" - ] - renderDiagnostic (ErrOnlyKeywordSearchResultsFound) = - vsep - [ "Matches to your keyword searches were found, but no other analysis targets were found." - , "This error can be safely ignored if you are only expecting keyword search results." - ] + renderDiagnostic :: AnalyzeError -> DiagnosticInfo + renderDiagnostic (ErrNoProjectsDiscovered srcLoc) = do + let header = "No analysis targets found in directory" + documentationReferences = [userGuideUrl] + help = "Make sure your project is supported" + DiagnosticInfo (Just header) Nothing (Just documentationReferences) Nothing (Just help) Nothing (Just srcLoc) + renderDiagnostic (ErrFilteredAllProjects srcLoc) = do + let header = "Filtered out all projects" + content = + renderIt $ + vsep + [ "This may be occurring because: " + , "" + , " * No manual or vendor dependencies were provided with `fossa-deps` file." + , " * Exclusion filters were used, filtering out discovered projects. " + , " * Discovered projects resided in following ignored path by default:" + , vsep $ map (\i -> pretty $ " * " <> toText i) ignoredPaths + , "" + ] + body = createBody (Just content) (Just userGuideUrl) Nothing Nothing Nothing + block = createBlock srcLoc Nothing Nothing + E.Errata (Just header) [block] (Just body) + renderDiagnostic (ErrOnlyKeywordSearchResultsFound srcLoc) = do + let header = "Only keyword search results found" + content = + renderIt $ + vsep + [ "Matches to your keyword searches were found, but no other analysis targets were found." + , "This error can be safely ignored if you are only expecting keyword search results." + ] + body = createBody (Just content) Nothing Nothing Nothing Nothing + block = createBlock srcLoc Nothing Nothing + E.Errata (Just header) [block] (Just body) buildResult :: Flag IncludeAll -> [SourceUnit] -> [ProjectResult] -> Maybe LicenseSourceUnit -> Aeson.Value buildResult includeAll srcUnits projects licenseSourceUnits = diff --git a/src/App/Fossa/BinaryDeps/Jar.hs b/src/App/Fossa/BinaryDeps/Jar.hs index ce602bccc5..7c1d63241c 100644 --- a/src/App/Fossa/BinaryDeps/Jar.hs +++ b/src/App/Fossa/BinaryDeps/Jar.hs @@ -24,6 +24,7 @@ import Data.Maybe (listToMaybe, mapMaybe) import Data.String.Conversion (ToString (toString), ToText (toText)) import Data.Text (Text) import Data.Text qualified as Text +import Diag.Diagnostic qualified as DI import Discovery.Archive (extractZip, withArchive) import Discovery.Walk (WalkStep (WalkContinue, WalkSkipAll), findFileNamed, walk') import Effect.Logger (Logger, logDebug, pretty) @@ -69,11 +70,12 @@ resolveJar root file = do newtype FailedToResolveJar = FailedToResolveJar (Path Abs File) instance ToDiagnostic FailedToResolveJar where - renderDiagnostic (FailedToResolveJar path) = "Could not infer jar metadata (license, jar name, and version) from " <> viaShow path + renderDiagnostic (FailedToResolveJar path) = DI.DiagnosticInfo (Just $ "Could not infer jar metadata (license, jar name, and version) from " <> toText (show path)) Nothing Nothing Nothing Nothing Nothing Nothing newtype FailedToResolveJarCtx = FailedToResolveJarCtx (Path Abs File) instance ToDiagnostic FailedToResolveJarCtx where - renderDiagnostic (FailedToResolveJarCtx path) = "Ensure " <> viaShow path <> " is a valid jar or aar file." + renderDiagnostic :: FailedToResolveJarCtx -> DI.DiagnosticInfo + renderDiagnostic (FailedToResolveJarCtx path) = DI.DiagnosticInfo Nothing Nothing Nothing Nothing (Just $ "Ensure " <> toText (show path) <> " is a valid jar or aar file.") Nothing Nothing tacticMetaInf :: (Has (Lift IO) sig m, Has Diagnostics sig m, Has Logger sig m, Has ReadFS sig m) => Path Abs Dir -> m JarMetadata tacticMetaInf archive = context ("Parse " <> toText metaInfPath) $ do diff --git a/src/App/Fossa/Config/Container/Common.hs b/src/App/Fossa/Config/Container/Common.hs index 9a8bd6548a..7fefef8df6 100644 --- a/src/App/Fossa/Config/Container/Common.hs +++ b/src/App/Fossa/Config/Container/Common.hs @@ -11,6 +11,8 @@ import Data.Aeson (ToJSON (toEncoding), defaultOptions, genericToEncoding) import Data.String.Conversion (toText) import Data.Text (Text) import Data.Text qualified as Text +import Diag.Diagnostic qualified as DI +import Effect.Logger (renderIt) import GHC.Generics (Generic) import Options.Applicative (Parser, argument, help, metavar, str) import Prettyprinter (pretty, vsep) @@ -60,10 +62,13 @@ defaultDockerHost = "/var/run/docker.sock" newtype NotSupportedHostScheme = NotSupportedHostScheme Text instance ToDiagnostic NotSupportedHostScheme where - renderDiagnostic (NotSupportedHostScheme provided) = - vsep - [ "Only unix domain sockets are supported for DOCKER_HOST value." - , pretty $ "Provided 'DOCKER_HOST' via environment variable: " <> provided - , "" - , pretty $ "fossa will use: " <> "unix://" <> defaultDockerHost <> " instead, to connect with docker engine api (if needed)." - ] + renderDiagnostic (NotSupportedHostScheme provided) = do + let header = "Host scheme not supported" + content = + renderIt $ + vsep + [ "Only unix domain sockets are supported for DOCKER_HOST value." + , pretty $ "fossa will use: " <> "unix://" <> defaultDockerHost <> " instead, to connect with docker engine api (if needed)." + ] + ctx = "Provided 'DOCKER_HOST' via environment variable: " <> provided + DI.DiagnosticInfo (Just header) (Just content) Nothing Nothing Nothing (Just ctx) Nothing diff --git a/src/App/Fossa/Config/Report.hs b/src/App/Fossa/Config/Report.hs index 8108f95366..fe7b5e361a 100644 --- a/src/App/Fossa/Config/Report.hs +++ b/src/App/Fossa/Config/Report.hs @@ -28,8 +28,10 @@ import Control.Effect.Diagnostics (Diagnostics, ToDiagnostic (renderDiagnostic), import Control.Effect.Lift (Has, Lift) import Control.Timeout (Duration (Seconds)) import Data.Aeson (ToJSON (toEncoding), defaultOptions, genericToEncoding) +import Data.Error (SourceLocation, getSourceLocation) import Data.List (intercalate) import Data.String.Conversion (ToText, toText) +import Diag.Diagnostic qualified as DI import Effect.Exec (Exec) import Effect.Logger (Logger, Severity (..)) import Effect.ReadFS (ReadFS) @@ -202,26 +204,26 @@ mergeOpts cfgfile envvars ReportCliOptions{..} = do <*> pure cliReportType <*> revision -data NoFormatProvided = NoFormatProvided +newtype NoFormatProvided = NoFormatProvided SourceLocation instance ToDiagnostic NoFormatProvided where - renderDiagnostic NoFormatProvided = - pretty $ - "Provide a format option via '--format' to render this report. Supported formats: " - <> (toText reportOutputFormatList) + renderDiagnostic :: NoFormatProvided -> DI.DiagnosticInfo + renderDiagnostic (NoFormatProvided srcLoc) = do + let header = "No format provided" + helpMsg = "Provide a format option via '--format' to render this report. Supported formats: " <> (toText reportOutputFormatList) + DI.DiagnosticInfo (Just header) Nothing Nothing Nothing (Just helpMsg) Nothing (Just srcLoc) -newtype InvalidReportFormat = InvalidReportFormat String +data InvalidReportFormat = InvalidReportFormat SourceLocation String instance ToDiagnostic InvalidReportFormat where - renderDiagnostic (InvalidReportFormat fmt) = - pretty $ - "Report format " - <> toText fmt - <> " is not supported. Supported formats: " - <> (toText reportOutputFormatList) + renderDiagnostic (InvalidReportFormat srcLoc fmt) = do + let header = "Invalid report format" + ctxMsg = "Report format " <> toText fmt <> " is not supported" + helpMsg = "Provide a supported format. Supported formats: " <> (toText reportOutputFormatList) + DI.DiagnosticInfo (Just header) Nothing Nothing Nothing (Just helpMsg) (Just ctxMsg) (Just srcLoc) validateOutputFormat :: Has Diagnostics sig m => Bool -> Maybe String -> m ReportOutputFormat validateOutputFormat True _ = pure ReportJson -validateOutputFormat False Nothing = fatal NoFormatProvided -validateOutputFormat False (Just format) = fromMaybe (InvalidReportFormat format) $ parseReportOutputFormat format +validateOutputFormat False Nothing = fatal $ NoFormatProvided getSourceLocation +validateOutputFormat False (Just format) = fromMaybe (InvalidReportFormat getSourceLocation format) $ parseReportOutputFormat format data ReportConfig = ReportConfig { apiOpts :: ApiOpts diff --git a/src/App/Fossa/Container/Scan.hs b/src/App/Fossa/Container/Scan.hs index 71dd665710..582a5b9c54 100644 --- a/src/App/Fossa/Container/Scan.hs +++ b/src/App/Fossa/Container/Scan.hs @@ -35,6 +35,7 @@ import Data.Text (Text) import Data.Text qualified as Text import Data.Text.Extra (breakOnEndAndRemove) import Diag.Diagnostic qualified as Diag ( + DiagnosticInfo (..), ToDiagnostic (renderDiagnostic), ) import Discovery.Filters (AllFilters (..)) @@ -43,7 +44,6 @@ import Effect.Logger ( Logger, Pretty (pretty), logInfo, - vsep, ) import Effect.ReadFS (ReadFS, doesFileExist, getCurrentDir) import Path (Abs, File, Path, SomeBase (Abs, Rel), parseSomeFile, ()) @@ -191,11 +191,10 @@ parseDockerArchiveSource path = do newtype DockerEngineImageNotPresentLocally = DockerEngineImageNotPresentLocally Text instance ToDiagnostic DockerEngineImageNotPresentLocally where - renderDiagnostic (DockerEngineImageNotPresentLocally tag) = - vsep - [ pretty $ "Could not find: " <> (toString tag) <> " in local repository." - , pretty $ "Perform: docker pull " <> (toString tag) <> ", prior to running fossa." - ] + renderDiagnostic (DockerEngineImageNotPresentLocally tag) = do + let ctx = "Could not find: " <> tag <> " in local repository" + help = "Perform: docker pull " <> tag <> ", prior to running fossa." + Diag.DiagnosticInfo Nothing Nothing Nothing Nothing (Just help) (Just ctx) Nothing parsePodmanSource :: ( Has (Lift IO) sig m diff --git a/src/App/Fossa/LicenseScan.hs b/src/App/Fossa/LicenseScan.hs index 034fd5ee03..8f3b7e5b02 100644 --- a/src/App/Fossa/LicenseScan.hs +++ b/src/App/Fossa/LicenseScan.hs @@ -22,6 +22,7 @@ import App.Fossa.VendoredDependency ( dedupVendoredDeps, ) import App.Types (BaseDir (BaseDir), FullFileUploads (FullFileUploads)) +import Control.Carrier.Diagnostics qualified as Diag import Control.Carrier.StickyLogger ( Has, StickyLogger, @@ -31,30 +32,37 @@ import Control.Effect.Diagnostics (Diagnostics, ToDiagnostic, fromMaybe) import Control.Effect.Lift (Lift) import Data.Aeson (KeyValue ((.=)), ToJSON (toJSON), object) import Data.Aeson qualified as Aeson +import Data.Error (SourceLocation, getSourceLocation) import Data.List.NonEmpty (NonEmpty) import Data.List.NonEmpty qualified as NE import Data.String.Conversion (decodeUtf8) -import Diag.Diagnostic (ToDiagnostic (renderDiagnostic)) +import Diag.Diagnostic (DiagnosticInfo (..), ToDiagnostic (renderDiagnostic)) import Effect.Exec (Exec) -import Effect.Logger (Logger, Severity (SevInfo), logStdout) +import Effect.Logger (Logger, Severity (SevInfo), logStdout, renderIt) import Effect.ReadFS (ReadFS) import Path (Abs, Dir, Path) import Prettyprinter (vsep) import Srclib.Types (LicenseSourceUnit) import Types (LicenseScanPathFilters) -data MissingFossaDepsFile = MissingFossaDepsFile -data NoVendoredDeps = NoVendoredDeps +newtype MissingFossaDepsFile = MissingFossaDepsFile SourceLocation +newtype NoVendoredDeps = NoVendoredDeps SourceLocation instance ToDiagnostic MissingFossaDepsFile where - renderDiagnostic _ = - vsep - [ "'fossa license-scan fossa-deps' requires pointing to a directory with a fossa-deps file." - , "The file can have one of the extensions: .yaml .yml .json" - ] + renderDiagnostic (MissingFossaDepsFile srcLoc) = do + let header = "Missing fossa-deps file" + content = + renderIt $ + vsep + [ "'fossa license-scan fossa-deps' requires pointing to a directory with a fossa-deps file." + , "The file can have one of the extensions: .yaml .yml .json" + ] + DiagnosticInfo (Just header) (Just content) Nothing Nothing Nothing Nothing (Just srcLoc) instance ToDiagnostic NoVendoredDeps where - renderDiagnostic _ = "The 'vendored-dependencies' section of the fossa deps file is empty or missing." + renderDiagnostic (NoVendoredDeps srcLoc) = do + let header = "The 'vendored-dependencies' section of the fossa deps file is empty or missing." + DiagnosticInfo (Just header) Nothing Nothing Nothing Nothing Nothing (Just srcLoc) newtype UploadUnits = UploadUnits (NonEmpty LicenseSourceUnit) @@ -87,10 +95,11 @@ outputVendoredDeps :: BaseDir -> m () outputVendoredDeps (BaseDir dir) = runStickyLogger SevInfo $ do + Diag.fatal (NoVendoredDeps getSourceLocation) config <- resolveConfigFile dir Nothing - manualDepsFile <- fromMaybe MissingFossaDepsFile =<< findFossaDepsFile dir + manualDepsFile <- fromMaybe (MissingFossaDepsFile getSourceLocation) =<< findFossaDepsFile dir manualDeps <- readFoundDeps manualDepsFile - vendoredDeps <- fromMaybe NoVendoredDeps $ NE.nonEmpty $ vendoredDependencies manualDeps + vendoredDeps <- fromMaybe (NoVendoredDeps getSourceLocation) $ NE.nonEmpty $ vendoredDependencies manualDeps let licenseScanPathFilters = config >>= configVendoredDependencies >>= configLicenseScanPathFilters resultMap <- UploadUnits <$> runLicenseScan dir licenseScanPathFilters vendoredDeps logStdout . decodeUtf8 $ Aeson.encode resultMap diff --git a/src/App/Fossa/ManualDeps.hs b/src/App/Fossa/ManualDeps.hs index 836ebc5271..1cd2963d22 100644 --- a/src/App/Fossa/ManualDeps.hs +++ b/src/App/Fossa/ManualDeps.hs @@ -49,6 +49,7 @@ import Data.Aeson ( ) import Data.Aeson.Extra (TextLike (unTextLike), forbidMembers, neText) import Data.Aeson.Types (Object, Parser, prependFailure) +import Data.Error (SourceLocation) import Data.Functor.Extra ((<$$>)) import Data.List.NonEmpty (NonEmpty) import Data.List.NonEmpty qualified as NE @@ -429,24 +430,24 @@ instance FromJSON ReferencedDependency where <$> (obj `neText` "name") <*> pure depType <*> (unTextLike <$$> obj .:? "version") - <* forbidNonRefDepFields obj - <* forbidLinuxFields depType obj - <* forbidEpoch depType obj + <* forbidNonRefDepFields obj + <* forbidLinuxFields depType obj + <* forbidEpoch depType obj ) parseApkOrDebDependency :: Object -> DepType -> Parser ReferencedDependency parseApkOrDebDependency obj depType = LinuxApkDebDep <$> parseLinuxDependency obj depType - <* forbidNonRefDepFields obj - <* forbidEpoch depType obj + <* forbidNonRefDepFields obj + <* forbidEpoch depType obj parseRpmDependency :: Object -> DepType -> Parser ReferencedDependency parseRpmDependency obj depType = LinuxRpmDep <$> parseLinuxDependency obj depType <*> (unTextLike <$$> obj .:? "epoch") - <* forbidNonRefDepFields obj + <* forbidNonRefDepFields obj parseLinuxDependency :: Object -> DepType -> Parser LinuxReferenceDependency parseLinuxDependency obj depType = @@ -513,7 +514,7 @@ instance FromJSON CustomDependency where <*> (obj `neText` "license") <*> obj .:? "metadata" - <* forbidMembers "custom dependencies" ["type", "path", "url"] obj + <* forbidMembers "custom dependencies" ["type", "path", "url"] obj instance FromJSON RemoteDependency where parseJSON = withObject "RemoteDependency" $ \obj -> do @@ -523,7 +524,7 @@ instance FromJSON RemoteDependency where <*> (obj `neText` "url") <*> obj .:? "metadata" - <* forbidMembers "remote dependencies" ["license", "path", "type"] obj + <* forbidMembers "remote dependencies" ["license", "path", "type"] obj validateRemoteDep :: (Has Diagnostics sig m) => RemoteDependency -> Organization -> m RemoteDependency validateRemoteDep r org = @@ -549,10 +550,10 @@ validateRemoteDep r org = maxUrlRevLength :: Int maxUrlRevLength = maxLocatorLength - Text.length requiredChars -newtype RemoteDepLengthIsGtThanAllowed = RemoteDepLengthIsGtThanAllowed (RemoteDependency, Int) +newtype RemoteDepLengthIsGtThanAllowed = RemoteDepLengthIsGtThanAllowed SourceLocation (RemoteDependency, Int) instance ToDiagnostic RemoteDepLengthIsGtThanAllowed where - renderDiagnostic (RemoteDepLengthIsGtThanAllowed (r, maxLen)) = + renderDiagnostic (RemoteDepLengthIsGtThanAllowed srcLoc (r, maxLen)) = do vsep [ "You provided remote-dependency: " , "" @@ -579,7 +580,7 @@ instance FromJSON DependencyMetadata where .:? "description" <*> obj .:? "homepage" - <* forbidMembers "metadata" ["url"] obj + <* forbidMembers "metadata" ["url"] obj -- Parse supported dependency types into their respective type or return Nothing. depTypeFromText :: Text -> Maybe DepType diff --git a/src/App/Fossa/ProjectInference.hs b/src/App/Fossa/ProjectInference.hs index 6b60ec9e13..d1b4afb5f4 100644 --- a/src/App/Fossa/ProjectInference.hs +++ b/src/App/Fossa/ProjectInference.hs @@ -31,6 +31,7 @@ import Data.Text qualified as Text import Data.Text.IO qualified as TIO import Data.Time.Clock.POSIX (getCurrentTime) import Data.Time.Format.ISO8601 (iso8601Show) +import Diag.Diagnostic qualified as D import Effect.Exec import Effect.Logger import Effect.ReadFS @@ -240,13 +241,27 @@ data InferenceError instance ToDiagnostic InferenceError where renderDiagnostic = \case - InvalidRemote -> "Missing 'origin' git remote" - GitConfigParse err -> "An error occurred when parsing the git config: " <> pretty err - MissingGitConfig -> "Missing .git/config file" - MissingGitHead -> "Missing .git/HEAD file" - InvalidBranchName branch -> "Invalid branch name: " <> pretty branch - MissingBranch branch -> "Missing ref file for current branch: " <> pretty branch - MissingGitDir -> "Could not find .git directory in the current or any parent directory" + InvalidRemote -> do + let header = "Missing 'origin' git remote" + D.DiagnosticInfo (Just header) Nothing Nothing Nothing Nothing Nothing Nothing + GitConfigParse err -> do + let header = "An error occurred when parsing the git config: " <> err + D.DiagnosticInfo (Just header) Nothing Nothing Nothing Nothing Nothing Nothing + MissingGitConfig -> do + let header = "Missing .git/config file" + D.DiagnosticInfo (Just header) Nothing Nothing Nothing Nothing Nothing Nothing + MissingGitHead -> do + let header = "Missing .git/HEAD file" + D.DiagnosticInfo (Just header) Nothing Nothing Nothing Nothing Nothing Nothing + InvalidBranchName branch -> do + let header = "Invalid branch name: " <> branch + D.DiagnosticInfo (Just header) Nothing Nothing Nothing Nothing Nothing Nothing + MissingBranch branch -> do + let header = "Missing ref file for current branch: " <> branch + D.DiagnosticInfo (Just header) Nothing Nothing Nothing Nothing Nothing Nothing + MissingGitDir -> do + let header = "Could not find .git directory in the current or any parent directory" + D.DiagnosticInfo (Just header) Nothing Nothing Nothing Nothing Nothing Nothing data InferredProject = InferredProject { inferredName :: Text diff --git a/src/App/Fossa/VSI/DynLinked.hs b/src/App/Fossa/VSI/DynLinked.hs index 2292baf078..e92289b757 100644 --- a/src/App/Fossa/VSI/DynLinked.hs +++ b/src/App/Fossa/VSI/DynLinked.hs @@ -10,9 +10,10 @@ import Control.Effect.Diagnostics (Diagnostics, ToDiagnostic, context, errCtx, f import Control.Effect.Lift (Lift) import Control.Effect.Reader (Reader) import Data.String.Conversion (toText) +import Diag.Diagnostic qualified as DI import Discovery.Filters (AllFilters) import Effect.Exec (Exec) -import Effect.Logger (Logger, pretty) +import Effect.Logger (Logger) import Effect.ReadFS (ReadFS) import Path (Abs, Dir, Path) import Path.Extra (SomePath, resolveAbsolute) @@ -46,12 +47,18 @@ analyzeDynamicLinkedDeps root (target) = context "Analyze dynamic deps" . recove newtype SkippingDynamicDep = SkippingDynamicDep (SomePath) instance ToDiagnostic SkippingDynamicDep where - renderDiagnostic (SkippingDynamicDep path) = pretty $ "Skipping dynamic analysis for target: " <> show path + renderDiagnostic (SkippingDynamicDep path) = do + let header = "Skipping dynamic analysis for target: " <> toText (show path) + DI.DiagnosticInfo (Just header) Nothing Nothing Nothing Nothing Nothing Nothing data NotSupportedDistro = NotSupportedDistro instance ToDiagnostic NotSupportedDistro where - renderDiagnostic (NotSupportedDistro) = "fossa is executing in an environment that is not supported for dynamic link detection. Redhat and Debian based linux is currently supported." + renderDiagnostic (NotSupportedDistro) = do + let ctx = "Fossa is executing in an environment that is not supported for dynamic link detection. Redhat and Debian based linux is currently supported." + DI.DiagnosticInfo Nothing Nothing Nothing Nothing Nothing (Just ctx) Nothing data NoDependenciesFound = NoDependenciesFound instance ToDiagnostic NoDependenciesFound where - renderDiagnostic (NoDependenciesFound) = "no dynamic dependencies found in target executable" + renderDiagnostic (NoDependenciesFound) = do + let ctx = "no dynamic dependencies found in target executable" + DI.DiagnosticInfo Nothing Nothing Nothing Nothing Nothing (Just ctx) Nothing diff --git a/src/App/Fossa/VSI/DynLinked/Internal/Binary.hs b/src/App/Fossa/VSI/DynLinked/Internal/Binary.hs index 7c3597409d..abc8891c04 100644 --- a/src/App/Fossa/VSI/DynLinked/Internal/Binary.hs +++ b/src/App/Fossa/VSI/DynLinked/Internal/Binary.hs @@ -17,6 +17,7 @@ import Data.Set qualified as Set import Data.String.Conversion (ToString (toString), toText) import Data.Text (Text) import Data.Void (Void) +import Diag.Diagnostic qualified as D import Discovery.Filters (AllFilters) import Discovery.Walk (WalkStep (WalkContinue), walkWithFilters') import Effect.Exec (AllowErr (Never), Command (..), Exec, execParser) @@ -74,7 +75,9 @@ dynamicLinkedDependenciesSingle file = context ("Inspect " <> toText (show file) newtype SkippingDynamicDep = SkippingDynamicDep (Path Abs File) instance ToDiagnostic SkippingDynamicDep where - renderDiagnostic (SkippingDynamicDep target) = pretty $ "Skipping dynamic analysis for target: " <> show target + renderDiagnostic (SkippingDynamicDep target) = do + let header = "Skipping dynamic analysis for target: " <> toText (show target) + D.DiagnosticInfo (Just header) Nothing Nothing Nothing Nothing Nothing Nothing lddCommand :: Path Abs File -> Command lddCommand binaryPath = @@ -121,7 +124,7 @@ lddParseLocalDependencies = <|> try lddConsumeLinker <|> try lddParseDependency ) - <* eof + <* eof lddParseDependency :: Parser (Maybe LocalDependency) lddParseDependency = Just <$> (LocalDependency <$> (linePrefix *> ident) <* symbol "=>" <*> path <* printedHex) diff --git a/src/App/Fossa/VSI/DynLinked/Internal/Lookup.hs b/src/App/Fossa/VSI/DynLinked/Internal/Lookup.hs index b8e24ded0e..b4af3c47f4 100644 --- a/src/App/Fossa/VSI/DynLinked/Internal/Lookup.hs +++ b/src/App/Fossa/VSI/DynLinked/Internal/Lookup.hs @@ -18,9 +18,9 @@ import Control.Monad (join) import Data.Set (Set) import Data.Set qualified as Set import Data.String.Conversion (toText) +import Diag.Diagnostic qualified as DI import Effect.Exec (Exec) import Path (Abs, Dir, File, Path) -import Prettyprinter (pretty, vsep) -- | Resolve the provided file paths, which represent dynamic dependencies of a binary, into a set of @DynamicDependency@. dynamicDependencies :: @@ -59,8 +59,6 @@ fallbackTactic file = DynamicDependency file Nothing newtype MissingLinuxMetadata = MissingLinuxMetadata (Path Abs File) instance ToDiagnostic MissingLinuxMetadata where - renderDiagnostic (MissingLinuxMetadata path) = - vsep - [ "Could not determine owning system package for file:" - , pretty . show $ path - ] + renderDiagnostic (MissingLinuxMetadata path) = do + let header = "Could not determine owning system package for file: " <> (toText . show $ path) + DI.DiagnosticInfo (Just header) Nothing Nothing Nothing Nothing Nothing Nothing diff --git a/src/App/Fossa/VSI/Types.hs b/src/App/Fossa/VSI/Types.hs index 05f73158a2..fa5a97225c 100644 --- a/src/App/Fossa/VSI/Types.hs +++ b/src/App/Fossa/VSI/Types.hs @@ -35,7 +35,7 @@ import Data.String.Conversion (ToString, ToText, toText) import Data.Text (Text, isPrefixOf) import Data.Text qualified as Text import DepTypes (DepType (..), Dependency (..), VerConstraint (CEq)) -import Diag.Diagnostic (ToDiagnostic, renderDiagnostic) +import Diag.Diagnostic (DiagnosticInfo (..), ToDiagnostic, renderDiagnostic) import Effect.Logger (Pretty (pretty), viaShow) import GHC.Generics (Generic) import Srclib.Converter (depTypeToFetcher, fetcherToDepType) @@ -95,8 +95,9 @@ instance ToText LocatorParseError where "Revision is required on locator: " <> Srclib.renderLocator locator instance ToDiagnostic LocatorParseError where - renderDiagnostic (RevisionRequired locator) = - "Revision is required on locator: " <> viaShow locator + renderDiagnostic (RevisionRequired locator) = do + let header = toText $ "Revision is required on locator: " <> show locator + DiagnosticInfo (Just header) Nothing Nothing Nothing Nothing Nothing Nothing -- | VSI locally resolves the dependencies of some VSI dependencies using the FOSSA API. -- In the case where a user doesn't have access to view a project that is a dependency of their project, @@ -131,11 +132,11 @@ newtype ToDependencyError = UnsupportedLocator Locator deriving (Eq, Ord, Show) instance ToDiagnostic ToDependencyError where - renderDiagnostic (UnsupportedLocator locator) = - "Unsupported locator: Cannot convert fetcher " - <> pretty (locatorFetcher locator) - <> " to known dependency type. Locator: " - <> viaShow locator + renderDiagnostic (UnsupportedLocator locator) = do + let header = "Unsupported locator" + content = "Cannot convert fetcher " <> (locatorFetcher locator) <> " to known dependency type" + ctx = toText $ "Locator: " <> show locator + DiagnosticInfo (Just header) (Just content) Nothing Nothing Nothing (Just ctx) Nothing validateLocator :: Srclib.Locator -> Either LocatorParseError Locator validateLocator loc = Locator (Srclib.locatorFetcher loc) (Srclib.locatorProject loc) <$> validateRevision loc diff --git a/src/Control/Carrier/Diagnostics.hs b/src/Control/Carrier/Diagnostics.hs index a36adc9523..e1d51bf874 100644 --- a/src/Control/Carrier/Diagnostics.hs +++ b/src/Control/Carrier/Diagnostics.hs @@ -125,7 +125,8 @@ errorBoundaryIO act = errorBoundary $ act `safeCatch` (\(e :: SomeException) -> -- - On success, the associated warnings are logged with the provided -- @sevOnSuccess@ severity withResult :: Has Logger sig m => Severity -> Severity -> Result a -> (a -> m ()) -> m () -withResult sevOnErr _ (Failure ws eg) _ = Effect.Logger.log sevOnErr (renderFailure ws eg "An issue occurred") +withResult sevOnErr _ (Failure ws eg) _ = do + Effect.Logger.log sevOnErr (renderFailure ws eg "An issue occurred") withResult _ sevOnSuccess (Success ws res) f = do traverse_ (Effect.Logger.log sevOnSuccess) diff --git a/src/Control/Carrier/Git.hs b/src/Control/Carrier/Git.hs index 1b75f529d9..9de1b43437 100644 --- a/src/Control/Carrier/Git.hs +++ b/src/Control/Carrier/Git.hs @@ -30,6 +30,7 @@ import Data.Time ( parseTimeM, ) import Data.Time.Format.ISO8601 (iso8601Show) +import Diag.Diagnostic (DiagnosticInfo (..)) import Effect.Exec ( AllowErr (Never), Command (..), @@ -87,4 +88,6 @@ fetchGitContributors basedir = do data FailedToPerformGitLog = FailedToPerformGitLog instance ToDiagnostic FailedToPerformGitLog where - renderDiagnostic _ = "Could not retrieve git logs for contributor counting." + renderDiagnostic _ = do + let ctx = "Could not retrieve git logs for contributor counting." + DiagnosticInfo Nothing Nothing Nothing Nothing Nothing (Just ctx) Nothing \ No newline at end of file diff --git a/src/Data/Error.hs b/src/Data/Error.hs new file mode 100644 index 0000000000..f5948a5c17 --- /dev/null +++ b/src/Data/Error.hs @@ -0,0 +1,111 @@ +{-# LANGUAGE ImplicitParams #-} +{-# LANGUAGE RecordWildCards #-} + +module Data.Error ( + SourceLocation (..), + getSourceLocation, + buildErrorMessage, + buildHelpMessage, + buildDocumentationMessage, + buildContextMessage, + createBlock, + createBody, + createError, + renderErrors, +) where + +import Algebra.Graph.Export (render) +import Data.Maybe (fromMaybe) +import Data.Text (Text) +import Data.Text.Lazy qualified as TL +import Errata (Block (..), Pointer (..), blockSimple, errataSimple, prettyErrors) +import Errata.Source (Source (emptySource)) +import Errata.Styles (basicPointer, basicStyle, fancyRedPointer, fancyRedStyle, fancyStyle) +import Errata.Types (Errata (..)) +import GHC.Generics (Generic) +import GHC.Stack (CallStack, SrcLoc (..), getCallStack) + +-- SourceLocation captures the file path, line, and col at a given call site +-- SourceLocation will be used in conjuction with our errors +data SourceLocation = SourceLocation + { filePath :: FilePath + , line :: Int + , col :: Int + } + deriving (Eq, Ord, Show, Generic) + +-- getSourceLocation returns SourceLocation with the filePath, line, col of the call site +getSourceLocation :: (?callStack :: CallStack) => SourceLocation +getSourceLocation = case getCallStack ?callStack of + (_, loc) : _ -> SourceLocation (srcLocFile loc) (srcLocStartLine loc) (srcLocStartCol loc) + _ -> SourceLocation "Unknown" 0 0 + +createError :: Maybe Text -> [Block] -> Maybe Text -> Errata +createError = Errata + +-- wrapper to create an Errata block +createBlock :: SourceLocation -> Maybe Text -> Maybe Text -> Block +createBlock SourceLocation{..} maybeHeader = + Block + fancyStyle + (filePath, line, col) + maybeHeader + [] + +createBody :: Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Text +createBody maybeContent maybeDocumentation maybeSupport maybeHelp maybeContext = do + let content = fromMaybe "" maybeContent + documentation = maybe "" buildDocumentationMessage maybeDocumentation + support = maybe "" buildSupportMessage maybeSupport + help = maybe "" buildHelpMessage maybeHelp + context = maybe "" buildContextMessage maybeContext + + content <> documentation <> support <> help <> context + +-- red ANSI escape code +errorColor :: Text +errorColor = "\x1b[31m" + +-- yellow ANSI escape code +warningColor :: Text +warningColor = "\x1b[33m" + +-- blue ANSI escape code +supportColor :: Text +supportColor = "\x1b[34m" + +-- magenta ANSI escape code +documentationColor :: Text +documentationColor = "\x1b[35m" + +-- cyan ANSI escape code +helpColor :: Text +helpColor = "\x1b[36m" + +-- green ANSI escape code +contextColor :: Text +contextColor = "\x1b[32m" + +-- ANSI escape code to reset foreground text color +resetColor :: Text +resetColor = "\x1b[39m" + +buildErrorMessage :: Text -> Text +buildErrorMessage msg = errorColor <> "Error:" <> resetColor <> " " <> msg + +buildSupportMessage :: Text -> Text +buildSupportMessage msg = supportColor <> "Support:" <> resetColor <> " " <> msg <> "\n" + +buildDocumentationMessage :: Text -> Text +buildDocumentationMessage msg = documentationColor <> "Documentation:" <> resetColor <> " " <> msg <> "\n" + +buildHelpMessage :: Text -> Text +buildHelpMessage msg = helpColor <> "Help:" <> resetColor <> " " <> msg <> "\n" + +buildContextMessage :: Text -> Text +buildContextMessage msg = contextColor <> "Context:" <> resetColor <> " " <> msg + +renderErrors :: [Errata] -> TL.Text +renderErrors = + prettyErrors @String + emptySource \ No newline at end of file diff --git a/src/Diag/Common.hs b/src/Diag/Common.hs index 1da98cae81..c5e41858cc 100644 --- a/src/Diag/Common.hs +++ b/src/Diag/Common.hs @@ -4,19 +4,22 @@ module Diag.Common ( AllDirectDeps (..), ) where -import Diag.Diagnostic (ToDiagnostic (renderDiagnostic)) +import Diag.Diagnostic (DiagnosticInfo (..), ToDiagnostic (renderDiagnostic)) data MissingDeepDeps = MissingDeepDeps instance ToDiagnostic MissingDeepDeps where - renderDiagnostic (MissingDeepDeps) = - "Could not analyze deep dependencies." + renderDiagnostic (MissingDeepDeps) = do + let header = "Could not analyze deep dependencies." + DiagnosticInfo (Just header) Nothing Nothing Nothing Nothing Nothing Nothing data MissingEdges = MissingEdges instance ToDiagnostic MissingEdges where - renderDiagnostic (MissingEdges) = - "Could not analyze edges between dependencies." + renderDiagnostic (MissingEdges) = do + let header = "Could not analyze edges between dependencies." + DiagnosticInfo (Just header) Nothing Nothing Nothing Nothing Nothing Nothing data AllDirectDeps = AllDirectDeps instance ToDiagnostic AllDirectDeps where - renderDiagnostic (AllDirectDeps) = - "Could not differentiate between direct and deep dependencies, all dependencies will be reported as direct." + renderDiagnostic (AllDirectDeps) = do + let header = "Could not differentiate between direct and deep dependencies, all dependencies will be reported as direct." + DiagnosticInfo (Just header) Nothing Nothing Nothing Nothing Nothing Nothing diff --git a/src/Diag/Diagnostic.hs b/src/Diag/Diagnostic.hs index 86bb4e6938..41eb66b4d4 100644 --- a/src/Diag/Diagnostic.hs +++ b/src/Diag/Diagnostic.hs @@ -3,28 +3,53 @@ module Diag.Diagnostic ( -- * ToDiagnostic ToDiagnostic (..), SomeDiagnostic (..), + DiagnosticInfo (..), ) where import Control.Exception (SomeException (SomeException)) import Data.Aeson (ToJSON, object, toJSON, (.=)) +import Data.Error (SourceLocation) +import Data.String.Conversion (toText) import Data.Text (Text) -import Effect.Logger --- | A class of diagnostic types that can be rendered in a user-friendly way -class ToDiagnostic a where - renderDiagnostic :: a -> Doc AnsiStyle +data DiagnosticInfo = DiagnosticInfo + { header :: Maybe Text + , content :: Maybe Text + , documentation :: Maybe [Text] + , support :: Maybe Text + , help :: Maybe Text + , context :: Maybe Text + , sourceLocation :: Maybe SourceLocation + } + deriving (Eq, Ord, Show) -instance ToDiagnostic (Doc AnsiStyle) where - renderDiagnostic = id +class ToDiagnostic a where + renderDiagnostic :: a -> DiagnosticInfo instance ToDiagnostic Text where - renderDiagnostic = pretty - -instance ToDiagnostic String where - renderDiagnostic = pretty + renderDiagnostic t = DiagnosticInfo (Just t) Nothing Nothing Nothing Nothing Nothing Nothing instance ToDiagnostic SomeException where - renderDiagnostic (SomeException exc) = "An exception occurred: " <> pretty (show exc) + renderDiagnostic (SomeException exc) = DiagnosticInfo (Just $ "An exception occurred:" <> toText (show exc)) Nothing Nothing Nothing Nothing Nothing Nothing + +-- | A class of diagnostic types that can be rendered in a user-friendly way +-- class ToDiagnostic a where +-- renderDiagnostic :: a -> Doc AnsiStyle + +-- instance ToDiagnostic (Doc AnsiStyle) where +-- renderDiagnostic = id + +-- instance ToDiagnostic Text where +-- renderDiagnostic = pretty + +-- instance ToDiagnostic String where +-- renderDiagnostic = pretty + +-- instance ToDiagnostic Errata where +-- renderDiagnostic err = pretty $ renderErrors [err] + +-- instance ToDiagnostic SomeException where +-- renderDiagnostic (SomeException exc) = "An exception occurred: " <> pretty (show exc) -- | An error with a ToDiagnostic instance and an associated stack trace data SomeDiagnostic where diff --git a/src/Strategy/AlpineLinux/Parser.hs b/src/Strategy/AlpineLinux/Parser.hs index 8d323c429d..f511624fd8 100644 --- a/src/Strategy/AlpineLinux/Parser.hs +++ b/src/Strategy/AlpineLinux/Parser.hs @@ -50,6 +50,7 @@ import Data.String.Conversion (toText) import Data.Text (Text) import Data.Text qualified as Text import Data.Void (Void) +import Diag.Diagnostic (DiagnosticInfo (..)) import Effect.Logger (pretty) import Strategy.AlpineLinux.Types (AlpinePackage (..)) import Text.Megaparsec ( @@ -73,9 +74,15 @@ data PackageError deriving (Show, Eq, Ord) instance ToDiagnostic PackageError where - renderDiagnostic MissingPackageName = "Could not identify alpine package name" - renderDiagnostic (MissingPackageArchitecture name) = pretty $ "Could not identify architecture associated with " <> name - renderDiagnostic (MissingPackageVersion name) = pretty $ "Could not identify version associated with " <> name + renderDiagnostic MissingPackageName = do + let header = "Could not identify alpine package name" + DiagnosticInfo (Just header) Nothing Nothing Nothing Nothing Nothing Nothing + renderDiagnostic (MissingPackageArchitecture name) = do + let header = "Could not identify architecture associated with " <> name + DiagnosticInfo (Just header) Nothing Nothing Nothing Nothing Nothing Nothing + renderDiagnostic (MissingPackageVersion name) = do + let header = "Could not identify version associated with " <> name + DiagnosticInfo (Just header) Nothing Nothing Nothing Nothing Nothing Nothing type Parser = Parsec Void Text diff --git a/src/Strategy/Carthage.hs b/src/Strategy/Carthage.hs index 8155bd6b81..ef42a660e9 100644 --- a/src/Strategy/Carthage.hs +++ b/src/Strategy/Carthage.hs @@ -37,6 +37,7 @@ import DepTypes ( Dependency (..), VerConstraint (CEq), ) +import Diag.Diagnostic qualified as DI import Discovery.Filters (AllFilters) import Discovery.Simple (simpleDiscover) import Discovery.Walk ( @@ -183,16 +184,16 @@ analyze topPath = evalGrapher $ do newtype MissingCarthageDeepDep = MissingCarthageDeepDep ResolvedEntry instance ToDiagnostic MissingCarthageDeepDep where - renderDiagnostic (MissingCarthageDeepDep entry) = pretty $ "Failed to find transitive dependencies for: " <> (resolvedName entry) + renderDiagnostic (MissingCarthageDeepDep entry) = do + let header = "Failed to find transitive dependencies for: " <> (resolvedName entry) + DI.DiagnosticInfo (Just header) Nothing Nothing Nothing Nothing Nothing Nothing newtype MissingResolvedFile = MissingResolvedFile (Path Abs File) instance ToDiagnostic MissingResolvedFile where - renderDiagnostic (MissingResolvedFile path) = - vsep - [ "We could not find or parse resolved file in: " <> (viaShow path) - , "" - , "Ensure your carthage project is built prior to running fossa." - ] + renderDiagnostic (MissingResolvedFile path) = do + let ctx = "Could not find or parse resolved file in: " <> toText (show path) + help = "Ensure your carthage project is built prior to running fossa" + DI.DiagnosticInfo Nothing Nothing Nothing Nothing (Just help) (Just ctx) Nothing entryToCheckoutName :: ResolvedEntry -> Text entryToCheckoutName entry = diff --git a/src/Strategy/Conan/ConanGraph.hs b/src/Strategy/Conan/ConanGraph.hs index 81bc2cc36f..fab6b7886d 100644 --- a/src/Strategy/Conan/ConanGraph.hs +++ b/src/Strategy/Conan/ConanGraph.hs @@ -39,7 +39,7 @@ import DepTypes ( Dependency (..), VerConstraint (CEq), ) -import Diag.Diagnostic (ToDiagnostic (renderDiagnostic)) +import Diag.Diagnostic (DiagnosticInfo (..), ToDiagnostic (renderDiagnostic)) import Effect.Exec ( AllowErr (Never), Command (..), @@ -309,12 +309,7 @@ analyzeFromConanGraph dir = do data ConanV2IsRequired = ConanV2IsRequired instance ToDiagnostic ConanV2IsRequired where - renderDiagnostic (ConanV2IsRequired) = - vsep - [ "Conan analysis requires conan v2.0.0 or greater" - , "" - , indent 2 $ - vsep - [ "Ensure you are using conan v2. You can check this by running, conan --version" - ] - ] + renderDiagnostic (ConanV2IsRequired) = do + let ctx = "Conan analysis requires conan v2.0.0 or greater" + help = "Ensure you are using conan v2 by running, conan --version" + DiagnosticInfo Nothing Nothing Nothing Nothing (Just help) (Just ctx) Nothing diff --git a/src/Strategy/Conan/Enrich.hs b/src/Strategy/Conan/Enrich.hs index e30330402b..baeb1af842 100644 --- a/src/Strategy/Conan/Enrich.hs +++ b/src/Strategy/Conan/Enrich.hs @@ -16,6 +16,7 @@ import Control.Effect.FossaApiClient (FossaApiClient) import Control.Effect.StickyLogger (StickyLogger) import Control.Monad (unless) import Data.Either (partitionEithers) +import Data.Error (SourceLocation, getSourceLocation) import Data.List (find) import Data.List.NonEmpty (NonEmpty, nonEmpty, toList) import Data.List.NonEmpty qualified as NE @@ -26,9 +27,9 @@ import Data.String.Conversion (toText) import Data.Text (Text, intercalate) import Data.Text.Extra (splitOnceOn) import DepTypes (DepType (ArchiveType, ConanType), Dependency (..), VerConstraint (CEq)) -import Diag.Diagnostic (ToDiagnostic (renderDiagnostic)) +import Diag.Diagnostic (DiagnosticInfo (..), ToDiagnostic (renderDiagnostic)) import Effect.Exec (Exec) -import Effect.Logger (Logger, indent, pretty, vsep) +import Effect.Logger (Logger, indent, pretty, renderIt, vsep) import Effect.ReadFS (ReadFS) import Graphing (Graphing, gmap, vertexList) import Path (Abs, Dir, Path) @@ -62,7 +63,7 @@ conanToArchives rootPath fullfileUploads g = -- need to do any work! case (null unableToTransformConanDep, transformedVendorDep) of (True, Nothing) -> pure g - (False, _) -> fatal $ FailedToTransformConanDependency unableToTransformConanDep + (False, _) -> fatal $ FailedToTransformConanDependency getSourceLocation unableToTransformConanDep (True, Just depsAndVendorDeps) -> do let vendorDeps = NE.map snd depsAndVendorDeps @@ -88,13 +89,13 @@ conanToArchives rootPath fullfileUploads g = unless (null failed) $ fatal $ - FailedToTransformLocators failed + FailedToTransformLocators getSourceLocation failed -- 3. We replace all conan dependencies with archive dependencies from -- original graph. If we are unable to find twin of archive dep -- (e.g. sourcing conan dep), we fail fatally! case fromList <$> archiveToConanDep archiveDeps of - Left lonelyArchiveDeps -> fatal $ UnableToFindTwinOfArchiveDep lonelyArchiveDeps + Left lonelyArchiveDeps -> fatal $ UnableToFindTwinOfArchiveDep getSourceLocation lonelyArchiveDeps Right registry -> pure $ gmap (\graphDep -> Map.findWithDefault graphDep graphDep registry) g where allDeps :: [Dependency] @@ -198,16 +199,16 @@ findArchiveTwin archiveDeps conanDep = case find unOrg :: Text -> Text unOrg t = snd $ splitOnceOn "/" t -newtype FailedToTransformConanDependency = FailedToTransformConanDependency [Dependency] +data FailedToTransformConanDependency = FailedToTransformConanDependency SourceLocation [Dependency] instance ToDiagnostic FailedToTransformConanDependency where - renderDiagnostic (FailedToTransformConanDependency deps) = - vsep - [ "We could not transform analyzed conan dependency to vendored dependency." - , "" - , indent 2 $ vsep $ map (pretty . renderDep) deps - , "" - , "Ensure location is provided for conan dependency." - ] + renderDiagnostic (FailedToTransformConanDependency srcLoc deps) = do + let header = "Could not transform analyzed conan dependency to vendored dependency" + content = + renderIt $ + vsep + [indent 2 $ vsep $ map (pretty . renderDep) deps] + help = "Ensure location is provided for conan dependency" + DiagnosticInfo (Just header) (Just content) Nothing Nothing (Just help) Nothing (Just srcLoc) where renderDep :: Dependency -> Text renderDep d = @@ -215,24 +216,26 @@ instance ToDiagnostic FailedToTransformConanDependency where <> " at: " <> intercalate "," (dependencyLocations d) -newtype FailedToTransformLocators = FailedToTransformLocators [Locator] +data FailedToTransformLocators = FailedToTransformLocators SourceLocation [Locator] instance ToDiagnostic FailedToTransformLocators where - renderDiagnostic (FailedToTransformLocators locs) = - vsep - [ "We could not transform vendored dependency to archive dependency." - , "" - , indent 2 $ vsep $ map (pretty . toText) locs - , "" - , "This is likely a defect, please contact FOSSA support!" - ] - -newtype UnableToFindTwinOfArchiveDep = UnableToFindTwinOfArchiveDep LonelyDeps + renderDiagnostic (FailedToTransformLocators srcLoc locs) = do + let header = "Could not transform vendored dependency to archive dependency" + content = + renderIt $ + vsep + [vsep $ map (pretty . toText) locs] + support = "This is likely a defect, please contact FOSSA support at: https://support.fossa.com/" + DiagnosticInfo (Just header) (Just content) Nothing (Just support) Nothing Nothing (Just srcLoc) + +data UnableToFindTwinOfArchiveDep = UnableToFindTwinOfArchiveDep SourceLocation LonelyDeps instance ToDiagnostic UnableToFindTwinOfArchiveDep where - renderDiagnostic (UnableToFindTwinOfArchiveDep (LonelyDeps deps)) = - vsep - [ "We could not identify conan dependency for following dependencies:" - , "" - , indent 2 $ vsep $ map (pretty . toText . toLocator) deps - , "" - , "This is likely a defect, please contact FOSSA support!" - ] + renderDiagnostic (UnableToFindTwinOfArchiveDep srcLoc (LonelyDeps deps)) = do + let header = "Could not identify conan dependency" + content = + renderIt $ + vsep + [ "We could not identify conan dependency for following dependencies:" + , indent 2 $ vsep $ map (pretty . toText . toLocator) deps + ] + support = "This is likely a defect, please contact FOSSA support at: https://support.fossa.com/" + DiagnosticInfo (Just header) (Just content) Nothing (Just support) Nothing Nothing (Just srcLoc) diff --git a/src/Strategy/Conda/CondaEnvCreate.hs b/src/Strategy/Conda/CondaEnvCreate.hs index 17ab28f388..5c58006012 100644 --- a/src/Strategy/Conda/CondaEnvCreate.hs +++ b/src/Strategy/Conda/CondaEnvCreate.hs @@ -110,9 +110,9 @@ parseCondaEnvDep = CondaEnvDep <$> parseChannel <*> takeWhile1P (Just "platform") (/= ':') - <* chunk "::" + <* chunk "::" <*> takeWhile1P (Just "package name") (/= '=') - <* chunk "==" + <* chunk "==" <*> takeWhile1P (Just "version") (/= '=') where -- Parse '/'. diff --git a/src/Strategy/Leiningen.hs b/src/Strategy/Leiningen.hs index e00770a4ca..2b77fa5f43 100644 --- a/src/Strategy/Leiningen.hs +++ b/src/Strategy/Leiningen.hs @@ -46,6 +46,7 @@ import Data.Text (Text) import Data.Text qualified as Text import Data.Text.Lazy qualified as TL import Data.Vector qualified as V +import Diag.Diagnostic qualified as DI import Discovery.Filters (AllFilters) import Discovery.Simple (simpleDiscover) import Discovery.Walk ( @@ -164,7 +165,9 @@ analyze file = do data FailedToRetrieveLeinDependencies = FailedToRetrieveLeinDependencies instance ToDiagnostic FailedToRetrieveLeinDependencies where - renderDiagnostic _ = "We could not successfully retrieve dependencies information using lein deps subcommand." + renderDiagnostic _ = do + let ctx = "Could not successfully retrieve dependencies information using lein deps subcommand" + DI.DiagnosticInfo Nothing Nothing Nothing Nothing Nothing (Just ctx) Nothing -- node type for our LabeledGrapher data ClojureNode = ClojureNode diff --git a/src/Strategy/Maven/PluginStrategy.hs b/src/Strategy/Maven/PluginStrategy.hs index 763e998823..4e73c14d7f 100644 --- a/src/Strategy/Maven/PluginStrategy.hs +++ b/src/Strategy/Maven/PluginStrategy.hs @@ -28,6 +28,7 @@ import DepTypes ( Dependency (..), VerConstraint (CEq), ) +import Diag.Diagnostic qualified as DI import Effect.Exec (CandidateCommandEffs) import Effect.Grapher (Grapher, edge, evalGrapher) import Effect.Grapher qualified as Grapher @@ -107,16 +108,21 @@ analyze dir plugin = do data MvnPluginInstallFailed = MvnPluginInstallFailed instance ToDiagnostic MvnPluginInstallFailed where - renderDiagnostic (MvnPluginInstallFailed) = "Failed to install maven plugin for analysis." + renderDiagnostic (MvnPluginInstallFailed) = do + let ctx = "Failed to install maven plugin for analysis" + DI.DiagnosticInfo Nothing Nothing Nothing Nothing Nothing (Just ctx) Nothing data MvnPluginExecFailed = MvnPluginExecFailed instance ToDiagnostic MvnPluginExecFailed where - renderDiagnostic (MvnPluginExecFailed) = "Failed to execute maven plugin for analysis." + renderDiagnostic (MvnPluginExecFailed) = do + let ctx = "Failed to execute maven plugin for analysis" + DI.DiagnosticInfo Nothing Nothing Nothing Nothing Nothing (Just ctx) Nothing data MayIncludeSubmodule = MayIncludeSubmodule instance ToDiagnostic MayIncludeSubmodule where - renderDiagnostic MayIncludeSubmodule = - "Failed to run reactor, submodules may be included in the output graph." + renderDiagnostic MayIncludeSubmodule = do + let header = "Failed to run reactor, submodules may be included in the output graph." + DI.DiagnosticInfo (Just header) Nothing Nothing Nothing Nothing Nothing Nothing -- | The graphs returned by the depgraph plugin look like this: -- diff --git a/src/Strategy/Nim/NimbleLock.hs b/src/Strategy/Nim/NimbleLock.hs index d53f979c61..bfcb8f9ecd 100644 --- a/src/Strategy/Nim/NimbleLock.hs +++ b/src/Strategy/Nim/NimbleLock.hs @@ -45,6 +45,7 @@ import DepTypes ( Dependency (Dependency), VerConstraint (CEq), ) +import Diag.Diagnostic qualified as DI import Effect.Exec (AllowErr (Always), Command (..), Exec, execJson) import Effect.ReadFS (Has, ReadFS, readContentsJson) import GHC.Generics (Generic) @@ -213,8 +214,12 @@ analyze' _ lockFile = do data MissingEdgesBetweenDirectDeps = MissingEdgesBetweenDirectDeps instance ToDiagnostic MissingEdgesBetweenDirectDeps where - renderDiagnostic _ = "Could not infer edges between direct dependencies." + renderDiagnostic _ = do + let header = "Could not infer edges between direct dependencies" + DI.DiagnosticInfo (Just header) Nothing Nothing Nothing Nothing Nothing Nothing data CmdNimbleDumpFailed = CmdNimbleDumpFailed instance ToDiagnostic CmdNimbleDumpFailed where - renderDiagnostic _ = "We could not retrieve nimble packages metadata using nimble's dump subcommand." + renderDiagnostic _ = do + let ctx = "Could not retrieve nimble packages metadata using nimble's dump subcommand." + DI.DiagnosticInfo Nothing Nothing Nothing Nothing Nothing (Just ctx) Nothing diff --git a/src/Strategy/Python/Pip.hs b/src/Strategy/Python/Pip.hs index 17c0e2e246..c7bf8a543f 100644 --- a/src/Strategy/Python/Pip.hs +++ b/src/Strategy/Python/Pip.hs @@ -12,7 +12,7 @@ import Data.String.Conversion (toText) import Data.Text (Text) import Data.Text qualified as Text import Data.Void (Void) -import Diag.Diagnostic (ToDiagnostic (..)) +import Diag.Diagnostic (DiagnosticInfo (..), ToDiagnostic (..)) import Effect.Exec ( AllowErr (Never), Command (..), @@ -48,10 +48,9 @@ data PythonPackage = PythonPackage data PipListCommandFailed = PipListCommandFailed instance ToDiagnostic PipListCommandFailed where - renderDiagnostic PipListCommandFailed = - vsep - [ "Failed to run pip command" - ] + renderDiagnostic PipListCommandFailed = do + let header = "Failed to run pip command" + DiagnosticInfo (Just header) Nothing Nothing Nothing Nothing Nothing Nothing pythonPip :: [Text] -> Command pythonPip args = diff --git a/src/Strategy/Python/ReqTxt.hs b/src/Strategy/Python/ReqTxt.hs index 76c66f5ef1..654768091b 100644 --- a/src/Strategy/Python/ReqTxt.hs +++ b/src/Strategy/Python/ReqTxt.hs @@ -6,12 +6,13 @@ module Strategy.Python.ReqTxt ( import Control.Effect.Diagnostics import Control.Monad (void) import Data.Foldable (asum) +import Data.String.Conversion (toText) import Data.Text (Text) import Data.Void (Void) +import Diag.Diagnostic qualified as DI import Effect.ReadFS import Graphing (Graphing) import Path -import Prettyprinter (Pretty (pretty), vsep) import Strategy.Python.Pip (PythonPackage) import Strategy.Python.Util import Text.Megaparsec @@ -25,14 +26,10 @@ analyze' packages file = do newtype ReqsTxtFailed = ReqsTxtFailed (Path Abs File) instance ToDiagnostic ReqsTxtFailed where - renderDiagnostic (ReqsTxtFailed path) = - vsep - [ pretty $ "Failed to parse: " <> show path - , "" - , "We occasionally find files we think are python requirements.txt files but" - , "aren't. If this file isn't a python requirements.txt file, this error can" - , "be safely ignored." - ] + renderDiagnostic (ReqsTxtFailed path) = do + let ctx = "Failed to parse: " <> toText (show path) + let help = "Ignore this error if this file isn't a python requirements.txt file." + DI.DiagnosticInfo Nothing Nothing Nothing Nothing (Just help) (Just ctx) Nothing type Parser = Parsec Void Text diff --git a/src/Strategy/Ruby/Errors.hs b/src/Strategy/Ruby/Errors.hs index a1e8ff82aa..b9d22d9eb6 100644 --- a/src/Strategy/Ruby/Errors.hs +++ b/src/Strategy/Ruby/Errors.hs @@ -7,10 +7,10 @@ module Strategy.Ruby.Errors ( ) where import App.Docs (strategyLangDocUrl) +import Data.String.Conversion (toText) import Data.Text (Text) -import Diag.Diagnostic (ToDiagnostic, renderDiagnostic) +import Diag.Diagnostic (DiagnosticInfo (..), ToDiagnostic, renderDiagnostic) import Path -import Prettyprinter (Pretty (pretty), indent, viaShow, vsep) bundlerLockFileRationaleUrl :: Text bundlerLockFileRationaleUrl = "https://bundler.io/rationale.html#sharing-your-application-with-other-developers" @@ -20,17 +20,8 @@ rubyFossaDocUrl = strategyLangDocUrl "ruby/ruby.md" newtype BundlerMissingLockFile = BundlerMissingLockFile (Path Abs File) instance ToDiagnostic BundlerMissingLockFile where - renderDiagnostic (BundlerMissingLockFile path) = - vsep - [ "We could not perform Gemfile.lock analysis for Gemfile: " <> viaShow path - , "" - , indent 2 $ - vsep - [ "Ensure valid Gemfile.lock exists, and is readable by user." - , "If you are using bundler, you can perform: `bundler install` to generate Gemfile.lock." - ] - , "" - , "Refer to:" - , indent 2 $ pretty $ "- " <> bundlerLockFileRationaleUrl - , indent 2 $ pretty $ "- " <> rubyFossaDocUrl - ] + renderDiagnostic (BundlerMissingLockFile path) = do + let ctx = "We could not perform Gemfile.lock analysis for Gemfile: " <> toText (show path) + help = "Ensure valid Gemfile.lock exists, and is readable by user. If you are using bundler, run `bundler install` to generate Gemfile.lock." + documentationReferences = [rubyFossaDocUrl, bundlerLockFileRationaleUrl] + DiagnosticInfo Nothing Nothing (Just documentationReferences) Nothing (Just help) (Just ctx) Nothing diff --git a/src/Strategy/Swift/Errors.hs b/src/Strategy/Swift/Errors.hs index 3cc04ccfdd..e9637fa1ab 100644 --- a/src/Strategy/Swift/Errors.hs +++ b/src/Strategy/Swift/Errors.hs @@ -8,8 +8,9 @@ module Strategy.Swift.Errors ( ) where import App.Docs (platformDocUrl) +import Data.String.Conversion (toText) import Data.Text (Text) -import Diag.Diagnostic (ToDiagnostic, renderDiagnostic) +import Diag.Diagnostic (DiagnosticInfo (..), ToDiagnostic, renderDiagnostic) import Path import Prettyprinter (Pretty (pretty), indent, viaShow, vsep) @@ -25,17 +26,8 @@ xcodeCoordinatePkgVersion = "https://developer.apple.com/documentation/swift_pac newtype MissingPackageResolvedFile = MissingPackageResolvedFile (Path Abs File) instance ToDiagnostic MissingPackageResolvedFile where - renderDiagnostic (MissingPackageResolvedFile path) = - vsep - [ "We could not perform Package.resolved analysis for: " <> viaShow path - , "" - , indent 2 $ - vsep - [ "Ensure valid Package.resolved exists, and is readable by user." - ] - , "" - , "Refer to:" - , indent 2 $ pretty $ "- " <> swiftPackageResolvedRef - , indent 2 $ pretty $ "- " <> xcodeCoordinatePkgVersion - , indent 2 $ pretty $ "- " <> swiftFossaDocUrl - ] + renderDiagnostic (MissingPackageResolvedFile path) = do + let ctx = "We could not perform Package.resolved analysis for: " <> toText (show path) + help = "Ensure valid Package.resolved exists, and is readable by user" + documentationReferences = [swiftPackageResolvedRef, xcodeCoordinatePkgVersion, swiftFossaDocUrl] + DiagnosticInfo Nothing Nothing (Just documentationReferences) Nothing (Just help) (Just ctx) Nothing diff --git a/src/Strategy/Swift/Xcode/Pbxproj.hs b/src/Strategy/Swift/Xcode/Pbxproj.hs index 52784d7a9b..2ed600341b 100644 --- a/src/Strategy/Swift/Xcode/Pbxproj.hs +++ b/src/Strategy/Swift/Xcode/Pbxproj.hs @@ -13,9 +13,11 @@ import Data.Map (Map) import Data.Map.Strict qualified as Map import Data.Maybe (mapMaybe) import Data.Set (fromList, member) +import Data.String.Conversion (toText) import Data.Text (Text) import DepTypes (DepType (GitType, SwiftType), Dependency (..)) import Diag.Common (MissingDeepDeps (MissingDeepDeps)) +import Diag.Diagnostic qualified as DI import Effect.ReadFS (Has, ReadFS, readContentsJson, readContentsParser) import Graphing (Graphing, deeps, directs, promoteToDirect) import Path @@ -100,7 +102,9 @@ buildGraph projFile maybeResolvedContent = newtype FailedToParseProjFile = FailedToParseProjFile (Path Abs File) instance ToDiagnostic FailedToParseProjFile where - renderDiagnostic (FailedToParseProjFile path) = "Could not parse project.pbxproj file " <> viaShow path + renderDiagnostic (FailedToParseProjFile path) = do + let ctx = "Could not parse project.pbxproj file: " <> toText (show path) + DI.DiagnosticInfo Nothing Nothing Nothing Nothing Nothing (Just ctx) Nothing -- | Checks if XCode Project File has at-least one swift dependency. -- It does by counting instances of `XCRemoteSwiftPackageReference` in the project file. From c7c997281a60cdc6ea11e628a5ca6d9595581ff4 Mon Sep 17 00:00:00 2001 From: Jeffrey Huynh Date: Wed, 17 Jan 2024 09:47:04 -0800 Subject: [PATCH 03/17] Initial implementation --- src/App/Fossa/API/BuildWait.hs | 20 +- src/App/Fossa/Analyze.hs | 73 +- src/App/Fossa/BinaryDeps/Jar.hs | 12 +- src/App/Fossa/Config/ConfigFile.hs | 26 +- src/App/Fossa/Config/Container/Common.hs | 8 +- src/App/Fossa/Config/Report.hs | 30 +- src/App/Fossa/Config/Test.hs | 11 +- src/App/Fossa/Container/AnalyzeNative.hs | 3 +- src/App/Fossa/Container/Scan.hs | 11 +- src/App/Fossa/LicenseScan.hs | 13 +- src/App/Fossa/LicenseScanner.hs | 54 +- src/App/Fossa/ManualDeps.hs | 48 +- src/App/Fossa/ProjectInference.hs | 17 +- src/App/Fossa/VSI/DynLinked.hs | 12 +- .../Fossa/VSI/DynLinked/Internal/Binary.hs | 4 +- .../Fossa/VSI/DynLinked/Internal/Lookup.hs | 4 +- src/App/Fossa/VSI/Types.hs | 12 +- src/App/Support.hs | 61 +- src/Container/Docker/OciManifest.hs | 35 +- src/Container/Errors.hs | 35 +- src/Control/Carrier/ContainerRegistryApi.hs | 2 + .../Carrier/ContainerRegistryApi/Errors.hs | 60 +- .../FossaApiClient/Internal/FossaAPIV1.hs | 773 +++++++++++------- src/Control/Carrier/Git.hs | 6 +- src/Data/Error.hs | 91 +-- src/Data/String/Conversion.hs | 3 + src/Diag/Common.hs | 9 +- src/Diag/Diagnostic.hs | 23 +- src/Diag/Result.hs | 90 +- src/Discovery/Archive.hs | 17 +- src/Effect/Exec.hs | 68 +- src/Effect/Grapher.hs | 5 +- src/Effect/ReadFS.hs | 97 ++- src/Strategy/AlpineLinux/Parser.hs | 8 +- src/Strategy/Bundler.hs | 9 +- src/Strategy/Cargo.hs | 10 +- src/Strategy/Carthage.hs | 23 +- src/Strategy/Cocoapods.hs | 13 +- src/Strategy/Cocoapods/Errors.hs | 21 +- src/Strategy/Conan/ConanGraph.hs | 21 +- src/Strategy/Conan/Enrich.hs | 37 +- src/Strategy/Dart/Errors.hs | 21 +- src/Strategy/Go/GoListPackages.hs | 36 +- src/Strategy/Go/Transitive.hs | 9 +- src/Strategy/Googlesource/RepoManifest.hs | 13 +- src/Strategy/Gradle.hs | 10 +- src/Strategy/Gradle/Errors.hs | 46 +- src/Strategy/Haskell/Cabal.hs | 5 +- src/Strategy/Leiningen.hs | 6 +- src/Strategy/Maven/PluginStrategy.hs | 12 +- src/Strategy/Nim/NimbleLock.hs | 7 +- src/Strategy/Node.hs | 11 +- src/Strategy/Node/Errors.hs | 44 +- src/Strategy/Node/YarnV1/YarnLock.hs | 26 +- src/Strategy/Pub.hs | 11 +- src/Strategy/Python/Errors.hs | 44 +- src/Strategy/Python/Pip.hs | 5 +- src/Strategy/Python/Pipenv.hs | 6 +- src/Strategy/Python/Poetry.hs | 9 +- src/Strategy/Python/ReqTxt.hs | 18 +- src/Strategy/R.hs | 8 +- src/Strategy/R/Errors.hs | 44 +- src/Strategy/Ruby/Errors.hs | 19 +- src/Strategy/Scala.hs | 27 +- src/Strategy/Scala/Errors.hs | 56 +- src/Strategy/Swift/Errors.hs | 18 +- src/Strategy/Swift/PackageSwift.hs | 8 +- src/Strategy/Swift/Xcode/Pbxproj.hs | 19 +- 68 files changed, 1353 insertions(+), 1060 deletions(-) diff --git a/src/App/Fossa/API/BuildWait.hs b/src/App/Fossa/API/BuildWait.hs index 0da11c2c2b..cfc64cc6bd 100644 --- a/src/App/Fossa/API/BuildWait.hs +++ b/src/App/Fossa/API/BuildWait.hs @@ -28,7 +28,9 @@ import Control.Effect.FossaApiClient ( import Control.Effect.StickyLogger (StickyLogger, logSticky') import Control.Monad (void, when) import Control.Timeout (Cancel, checkForCancel, delay) +import Data.Error (SourceLocation, createBlock, getSourceLocation) import Effect.Logger (Logger, viaShow) +import Errata (errataSimple) import Fossa.API.Types ( ApiOpts (apiOptsPollDelay), Build (buildTask), @@ -43,14 +45,20 @@ import Fossa.API.Types ( data WaitError = -- | We encountered the FAILED status on a build - BuildFailed + BuildFailed SourceLocation | -- | We ran out of time locally, and aborted - LocalTimeout + LocalTimeout SourceLocation deriving (Eq, Ord, Show) instance ToDiagnostic WaitError where - renderDiagnostic BuildFailed = "The build failed. Check the FOSSA webapp for more details." - renderDiagnostic LocalTimeout = "Build/Issue scan was not completed on the FOSSA server, and the --timeout duration has expired." + renderDiagnostic (BuildFailed srcLoc) = do + let header = "The build failed. Check the FOSSA webapp for more details" + block = createBlock srcLoc Nothing Nothing + errataSimple (Just header) block Nothing + renderDiagnostic (LocalTimeout srcLoc) = do + let header = "Build/Issue scan was not completed on the FOSSA server, and the --timeout duration has expired" + block = createBlock srcLoc Nothing Nothing + errataSimple (Just header) block Nothing -- | Wait for either a normal build completion or a monorepo scan completion. -- Try to detect the correct method, use provided fallback @@ -107,7 +115,7 @@ waitForBuild revision cancelFlag = do case buildTaskStatus (buildTask build) of StatusSucceeded -> pure () - StatusFailed -> fatal BuildFailed + StatusFailed -> fatal $ BuildFailed getSourceLocation otherStatus -> do logSticky' $ "[ Waiting for build completion... last status: " <> viaShow otherStatus <> " ]" pauseForRetry @@ -121,7 +129,7 @@ checkForTimeout :: ) => Cancel -> m () -checkForTimeout = checkForCancel LocalTimeout +checkForTimeout = checkForCancel $ LocalTimeout getSourceLocation pauseForRetry :: ( Has (Lift IO) sig m diff --git a/src/App/Fossa/Analyze.hs b/src/App/Fossa/Analyze.hs index ad5ff6859d..cbee5bb9f2 100644 --- a/src/App/Fossa/Analyze.hs +++ b/src/App/Fossa/Analyze.hs @@ -98,6 +98,7 @@ import Data.Foldable (traverse_) import Data.List.NonEmpty qualified as NE import Data.Maybe (fromMaybe, mapMaybe) import Data.String.Conversion (decodeUtf8, toText) +import Data.Text (Text) import Data.Text.Extra (showT) import Diag.Diagnostic as DI import Diag.Result (resultToMaybe) @@ -114,6 +115,7 @@ import Effect.Logger ( renderIt, ) import Effect.ReadFS (ReadFS) +import Errata (errataSimple) import Errata qualified as E import Path (Abs, Dir, Path, toFilePath) import Path.IO (makeRelative) @@ -260,10 +262,7 @@ analyze :: m Aeson.Value analyze cfg = Diag.context "fossa-analyze" $ do capabilities <- sendIO getNumCapabilities - logDebug "highihi" - -- sendIO execute - logInfo "After --------" - Diag.fatal $ ErrOnlyKeywordSearchResultsFound getSourceLocation + Diag.errHelp ("Make sure your project is supported" :: Text) $ Diag.errDoc userGuideUrl $ Diag.errSupport ("fjslfjs" :: Text) $ Diag.errCtx ("Testing context" :: Text) $ Diag.fatal $ ErrNoProjectsDiscovered getSourceLocation let maybeApiOpts = case destination of OutputStdout -> Nothing UploadScan opts _ -> Just opts @@ -401,45 +400,13 @@ analyze cfg = Diag.context "fossa-analyze" $ do let keywordSearchResultsFound = (maybe False (not . null . lernieResultsKeywordSearches) lernieResults) let outputResult = buildResult includeAll additionalSourceUnits filteredProjects' licenseSourceUnits - -- logInfo "This is the pErrors &&&&&&&&&&" - -- let pErrors = - -- prettyErrors @String - -- emptySource - -- [ E.Errata - -- (Just "Relevant Errors") - -- [ Block - -- fancyRedStyle - -- ("src/App/Fossa/Analyze.hs", 1, 10) - -- (Just "\x1b[31mError: No Analysis Targets Found") - -- [] - -- (Just ("\n\x1b[36mHint:\x1b[0m Make sure your project is supported. \n\x1b[35mDocumentation: \x1b[0m" <> userGuideUrl)) - -- , Block - -- fancyRedStyle - -- ("src/App/Fossa/Analyze.hs", 1, 10) - -- (Just "Block Header 2") - -- [] - -- (Just "block body 2") - -- ] - -- (Just "\x1b[36mThis si the Errata Body") - -- , E.Errata - -- (Just "Errata Header 2") - -- [ Block - -- fancyRedStyle - -- ("src/App/Fossa/Analyze.hs", 1, 10) - -- (Just "Block Header 3") - -- [] - -- (Just "Block Body 3") - -- ] - -- (Just ("\x1b[36mHint:\x1b[0m Make sure your project is supported. \n\x1b[35mDocumentation: \x1b[0m" <> userGuideUrl)) - -- ] - -- logInfo (pretty pErrors) -- If we find nothing but keyword search, we exit with an error, but explain that the error may be ignorable. -- We do not want to succeed, because nothing gets uploaded to the API for keyword searches, so `fossa test` will fail. -- So the solution is to still fail, but give a hopefully useful explanation that the error can be ignored if all you were expecting is keyword search results. case (keywordSearchResultsFound, checkForEmptyUpload includeAll projectScans filteredProjects' additionalSourceUnits licenseSourceUnits) of - (False, NoneDiscovered) -> Diag.fatal $ ErrNoProjectsDiscovered getSourceLocation + (False, NoneDiscovered) -> Diag.errHelp ("Make sure your project is supported" :: Text) $ Diag.errDoc userGuideUrl $ Diag.fatal $ ErrNoProjectsDiscovered getSourceLocation (True, NoneDiscovered) -> Diag.fatal $ ErrOnlyKeywordSearchResultsFound getSourceLocation - (False, FilteredAll) -> Diag.fatal $ ErrFilteredAllProjects getSourceLocation + (False, FilteredAll) -> Diag.errDoc userGuideUrl $ Diag.fatal $ ErrFilteredAllProjects getSourceLocation (True, FilteredAll) -> Diag.fatal $ ErrOnlyKeywordSearchResultsFound getSourceLocation (_, CountedScanUnits scanUnits) -> doUpload outputResult iatAssertion destination basedir jsonOutput revision scanUnits pure outputResult @@ -454,20 +421,6 @@ analyze cfg = Diag.context "fossa-analyze" $ do locator <- uploadSuccessfulAnalysis (BaseDir basedir) metadata jsonOutput revision scanUnits doAssertRevisionBinaries iatAssertion locator --- toErrata :: AnalyzeError -> E.Errata --- toErrata analyzeError = --- errataSimple --- (Just "An error occured!") --- ( blockSimple --- basicStyle --- basicPointer --- sampleFilePath --- (Just "error: No analysis targets found in directory.") --- (1, 3, 0, Just "this one") --- (Just "Make sure your project is supported. See the user guide for details:") --- ) --- Nothing - toProjectResult :: DiscoveredProjectScan -> Maybe ProjectResult toProjectResult (SkippedDueToProvidedFilter _) = Nothing toProjectResult (SkippedDueToDefaultProductionFilter _) = Nothing @@ -552,15 +505,13 @@ data AnalyzeError -- instance Error.toErrata AnalyzeError where instance Diag.ToDiagnostic AnalyzeError where - renderDiagnostic :: AnalyzeError -> DiagnosticInfo renderDiagnostic (ErrNoProjectsDiscovered srcLoc) = do let header = "No analysis targets found in directory" - documentationReferences = [userGuideUrl] - help = "Make sure your project is supported" - DiagnosticInfo (Just header) Nothing (Just documentationReferences) Nothing (Just help) Nothing (Just srcLoc) + block = createBlock srcLoc Nothing Nothing + errataSimple (Just header) block Nothing renderDiagnostic (ErrFilteredAllProjects srcLoc) = do let header = "Filtered out all projects" - content = + body = renderIt $ vsep [ "This may be occurring because: " @@ -571,20 +522,18 @@ instance Diag.ToDiagnostic AnalyzeError where , vsep $ map (\i -> pretty $ " * " <> toText i) ignoredPaths , "" ] - body = createBody (Just content) (Just userGuideUrl) Nothing Nothing Nothing block = createBlock srcLoc Nothing Nothing - E.Errata (Just header) [block] (Just body) + errataSimple (Just header) block (Just body) renderDiagnostic (ErrOnlyKeywordSearchResultsFound srcLoc) = do let header = "Only keyword search results found" - content = + body = renderIt $ vsep [ "Matches to your keyword searches were found, but no other analysis targets were found." , "This error can be safely ignored if you are only expecting keyword search results." ] - body = createBody (Just content) Nothing Nothing Nothing Nothing block = createBlock srcLoc Nothing Nothing - E.Errata (Just header) [block] (Just body) + errataSimple (Just header) block (Just body) buildResult :: Flag IncludeAll -> [SourceUnit] -> [ProjectResult] -> Maybe LicenseSourceUnit -> Aeson.Value buildResult includeAll srcUnits projects licenseSourceUnits = diff --git a/src/App/Fossa/BinaryDeps/Jar.hs b/src/App/Fossa/BinaryDeps/Jar.hs index 7c1d63241c..0dc3a29702 100644 --- a/src/App/Fossa/BinaryDeps/Jar.hs +++ b/src/App/Fossa/BinaryDeps/Jar.hs @@ -24,15 +24,14 @@ import Data.Maybe (listToMaybe, mapMaybe) import Data.String.Conversion (ToString (toString), ToText (toText)) import Data.Text (Text) import Data.Text qualified as Text -import Diag.Diagnostic qualified as DI import Discovery.Archive (extractZip, withArchive) import Discovery.Walk (WalkStep (WalkContinue, WalkSkipAll), findFileNamed, walk') import Effect.Logger (Logger, logDebug, pretty) import Effect.ReadFS (ReadFS, readContentsText, readContentsXML) +import Errata (Errata (..)) import GHC.Base ((<|>)) import Path (Abs, Dir, File, Path, filename, mkRelDir, mkRelFile, ()) import Path.Extra (renderRelative, tryMakeRelative) -import Prettyprinter (viaShow) import Srclib.Types (SourceUserDefDep (..)) import Strategy.Maven.Pom.PomFile ( MavenCoordinate (..), @@ -70,12 +69,15 @@ resolveJar root file = do newtype FailedToResolveJar = FailedToResolveJar (Path Abs File) instance ToDiagnostic FailedToResolveJar where - renderDiagnostic (FailedToResolveJar path) = DI.DiagnosticInfo (Just $ "Could not infer jar metadata (license, jar name, and version) from " <> toText (show path)) Nothing Nothing Nothing Nothing Nothing Nothing + renderDiagnostic (FailedToResolveJar path) = do + let header = "Could not infer jar metadata (license, jar name, and version) from " <> toText path + Errata (Just header) [] Nothing newtype FailedToResolveJarCtx = FailedToResolveJarCtx (Path Abs File) instance ToDiagnostic FailedToResolveJarCtx where - renderDiagnostic :: FailedToResolveJarCtx -> DI.DiagnosticInfo - renderDiagnostic (FailedToResolveJarCtx path) = DI.DiagnosticInfo Nothing Nothing Nothing Nothing (Just $ "Ensure " <> toText (show path) <> " is a valid jar or aar file.") Nothing Nothing + renderDiagnostic (FailedToResolveJarCtx path) = do + let header = "Ensure " <> toText path <> " is a valid jar or aar file" + Errata (Just header) [] Nothing tacticMetaInf :: (Has (Lift IO) sig m, Has Diagnostics sig m, Has Logger sig m, Has ReadFS sig m) => Path Abs Dir -> m JarMetadata tacticMetaInf archive = context ("Parse " <> toText metaInfPath) $ do diff --git a/src/App/Fossa/Config/ConfigFile.hs b/src/App/Fossa/Config/ConfigFile.hs index c0f60269fe..7cd7333b4c 100644 --- a/src/App/Fossa/Config/ConfigFile.hs +++ b/src/App/Fossa/Config/ConfigFile.hs @@ -28,6 +28,7 @@ import Control.Applicative ((<|>)) import Control.Effect.Diagnostics ( Diagnostics, Has, + ToDiagnostic, context, fatal, fatalText, @@ -42,12 +43,14 @@ import Data.Aeson ( (.:), (.:?), ) +import Data.Error (createBody, renderErrataStack) import Data.Foldable (asum) import Data.Functor (($>)) import Data.Set (Set) import Data.Set qualified as Set import Data.String.Conversion (ToString (toString), ToText (toText)) import Data.Text (Text, strip, toLower) +import Diag.Diagnostic (ToDiagnostic (..)) import Effect.Logger ( AnsiStyle, Doc, @@ -59,6 +62,7 @@ import Effect.Logger ( vsep, ) import Effect.ReadFS (ReadFS, doesFileExist, getCurrentDir, readContentsYaml) +import Errata (Errata (..)) import Path ( Abs, Dir, @@ -126,7 +130,7 @@ resolveConfigFile base path = do if version >= 3 then pure $ Just configFile else -- Invalid config found without --config flag: warn and ignore file. - logWarn (warnMsgForOlderConfig @AnsiStyle version) $> Nothing + logWarn (pretty $ renderErrataStack [renderDiagnostic $ OlderConfigError version]) $> Nothing Nothing -> pure Nothing SpecifiedConfigLocation realpath -> do exists <- doesFileExist realpath @@ -139,17 +143,15 @@ resolveConfigFile base path = do if version >= 3 then pure $ Just configFile else -- Invalid config with --config specified: fail with message. - fatal $ warnMsgForOlderConfig @AnsiStyle version - -warnMsgForOlderConfig :: Int -> Doc ann -warnMsgForOlderConfig foundVersion = - vsep - [ "" - , "Incompatible [.fossa.yml] found! Expecting `version: 3`; found `version: " <> pretty foundVersion <> "`" - , "Documentation for the new config file format can be found here:" - , " " <> pretty fossaYmlDocUrl - , "" - ] + fatal $ OlderConfigError version + +newtype OlderConfigError = OlderConfigError Int +instance ToDiagnostic OlderConfigError where + renderDiagnostic (OlderConfigError foundVersion) = do + let header = "Incompatible [.fossa.yml] found" + ctx = "Expecting `version: 3`; found `version: " <> toText foundVersion <> "`" + body = createBody Nothing (Just fossaYmlDocUrl) Nothing Nothing (Just ctx) + Errata (Just header) [] (Just body) resolveLocation :: (Has (Lift IO) sig m, Has Diagnostics sig m) => Path Abs Dir -> Maybe FilePath -> m ConfigLocation resolveLocation base Nothing = pure $ DefaultConfigLocation base diff --git a/src/App/Fossa/Config/Container/Common.hs b/src/App/Fossa/Config/Container/Common.hs index 7fefef8df6..de8e1519c1 100644 --- a/src/App/Fossa/Config/Container/Common.hs +++ b/src/App/Fossa/Config/Container/Common.hs @@ -11,8 +11,8 @@ import Data.Aeson (ToJSON (toEncoding), defaultOptions, genericToEncoding) import Data.String.Conversion (toText) import Data.Text (Text) import Data.Text qualified as Text -import Diag.Diagnostic qualified as DI import Effect.Logger (renderIt) +import Errata (Errata (..)) import GHC.Generics (Generic) import Options.Applicative (Parser, argument, help, metavar, str) import Prettyprinter (pretty, vsep) @@ -64,11 +64,11 @@ newtype NotSupportedHostScheme = NotSupportedHostScheme Text instance ToDiagnostic NotSupportedHostScheme where renderDiagnostic (NotSupportedHostScheme provided) = do let header = "Host scheme not supported" - content = + body = renderIt $ vsep [ "Only unix domain sockets are supported for DOCKER_HOST value." , pretty $ "fossa will use: " <> "unix://" <> defaultDockerHost <> " instead, to connect with docker engine api (if needed)." + , "Provided 'DOCKER_HOST' via environment variable: " <> pretty provided ] - ctx = "Provided 'DOCKER_HOST' via environment variable: " <> provided - DI.DiagnosticInfo (Just header) (Just content) Nothing Nothing Nothing (Just ctx) Nothing + Errata (Just header) [] (Just body) diff --git a/src/App/Fossa/Config/Report.hs b/src/App/Fossa/Config/Report.hs index fe7b5e361a..1d53b55973 100644 --- a/src/App/Fossa/Config/Report.hs +++ b/src/App/Fossa/Config/Report.hs @@ -24,17 +24,17 @@ import App.Fossa.Config.ConfigFile (ConfigFile, resolveLocalConfigFile) import App.Fossa.Config.EnvironmentVars (EnvVars) import App.Fossa.Subcommand (EffStack, GetCommonOpts (getCommonOpts), GetSeverity (getSeverity), SubCommand (SubCommand)) import App.Types (BaseDir, OverrideProject (OverrideProject), ProjectRevision) -import Control.Effect.Diagnostics (Diagnostics, ToDiagnostic (renderDiagnostic), fatal, fromMaybe) +import Control.Effect.Diagnostics (Diagnostics, ToDiagnostic (renderDiagnostic), errHelp, fatal, fromMaybe) import Control.Effect.Lift (Has, Lift) import Control.Timeout (Duration (Seconds)) import Data.Aeson (ToJSON (toEncoding), defaultOptions, genericToEncoding) -import Data.Error (SourceLocation, getSourceLocation) +import Data.Error (SourceLocation, createBlock, getSourceLocation) import Data.List (intercalate) import Data.String.Conversion (ToText, toText) -import Diag.Diagnostic qualified as DI import Effect.Exec (Exec) import Effect.Logger (Logger, Severity (..)) import Effect.ReadFS (ReadFS) +import Errata (Errata (..), errataSimple) import Fossa.API.Types (ApiOpts) import GHC.Generics (Generic) import Options.Applicative ( @@ -52,7 +52,7 @@ import Options.Applicative ( strOption, switch, ) -import Prettyprinter (Doc, comma, hardline, pretty, punctuate, softline, viaShow) +import Prettyprinter (Doc, comma, hardline, punctuate, softline, viaShow) import Prettyprinter.Render.Terminal (AnsiStyle) data ReportType = Attribution deriving (Eq, Ord, Enum, Bounded, Generic) @@ -206,24 +206,28 @@ mergeOpts cfgfile envvars ReportCliOptions{..} = do newtype NoFormatProvided = NoFormatProvided SourceLocation instance ToDiagnostic NoFormatProvided where - renderDiagnostic :: NoFormatProvided -> DI.DiagnosticInfo renderDiagnostic (NoFormatProvided srcLoc) = do let header = "No format provided" - helpMsg = "Provide a format option via '--format' to render this report. Supported formats: " <> (toText reportOutputFormatList) - DI.DiagnosticInfo (Just header) Nothing Nothing Nothing (Just helpMsg) Nothing (Just srcLoc) + block = createBlock srcLoc Nothing Nothing + errataSimple (Just header) block Nothing data InvalidReportFormat = InvalidReportFormat SourceLocation String instance ToDiagnostic InvalidReportFormat where renderDiagnostic (InvalidReportFormat srcLoc fmt) = do - let header = "Invalid report format" - ctxMsg = "Report format " <> toText fmt <> " is not supported" - helpMsg = "Provide a supported format. Supported formats: " <> (toText reportOutputFormatList) - DI.DiagnosticInfo (Just header) Nothing Nothing Nothing (Just helpMsg) (Just ctxMsg) (Just srcLoc) + let header = "Report format: " <> toText fmt <> " is not supported" + block = createBlock srcLoc Nothing Nothing + errataSimple (Just header) block Nothing + +data ReportErrorHelp = ReportErrorHelp +instance ToDiagnostic ReportErrorHelp where + renderDiagnostic ReportErrorHelp = do + let header = "Provide a supported format via '--format'. Supported formats: " <> (toText reportOutputFormatList) + Errata (Just header) [] Nothing validateOutputFormat :: Has Diagnostics sig m => Bool -> Maybe String -> m ReportOutputFormat validateOutputFormat True _ = pure ReportJson -validateOutputFormat False Nothing = fatal $ NoFormatProvided getSourceLocation -validateOutputFormat False (Just format) = fromMaybe (InvalidReportFormat getSourceLocation format) $ parseReportOutputFormat format +validateOutputFormat False Nothing = errHelp ReportErrorHelp $ fatal $ NoFormatProvided getSourceLocation +validateOutputFormat False (Just format) = errHelp ReportErrorHelp $ fromMaybe (InvalidReportFormat getSourceLocation format) $ parseReportOutputFormat format data ReportConfig = ReportConfig { apiOpts :: ApiOpts diff --git a/src/App/Fossa/Config/Test.hs b/src/App/Fossa/Config/Test.hs index c69397b80d..4417fd960d 100644 --- a/src/App/Fossa/Config/Test.hs +++ b/src/App/Fossa/Config/Test.hs @@ -46,6 +46,7 @@ import Diag.Diagnostic (ToDiagnostic (renderDiagnostic)) import Effect.Exec (Exec) import Effect.Logger (Logger, Pretty (pretty), Severity (SevDebug, SevInfo), logWarn, vsep) import Effect.ReadFS (ReadFS, getCurrentDir, resolveDir) +import Errata (Errata (..)) import Fossa.API.Types (ApiOpts) import GHC.Generics (Generic) import Options.Applicative ( @@ -82,12 +83,10 @@ testOutputFormatList = intercalate ", " $ map show allFormats newtype InvalidReportFormat = InvalidReportFormat String instance ToDiagnostic InvalidReportFormat where - renderDiagnostic (InvalidReportFormat fmt) = - pretty $ - "Fossa test format " - <> toText fmt - <> " is not supported. Supported formats: " - <> (toText testOutputFormatList) + renderDiagnostic (InvalidReportFormat fmt) = do + let header = "Fossa test format: " <> toText fmt <> " is not supported" + body = "Supported formats: " <> toText testOutputFormatList + Errata (Just header) [] (Just body) validateOutputFormat :: Has Diagnostics sig m => Bool -> Maybe String -> m TestOutputFormat validateOutputFormat True _ = pure TestOutputJson diff --git a/src/App/Fossa/Container/AnalyzeNative.hs b/src/App/Fossa/Container/AnalyzeNative.hs index f7a9530bb3..c3b84f2a34 100644 --- a/src/App/Fossa/Container/AnalyzeNative.hs +++ b/src/App/Fossa/Container/AnalyzeNative.hs @@ -36,6 +36,7 @@ import Control.Monad (void, when) import Data.Aeson ((.=)) import Data.Aeson qualified as Aeson import Data.ByteString.Lazy qualified as BL +import Data.Error (getSourceLocation) import Data.Flag (Flag, fromFlag) import Data.Foldable (traverse_) import Data.Maybe (fromMaybe) @@ -131,7 +132,7 @@ uploadScan revision projectMeta jsonOutput containerScan = do supportsNativeScan <- orgSupportsNativeContainerScan <$> getOrganization if not supportsNativeScan - then fatal EndpointDoesNotSupportNativeContainerScan + then fatal (EndpointDoesNotSupportNativeContainerScan getSourceLocation) else do resp <- uploadNativeContainerScan revision projectMeta containerScan let locator = uploadLocator resp diff --git a/src/App/Fossa/Container/Scan.hs b/src/App/Fossa/Container/Scan.hs index 582a5b9c54..d5bd0a9834 100644 --- a/src/App/Fossa/Container/Scan.hs +++ b/src/App/Fossa/Container/Scan.hs @@ -35,7 +35,6 @@ import Data.Text (Text) import Data.Text qualified as Text import Data.Text.Extra (breakOnEndAndRemove) import Diag.Diagnostic qualified as Diag ( - DiagnosticInfo (..), ToDiagnostic (renderDiagnostic), ) import Discovery.Filters (AllFilters (..)) @@ -46,6 +45,7 @@ import Effect.Logger ( logInfo, ) import Effect.ReadFS (ReadFS, doesFileExist, getCurrentDir) +import Errata (Errata (..)) import Path (Abs, File, Path, SomeBase (Abs, Rel), parseSomeFile, ()) import Text.Megaparsec (errorBundlePretty, parse) @@ -192,9 +192,8 @@ newtype DockerEngineImageNotPresentLocally = DockerEngineImageNotPresentLocally instance ToDiagnostic DockerEngineImageNotPresentLocally where renderDiagnostic (DockerEngineImageNotPresentLocally tag) = do - let ctx = "Could not find: " <> tag <> " in local repository" - help = "Perform: docker pull " <> tag <> ", prior to running fossa." - Diag.DiagnosticInfo Nothing Nothing Nothing Nothing (Just help) (Just ctx) Nothing + let header = "Could not find: " <> tag <> " in local repository. Perform: docker pull " <> tag <> ", prior to running fossa." + Errata (Just header) [] Nothing parsePodmanSource :: ( Has (Lift IO) sig m @@ -214,5 +213,7 @@ parseRegistrySource :: Text -> m ContainerImageSource parseRegistrySource defaultArch tag = case parse (parseImageUrl defaultArch) "" tag of - Left err -> fatal $ errorBundlePretty err + Left err -> do + let structuredError = "\n" <> errorBundlePretty err + fatal structuredError Right registrySource -> pure $ Registry registrySource diff --git a/src/App/Fossa/LicenseScan.hs b/src/App/Fossa/LicenseScan.hs index 8f3b7e5b02..40717a1c55 100644 --- a/src/App/Fossa/LicenseScan.hs +++ b/src/App/Fossa/LicenseScan.hs @@ -32,14 +32,15 @@ import Control.Effect.Diagnostics (Diagnostics, ToDiagnostic, fromMaybe) import Control.Effect.Lift (Lift) import Data.Aeson (KeyValue ((.=)), ToJSON (toJSON), object) import Data.Aeson qualified as Aeson -import Data.Error (SourceLocation, getSourceLocation) +import Data.Error (SourceLocation, createBlock, getSourceLocation) import Data.List.NonEmpty (NonEmpty) import Data.List.NonEmpty qualified as NE import Data.String.Conversion (decodeUtf8) -import Diag.Diagnostic (DiagnosticInfo (..), ToDiagnostic (renderDiagnostic)) +import Diag.Diagnostic (ToDiagnostic (renderDiagnostic)) import Effect.Exec (Exec) import Effect.Logger (Logger, Severity (SevInfo), logStdout, renderIt) import Effect.ReadFS (ReadFS) +import Errata (errataSimple) import Path (Abs, Dir, Path) import Prettyprinter (vsep) import Srclib.Types (LicenseSourceUnit) @@ -51,18 +52,20 @@ newtype NoVendoredDeps = NoVendoredDeps SourceLocation instance ToDiagnostic MissingFossaDepsFile where renderDiagnostic (MissingFossaDepsFile srcLoc) = do let header = "Missing fossa-deps file" - content = + body = renderIt $ vsep [ "'fossa license-scan fossa-deps' requires pointing to a directory with a fossa-deps file." , "The file can have one of the extensions: .yaml .yml .json" ] - DiagnosticInfo (Just header) (Just content) Nothing Nothing Nothing Nothing (Just srcLoc) + block = createBlock srcLoc Nothing Nothing + errataSimple (Just header) block (Just body) instance ToDiagnostic NoVendoredDeps where renderDiagnostic (NoVendoredDeps srcLoc) = do let header = "The 'vendored-dependencies' section of the fossa deps file is empty or missing." - DiagnosticInfo (Just header) Nothing Nothing Nothing Nothing Nothing (Just srcLoc) + block = createBlock srcLoc Nothing Nothing + errataSimple (Just header) block Nothing newtype UploadUnits = UploadUnits (NonEmpty LicenseSourceUnit) diff --git a/src/App/Fossa/LicenseScanner.hs b/src/App/Fossa/LicenseScanner.hs index 8587ddf941..370edea0fc 100644 --- a/src/App/Fossa/LicenseScanner.hs +++ b/src/App/Fossa/LicenseScanner.hs @@ -43,6 +43,7 @@ import Control.Effect.Lift (Lift, sendIO) import Control.Effect.Path (withSystemTempDir) import Control.Effect.StickyLogger (StickyLogger, logSticky) import Data.Either.Combinators (rightToMaybe) +import Data.Error (SourceLocation, createBlock, getSourceLocation) import Data.HashMap.Strict qualified as HM import Data.List.NonEmpty (NonEmpty) import Data.List.NonEmpty qualified as NE @@ -61,6 +62,7 @@ import Effect.ReadFS ( ReadFS, resolvePath', ) +import Errata (errataSimple) import Fossa.API.Types ( Archive (Archive, archiveName), ArchiveComponents (..), @@ -79,20 +81,38 @@ import Srclib.Types ( import Types (LicenseScanPathFilters (licenseScanPathFilterFileExclude)) data LicenseScanErr - = NoSuccessfulScans - | NoLicenseResults (Path Abs Dir) - | EmptyDirectory (Path Abs Dir) - | EmptyOrCorruptedArchive (Path Abs File) - | UnsupportedArchive (Path Abs File) + = NoSuccessfulScans SourceLocation + | NoLicenseResults SourceLocation (Path Abs Dir) + | EmptyDirectory SourceLocation (Path Abs Dir) + | EmptyOrCorruptedArchive SourceLocation (Path Abs File) + | UnsupportedArchive SourceLocation (Path Abs File) instance ToDiagnostic LicenseScanErr where - renderDiagnostic NoSuccessfulScans = "No native license scans were successful" - renderDiagnostic (NoLicenseResults path) = "No license results found after scanning directory: " <> pretty (toText path) - renderDiagnostic (EmptyDirectory path) = "vendored-dependencies path has no files and cannot be scanned: " <> pretty (toString path) - renderDiagnostic (EmptyOrCorruptedArchive path) = "vendored-dependencies archive is malformed or contains no files: " <> pretty (toString path) - renderDiagnostic (UnsupportedArchive path) = case fileExtension path of - Just ext -> "fossa-cli does not support archives of type " <> squotes (pretty ext) <> ": " <> pretty (toString path) - Nothing -> "fossa-cli does not support archives without file extensions: " <> pretty (toString path) + renderDiagnostic (NoSuccessfulScans srcLoc) = do + let header = "No native license scans were successful" + block = createBlock srcLoc Nothing Nothing + errataSimple (Just header) block Nothing + renderDiagnostic (NoLicenseResults srcLoc path) = do + let header = "No license results found after scanning directory: " <> toText path + block = createBlock srcLoc Nothing Nothing + errataSimple (Just header) block Nothing + renderDiagnostic (EmptyDirectory srcLoc path) = do + let header = "vendored-dependencies path has no files and cannot be scanned: " <> toText path + block = createBlock srcLoc Nothing Nothing + errataSimple (Just header) block Nothing + renderDiagnostic (EmptyOrCorruptedArchive srcLoc path) = do + let header = "vendored-dependencies archive is malformed or contains no files: " <> toText path + block = createBlock srcLoc Nothing Nothing + errataSimple (Just header) block Nothing + renderDiagnostic (UnsupportedArchive srcLoc path) = case fileExtension path of + Just ext -> do + let header = "fossa-cli does not support archives of type " <> "`" <> toText ext <> "`" <> ": " <> toText path + block = createBlock srcLoc Nothing Nothing + errataSimple (Just header) block Nothing + Nothing -> do + let header = "fossa-cli does not support archives without file extensions: " <> toText path + block = createBlock srcLoc Nothing Nothing + errataSimple (Just header) block Nothing newtype ScannableArchive = ScannableArchive {scanFile :: Path Abs File} deriving (Eq, Ord, Show) @@ -249,9 +269,9 @@ scanArchive baseDir licenseScanPathFilters fullFileUploads file = runFinally $ d logSticky $ "scanning archive at " <> toText (scanFile file) result <- withArchive' (scanFile file) (scanDirectory (Just file) pathPrefix licenseScanPathFilters fullFileUploads) case result of - Left _ -> fatal . UnsupportedArchive $ scanFile file + Left _ -> fatal . UnsupportedArchive getSourceLocation $ scanFile file Right r -> case r of - Nothing -> fatal . EmptyOrCorruptedArchive $ scanFile file + Nothing -> fatal . EmptyOrCorruptedArchive getSourceLocation $ scanFile file Just units -> pure units where pathPrefix :: Text @@ -273,7 +293,7 @@ scanDirectory origin pathPrefix licenseScanPathFilters fullFileUploads path = do hasFiles <- hasAnyFiles path if hasFiles then scanNonEmptyDirectory pathPrefix licenseScanPathFilters fullFileUploads path - else maybe (fatal $ EmptyDirectory path) (fatal . EmptyOrCorruptedArchive . scanFile) origin + else maybe (fatal $ EmptyDirectory getSourceLocation path) (fatal . EmptyOrCorruptedArchive getSourceLocation . scanFile) origin hasAnyFiles :: ( Has Diagnostics sig m @@ -306,7 +326,7 @@ scanNonEmptyDirectory :: scanNonEmptyDirectory pathPrefix licenseScanPathFilters fullFileUploads cliScanDir = do themisScanResult <- runLicenseScanOnDir pathPrefix licenseScanPathFilters fullFileUploads cliScanDir case NE.nonEmpty themisScanResult of - Nothing -> fatal $ NoLicenseResults cliScanDir + Nothing -> fatal $ NoLicenseResults getSourceLocation cliScanDir Just results -> pure results uploadVendoredDep :: @@ -371,7 +391,7 @@ licenseScanSourceUnit vendoredDependencyScanMode licenseScanPathFilters fullFile -- We need to include both scanned and skipped archives in this list so that they all get included in the build in FOSSA let skippedArchives = map forceVendoredToArchive $ skippableDeps skippable - archives <- fromMaybe NoSuccessfulScans $ NE.nonEmpty $ (catMaybes maybeScannedArchives) <> skippedArchives + archives <- fromMaybe (NoSuccessfulScans getSourceLocation) $ NE.nonEmpty $ (catMaybes maybeScannedArchives) <> skippedArchives -- finalizeLicenseScan takes archives without Organization information. This orgID is appended when creating the build on the backend. -- We don't care about the response here because if the build has already been queued, we get a 401 response. diff --git a/src/App/Fossa/ManualDeps.hs b/src/App/Fossa/ManualDeps.hs index 1cd2963d22..8e6ddf4bda 100644 --- a/src/App/Fossa/ManualDeps.hs +++ b/src/App/Fossa/ManualDeps.hs @@ -34,7 +34,7 @@ import App.Fossa.VendoredDependency ( import App.Types (FullFileUploads (..)) import Control.Carrier.FossaApiClient (runFossaApiClient) import Control.Effect.Debug (Debug) -import Control.Effect.Diagnostics (Diagnostics, context, fatal, fatalText) +import Control.Effect.Diagnostics (Diagnostics, context, errCtx, errHelp, fatal, fatalText) import Control.Effect.FossaApiClient (FossaApiClient, getOrganization) import Control.Effect.Lift (Has, Lift) import Control.Effect.StickyLogger (StickyLogger) @@ -49,7 +49,7 @@ import Data.Aeson ( ) import Data.Aeson.Extra (TextLike (unTextLike), forbidMembers, neText) import Data.Aeson.Types (Object, Parser, prependFailure) -import Data.Error (SourceLocation) +import Data.Error (SourceLocation, createBlock, getSourceLocation) import Data.Functor.Extra ((<$$>)) import Data.List.NonEmpty (NonEmpty) import Data.List.NonEmpty qualified as NE @@ -60,8 +60,9 @@ import Data.Text qualified as Text import DepTypes (DepType (..)) import Diag.Diagnostic (ToDiagnostic (renderDiagnostic)) import Effect.Exec (Exec) -import Effect.Logger (Logger, indent, pretty, vsep) +import Effect.Logger (Logger, indent, pretty, renderIt, vsep) import Effect.ReadFS (ReadFS, doesFileExist, readContentsJson, readContentsYaml) +import Errata (Errata (..), errataSimple) import Fossa.API.Types (ApiOpts, Organization (..)) import Path (Abs, Dir, File, Path, mkRelFile, ()) import Path.Extra (tryMakeRelative) @@ -529,7 +530,7 @@ instance FromJSON RemoteDependency where validateRemoteDep :: (Has Diagnostics sig m) => RemoteDependency -> Organization -> m RemoteDependency validateRemoteDep r org = if locatorLen > maxLocatorLength - then fatal $ RemoteDepLengthIsGtThanAllowed (r, maxUrlRevLength) + then errCtx (RemoteDepLengthIsGtThanAllowedCtx r) $ errHelp (RemoteDepLengthIsGtThanAllowedHelp maxUrlRevLength) $ fatal $ RemoteDepLengthIsGtThanAllowedMessage getSourceLocation else pure r where orgId :: Text @@ -550,27 +551,34 @@ validateRemoteDep r org = maxUrlRevLength :: Int maxUrlRevLength = maxLocatorLength - Text.length requiredChars -newtype RemoteDepLengthIsGtThanAllowed = RemoteDepLengthIsGtThanAllowed SourceLocation (RemoteDependency, Int) +data RemoteDepLengthIsGtThanAllowed + = RemoteDepLengthIsGtThanAllowedMessage SourceLocation + | RemoteDepLengthIsGtThanAllowedCtx RemoteDependency + | RemoteDepLengthIsGtThanAllowedHelp Int instance ToDiagnostic RemoteDepLengthIsGtThanAllowed where - renderDiagnostic (RemoteDepLengthIsGtThanAllowed srcLoc (r, maxLen)) = do - vsep - [ "You provided remote-dependency: " - , "" - , indent 2 . pretty $ "Name: " <> remoteName r - , indent 2 . pretty $ "Url: " <> remoteUrl r - , indent 2 . pretty $ "Version: " <> remoteVersion r - , "" - , pretty $ - "The combined length of url and version is: " - <> show urlRevLength - <> ". It must be below: " - <> show maxLen - <> "." - ] + renderDiagnostic (RemoteDepLengthIsGtThanAllowedMessage srcLoc) = do + let header = "remote-dependency length is exceeds limit" + block = createBlock srcLoc Nothing Nothing + errataSimple (Just header) block Nothing + renderDiagnostic (RemoteDepLengthIsGtThanAllowedCtx r) = do + let header = + renderIt $ + vsep + [ pretty $ "The combined length of url and version is: " <> show urlRevLength + , "" + , indent 2 "You provided remote-dependency: " + , indent 4 . pretty $ "Name: " <> remoteName r + , indent 4 . pretty $ "Url: " <> remoteUrl r + , indent 4 . pretty $ "Version: " <> remoteVersion r + ] + Errata (Just header) [] Nothing where urlRevLength :: Int urlRevLength = Text.length $ Text.intercalate "" [remoteUrl r, remoteVersion r] + renderDiagnostic (RemoteDepLengthIsGtThanAllowedHelp maxLen) = do + let header = "Ensure that the combined length is below: " <> toText maxLen + Errata (Just header) [] Nothing -- Dependency "metadata" section for both Remote and Custom Dependencies instance FromJSON DependencyMetadata where diff --git a/src/App/Fossa/ProjectInference.hs b/src/App/Fossa/ProjectInference.hs index d1b4afb5f4..1ceae124f4 100644 --- a/src/App/Fossa/ProjectInference.hs +++ b/src/App/Fossa/ProjectInference.hs @@ -31,10 +31,9 @@ import Data.Text qualified as Text import Data.Text.IO qualified as TIO import Data.Time.Clock.POSIX (getCurrentTime) import Data.Time.Format.ISO8601 (iso8601Show) -import Diag.Diagnostic qualified as D import Effect.Exec -import Effect.Logger import Effect.ReadFS +import Errata (Errata (..)) import Path import Path.IO (getTempDir) import System.FilePath.Posix qualified as FP @@ -243,25 +242,25 @@ instance ToDiagnostic InferenceError where renderDiagnostic = \case InvalidRemote -> do let header = "Missing 'origin' git remote" - D.DiagnosticInfo (Just header) Nothing Nothing Nothing Nothing Nothing Nothing + Errata (Just header) [] Nothing GitConfigParse err -> do let header = "An error occurred when parsing the git config: " <> err - D.DiagnosticInfo (Just header) Nothing Nothing Nothing Nothing Nothing Nothing + Errata (Just header) [] Nothing MissingGitConfig -> do let header = "Missing .git/config file" - D.DiagnosticInfo (Just header) Nothing Nothing Nothing Nothing Nothing Nothing + Errata (Just header) [] Nothing MissingGitHead -> do let header = "Missing .git/HEAD file" - D.DiagnosticInfo (Just header) Nothing Nothing Nothing Nothing Nothing Nothing + Errata (Just header) [] Nothing InvalidBranchName branch -> do let header = "Invalid branch name: " <> branch - D.DiagnosticInfo (Just header) Nothing Nothing Nothing Nothing Nothing Nothing + Errata (Just header) [] Nothing MissingBranch branch -> do let header = "Missing ref file for current branch: " <> branch - D.DiagnosticInfo (Just header) Nothing Nothing Nothing Nothing Nothing Nothing + Errata (Just header) [] Nothing MissingGitDir -> do let header = "Could not find .git directory in the current or any parent directory" - D.DiagnosticInfo (Just header) Nothing Nothing Nothing Nothing Nothing Nothing + Errata (Just header) [] Nothing data InferredProject = InferredProject { inferredName :: Text diff --git a/src/App/Fossa/VSI/DynLinked.hs b/src/App/Fossa/VSI/DynLinked.hs index e92289b757..4bd7210efe 100644 --- a/src/App/Fossa/VSI/DynLinked.hs +++ b/src/App/Fossa/VSI/DynLinked.hs @@ -10,11 +10,11 @@ import Control.Effect.Diagnostics (Diagnostics, ToDiagnostic, context, errCtx, f import Control.Effect.Lift (Lift) import Control.Effect.Reader (Reader) import Data.String.Conversion (toText) -import Diag.Diagnostic qualified as DI import Discovery.Filters (AllFilters) import Effect.Exec (Exec) import Effect.Logger (Logger) import Effect.ReadFS (ReadFS) +import Errata (Errata (..)) import Path (Abs, Dir, Path) import Path.Extra (SomePath, resolveAbsolute) import Srclib.Types (SourceUnit (..)) @@ -49,16 +49,16 @@ newtype SkippingDynamicDep = SkippingDynamicDep (SomePath) instance ToDiagnostic SkippingDynamicDep where renderDiagnostic (SkippingDynamicDep path) = do let header = "Skipping dynamic analysis for target: " <> toText (show path) - DI.DiagnosticInfo (Just header) Nothing Nothing Nothing Nothing Nothing Nothing + Errata (Just header) [] Nothing data NotSupportedDistro = NotSupportedDistro instance ToDiagnostic NotSupportedDistro where renderDiagnostic (NotSupportedDistro) = do - let ctx = "Fossa is executing in an environment that is not supported for dynamic link detection. Redhat and Debian based linux is currently supported." - DI.DiagnosticInfo Nothing Nothing Nothing Nothing Nothing (Just ctx) Nothing + let header = "Fossa is executing in an environment that is not supported for dynamic link detection. Redhat and Debian based linux is currently supported." + Errata (Just header) [] Nothing data NoDependenciesFound = NoDependenciesFound instance ToDiagnostic NoDependenciesFound where renderDiagnostic (NoDependenciesFound) = do - let ctx = "no dynamic dependencies found in target executable" - DI.DiagnosticInfo Nothing Nothing Nothing Nothing Nothing (Just ctx) Nothing + let header = "No dynamic dependencies found in target executable" + Errata (Just header) [] Nothing diff --git a/src/App/Fossa/VSI/DynLinked/Internal/Binary.hs b/src/App/Fossa/VSI/DynLinked/Internal/Binary.hs index abc8891c04..ddbe02363f 100644 --- a/src/App/Fossa/VSI/DynLinked/Internal/Binary.hs +++ b/src/App/Fossa/VSI/DynLinked/Internal/Binary.hs @@ -17,12 +17,12 @@ import Data.Set qualified as Set import Data.String.Conversion (ToString (toString), toText) import Data.Text (Text) import Data.Void (Void) -import Diag.Diagnostic qualified as D import Discovery.Filters (AllFilters) import Discovery.Walk (WalkStep (WalkContinue), walkWithFilters') import Effect.Exec (AllowErr (Never), Command (..), Exec, execParser) import Effect.Logger (Logger, logDebug, pretty) import Effect.ReadFS (ReadFS) +import Errata (Errata (..)) import Path (Abs, Dir, File, Path, parent, parseAbsFile) import Path.Extra (SomeResolvedPath (..)) import Text.Megaparsec (Parsec, between, empty, eof, many, optional, takeWhile1P, try, (<|>)) @@ -77,7 +77,7 @@ newtype SkippingDynamicDep = SkippingDynamicDep (Path Abs File) instance ToDiagnostic SkippingDynamicDep where renderDiagnostic (SkippingDynamicDep target) = do let header = "Skipping dynamic analysis for target: " <> toText (show target) - D.DiagnosticInfo (Just header) Nothing Nothing Nothing Nothing Nothing Nothing + Errata (Just header) [] Nothing lddCommand :: Path Abs File -> Command lddCommand binaryPath = diff --git a/src/App/Fossa/VSI/DynLinked/Internal/Lookup.hs b/src/App/Fossa/VSI/DynLinked/Internal/Lookup.hs index b4af3c47f4..4880ee82dd 100644 --- a/src/App/Fossa/VSI/DynLinked/Internal/Lookup.hs +++ b/src/App/Fossa/VSI/DynLinked/Internal/Lookup.hs @@ -18,8 +18,8 @@ import Control.Monad (join) import Data.Set (Set) import Data.Set qualified as Set import Data.String.Conversion (toText) -import Diag.Diagnostic qualified as DI import Effect.Exec (Exec) +import Errata (Errata (..)) import Path (Abs, Dir, File, Path) -- | Resolve the provided file paths, which represent dynamic dependencies of a binary, into a set of @DynamicDependency@. @@ -61,4 +61,4 @@ newtype MissingLinuxMetadata = MissingLinuxMetadata (Path Abs File) instance ToDiagnostic MissingLinuxMetadata where renderDiagnostic (MissingLinuxMetadata path) = do let header = "Could not determine owning system package for file: " <> (toText . show $ path) - DI.DiagnosticInfo (Just header) Nothing Nothing Nothing Nothing Nothing Nothing + Errata (Just header) [] Nothing diff --git a/src/App/Fossa/VSI/Types.hs b/src/App/Fossa/VSI/Types.hs index fa5a97225c..8d38a43cf1 100644 --- a/src/App/Fossa/VSI/Types.hs +++ b/src/App/Fossa/VSI/Types.hs @@ -35,8 +35,8 @@ import Data.String.Conversion (ToString, ToText, toText) import Data.Text (Text, isPrefixOf) import Data.Text qualified as Text import DepTypes (DepType (..), Dependency (..), VerConstraint (CEq)) -import Diag.Diagnostic (DiagnosticInfo (..), ToDiagnostic, renderDiagnostic) -import Effect.Logger (Pretty (pretty), viaShow) +import Diag.Diagnostic (ToDiagnostic, renderDiagnostic) +import Errata (Errata (..)) import GHC.Generics (Generic) import Srclib.Converter (depTypeToFetcher, fetcherToDepType) import Srclib.Types qualified as Srclib @@ -97,7 +97,7 @@ instance ToText LocatorParseError where instance ToDiagnostic LocatorParseError where renderDiagnostic (RevisionRequired locator) = do let header = toText $ "Revision is required on locator: " <> show locator - DiagnosticInfo (Just header) Nothing Nothing Nothing Nothing Nothing Nothing + Errata (Just header) [] Nothing -- | VSI locally resolves the dependencies of some VSI dependencies using the FOSSA API. -- In the case where a user doesn't have access to view a project that is a dependency of their project, @@ -133,10 +133,8 @@ newtype ToDependencyError = UnsupportedLocator Locator instance ToDiagnostic ToDependencyError where renderDiagnostic (UnsupportedLocator locator) = do - let header = "Unsupported locator" - content = "Cannot convert fetcher " <> (locatorFetcher locator) <> " to known dependency type" - ctx = toText $ "Locator: " <> show locator - DiagnosticInfo (Just header) (Just content) Nothing Nothing Nothing (Just ctx) Nothing + let header = "Cannot convert fetcher " <> (locatorFetcher locator) <> " to known dependency type" <> "Locator: " <> toText (show locator) + Errata (Just header) [] Nothing validateLocator :: Srclib.Locator -> Either LocatorParseError Locator validateLocator loc = Locator (Srclib.locatorFetcher loc) (Srclib.locatorProject loc) <$> validateRevision loc diff --git a/src/App/Support.hs b/src/App/Support.hs index 277516a3de..2d6750d344 100644 --- a/src/App/Support.hs +++ b/src/App/Support.hs @@ -12,6 +12,7 @@ module App.Support ( reportDefectWithDebugBundle, requestDebugBundle, requestReportIfPersists, + requestReportIfPersistsWithDebugBundle, FossaEnvironment (..), ) where @@ -54,52 +55,47 @@ reportDefectWithFileMsg filepath = reportDefectWithDebugBundle :: Doc ann reportDefectWithDebugBundle = withDebugBundle reportDefectMsg +-- | Request a report if the issue persists, but also ask for the debug bundle +requestReportIfPersistsWithDebugBundle :: Doc ann +requestReportIfPersistsWithDebugBundle = withDebugBundle requestReportIfPersists + -- | A request for the debug bundle, along with instructions on how to generate it. requestDebugBundle :: Doc ann requestDebugBundle = vsep [ "In your bug report, please include FOSSA's debug bundle file: fossa.debug.json.gz." - , "" - , "You can generate debug bundle by using `--debug` flag, for example:" - , indent 2 "fossa analyze --debug" + , "You can generate debug bundle by using `--debug` flag, for example: fossa analyze --debug" ] -- | For networking errors, explain that networking errors are often transient or caused by local configuration. --- Contains a call to action for a bug report if the issue persists. reportNetworkErrorMsg :: Doc ann reportNetworkErrorMsg = - withDebugBundle $ - vsep - [ "This is a networking error." - , "" - , "Networking errors are typically caused by actual network failure or a network appliance" - , "(e.g. a firewall) between the FOSSA CLI and the FOSSA backend." - , "This means that often such errors are transient, or are caused by local network configuration." - , "" - , "Trying again in a few minutes may resolve this issue." - , requestReportIfPersists - ] + vsep + [ "This is a networking error." + , "" + , "Networking errors are typically caused by actual network failure or a network appliance" + , "(e.g. a firewall) between the FOSSA CLI and the FOSSA backend." + , "This means that often such errors are transient, or are caused by local network configuration." + , "" + , "Trying again in a few minutes may resolve this issue." + ] -- | For errors which almost definitely are a bug in the FOSSA CLI. reportCliBugErrorMsg :: Doc ann -reportCliBugErrorMsg = - withDebugBundle . withRequestReportIfPersists $ - "This is likely a bug in the FOSSA CLI." +reportCliBugErrorMsg = "This is likely a bug in the FOSSA CLI." -- | For errors which almost definitely are a bug in FOSSA. reportFossaBugErrorMsg :: FossaEnvironment -> Doc ann reportFossaBugErrorMsg FossaEnvironmentCloud = - withDebugBundle $ - vsep - [ "This is likely a bug in FOSSA, although it is also possible that this is caused by network failure" - , "or a network appliance (e.g. a firewall) between FOSSA CLI and the FOSSA endpoint." - , "" - , "FOSSA may already be aware of this issue, in which case this may be transient." - , "For current status, see the FOSSA status page at " <> pretty statusPageUrl - , "" - , "Trying again in a few minutes may resolve this issue." - , requestReportIfPersists - ] + vsep + [ "This is likely a bug in FOSSA, although it is also possible that this is caused by network failure" + , "or a network appliance (e.g. a firewall) between FOSSA CLI and the FOSSA endpoint." + , "" + , "FOSSA may already be aware of this issue, in which case this may be transient." + , "For current status, see the FOSSA status page at " <> pretty statusPageUrl + , "" + , "Trying again in a few minutes may resolve this issue." + ] reportFossaBugErrorMsg FossaEnvironmentOnprem = withDebugBundle $ vsep @@ -107,16 +103,12 @@ reportFossaBugErrorMsg FossaEnvironmentOnprem = , "or a network appliance (e.g. a firewall) between FOSSA CLI and the FOSSA endpoint." , "" , "Trying again in a few minutes may resolve this issue." - , requestReportIfPersists ] -- | For temporary errors, explain that the error is transient and to wait a bit to try again. --- Contains a call to action for a bug report if the issue persists. -- If this is a networking error, consider 'reportNetworkErrorMsg' instead. reportTransientErrorMsg :: Doc ann -reportTransientErrorMsg = - withDebugBundle . withRequestReportIfPersists $ - "This error is often transient, so trying again in a few minutes may resolve the issue." +reportTransientErrorMsg = "This error is often transient, so trying again in a few minutes may resolve the issue." -- | Request a report if the issue persists. requestReportIfPersists :: Doc ann @@ -134,6 +126,5 @@ withDebugBundle :: Doc ann -> Doc ann withDebugBundle msg = vsep [ msg - , "" , requestDebugBundle ] diff --git a/src/Container/Docker/OciManifest.hs b/src/Container/Docker/OciManifest.hs index f89f49062f..7033484420 100644 --- a/src/Container/Docker/OciManifest.hs +++ b/src/Container/Docker/OciManifest.hs @@ -25,13 +25,15 @@ import Container.Docker.SourceParser ( ) import Control.Effect.Diagnostics (ToDiagnostic, renderDiagnostic) import Data.Aeson (FromJSON (parseJSON), withObject, withText, (.:)) +import Data.Error (SourceLocation, createBlock) import Data.List.NonEmpty ((<|)) import Data.List.NonEmpty qualified as NonEmpty import Data.String.Conversion (toString) import Data.Text (Text) import Data.Text qualified as Text -import Effect.Logger (vsep) -import Prettyprinter (indent, line, pretty) +import Effect.Logger (renderIt, vsep) +import Errata (errataSimple) +import Prettyprinter (indent, line) supportedManifestKinds :: [Text] supportedManifestKinds = @@ -176,17 +178,22 @@ mkLayerTarFileName (OciManifestLayer (RepoDigest digest) _) = removeDigestAlgori removeDigestAlgorithm :: Text -> Text removeDigestAlgorithm = snd . Text.breakOnEnd ":" -data NotSupportedManifestFmt = NotSupportedManifestFmt Text RegistryImageSource +data NotSupportedManifestFmt + = NotSupportedManifestFmt SourceLocation Text RegistryImageSource instance ToDiagnostic NotSupportedManifestFmt where - renderDiagnostic (NotSupportedManifestFmt fmt imgSrc) = - vsep - [ pretty $ "Manifest format is not supported: " <> fmt - , line <> "Workaround:" <> line - , indent 2 $ - vsep - [ "Export the image:" - , line - , suggestDockerExport imgSrc - ] - ] + renderDiagnostic (NotSupportedManifestFmt srcLoc fmt imgSrc) = do + let header = "Manifest format is not supported: " <> fmt + body = + renderIt $ + vsep + [ "Workaround:" <> line + , indent 2 $ + vsep + [ "Export the image:" + , line + , suggestDockerExport imgSrc + ] + ] + block = createBlock srcLoc Nothing Nothing + errataSimple (Just header) block (Just body) diff --git a/src/Container/Errors.hs b/src/Container/Errors.hs index 683e1c9e7c..50c0c42f94 100644 --- a/src/Container/Errors.hs +++ b/src/Container/Errors.hs @@ -3,11 +3,15 @@ module Container.Errors ( EndpointDoesNotSupportNativeContainerScan (..), ) where +import App.Support (supportUrl) import Codec.Archive.Tar qualified as Tar import Control.Exception (Exception) +import Data.Error (SourceLocation, createBlock) import Data.List.NonEmpty (NonEmpty) +import Data.String.Conversion (toText) import Diag.Diagnostic (ToDiagnostic (renderDiagnostic)) -import Effect.Logger (pretty) +import Effect.Logger (pretty, renderIt) +import Errata (Errata (..), errataSimple) import Prettyprinter (vsep) -- | Errors that can be encountered when parsing a container image. @@ -35,20 +39,23 @@ instance Show ContainerImgParsingError where instance Exception ContainerImgParsingError instance ToDiagnostic ContainerImgParsingError where - renderDiagnostic = pretty . show + renderDiagnostic e = Errata (Just (toText $ show e)) [] Nothing instance ToDiagnostic (NonEmpty ContainerImgParsingError) where - renderDiagnostic = pretty . show + renderDiagnostic e = Errata (Just (toText $ show e)) [] Nothing -data EndpointDoesNotSupportNativeContainerScan = EndpointDoesNotSupportNativeContainerScan +newtype EndpointDoesNotSupportNativeContainerScan = EndpointDoesNotSupportNativeContainerScan SourceLocation instance ToDiagnostic EndpointDoesNotSupportNativeContainerScan where - renderDiagnostic (EndpointDoesNotSupportNativeContainerScan) = - vsep - [ "Provided endpoint does not support native container scans." - , "" - , "Container scanning with new scanner is not supported for your FOSSA endpoint." - , "" - , "Upgrade your FOSSA instance to v4.0.37 or downgrade your FOSSA CLI to 3.4.x" - , "" - , "Please contact FOSSA support for more assistance." - ] + renderDiagnostic (EndpointDoesNotSupportNativeContainerScan srcLoc) = do + let header = "Provided endpoint does not support native container scans" + body = + renderIt $ + vsep + [ "Container scanning with new scanner is not supported for your FOSSA endpoint." + , "" + , "Upgrade your FOSSA instance to v4.0.37 or downgrade your FOSSA CLI to 3.4.x" + , "" + , "Please contact FOSSA support at " <> pretty supportUrl <> " for more assistance." + ] + block = createBlock srcLoc Nothing Nothing + errataSimple (Just header) block (Just body) diff --git a/src/Control/Carrier/ContainerRegistryApi.hs b/src/Control/Carrier/ContainerRegistryApi.hs index ec90ce114e..9e2d9b5665 100644 --- a/src/Control/Carrier/ContainerRegistryApi.hs +++ b/src/Control/Carrier/ContainerRegistryApi.hs @@ -75,6 +75,7 @@ import Data.Aeson (eitherDecode, encode) import Data.ByteString (ByteString, writeFile) import Data.ByteString.Lazy qualified as ByteStringLazy import Data.Conduit.Zlib (ungzip) +import Data.Error (getSourceLocation) import Data.Maybe (fromMaybe) import Data.String.Conversion ( LazyStrict (toStrict), @@ -209,6 +210,7 @@ getImageManifest src = context "Getting Image Manifest" $ do else fatal $ NotSupportedManifestFmt + getSourceLocation (fromMaybe "" $ getContentType . responseHeaders $ resp) src diff --git a/src/Control/Carrier/ContainerRegistryApi/Errors.hs b/src/Control/Carrier/ContainerRegistryApi/Errors.hs index ab2cc98bba..8c2aeca628 100644 --- a/src/Control/Carrier/ContainerRegistryApi/Errors.hs +++ b/src/Control/Carrier/ContainerRegistryApi/Errors.hs @@ -7,12 +7,15 @@ module Control.Carrier.ContainerRegistryApi.Errors ( ) where import Data.Aeson (FromJSON (parseJSON), withObject, withText, (.:)) -import Data.String.Conversion (toString) +import Data.Error (renderErrataStack) +import Data.String.Conversion (ToText (toText), toString) import Data.Text (Text) import Diag.Diagnostic (ToDiagnostic (..), renderDiagnostic) +import Effect.Logger (renderIt) +import Errata (Errata (..)) import Network.HTTP.Types (Status (statusCode)) import Network.URI (URI) -import Prettyprinter (indent, line, pretty, vsep) +import Prettyprinter (indent, pretty, vsep) -- | OCI Registry Error Body. -- Refer to: https://github.com/opencontainers/distribution-spec/blob/main/spec.md#error-codes @@ -70,39 +73,44 @@ instance FromJSON ContainerRegistryApiError where ContainerRegistryApiError <$> o .: "code" <*> o .: "message" instance ToDiagnostic (URI, ContainerRegistryApiErrorBody) where - renderDiagnostic (uri, ContainerRegistryApiErrorBody errs) = - vsep - [ pretty $ "Caught API error from: " <> show uri - , line - , "API errors:" - , line - , indent 4 $ vsep $ map renderDiagnostic errs - ] + renderDiagnostic (uri, ContainerRegistryApiErrorBody errs) = do + let header = "Caught API error from: " <> toText (show uri) + apiErrs = pretty $ renderErrataStack (map renderDiagnostic errs) + body = + renderIt $ + vsep + [ "API errors:" + , indent 4 apiErrs + ] + Errata (Just header) [] (Just body) instance ToDiagnostic ContainerRegistryApiError where - renderDiagnostic (ContainerRegistryApiError errKind msg) = - vsep - [ pretty $ "Error code: " <> (show errKind) - , pretty $ "Error message: " <> msg - ] + renderDiagnostic (ContainerRegistryApiError errKind msg) = do + let header = + renderIt $ + vsep + [ pretty $ "Error code: " <> (show errKind) + , pretty $ "Error message: " <> msg + ] + Errata (Just header) [] Nothing -- * Other Errors data UnknownApiError = UnknownApiError URI Status instance ToDiagnostic UnknownApiError where - renderDiagnostic (UnknownApiError uri status) = - vsep - [ "Caught unexpected error from: " - , indent 4 $ pretty $ "(" <> show (statusCode status) <> ") " <> show uri - ] + renderDiagnostic (UnknownApiError uri status) = do + let header = + renderIt $ + vsep + [ "Caught unexpected error from:" <> pretty ("(" <> show (statusCode status) <> ") " <> show uri) + ] + Errata (Just header) [] Nothing newtype FailedToParseAuthChallenge = FailedToParseAuthChallenge Text instance ToDiagnostic FailedToParseAuthChallenge where - renderDiagnostic (FailedToParseAuthChallenge err) = - vsep - [ "Failed to parse authorization challenge: " - , line - , indent 4 $ pretty err - ] + renderDiagnostic (FailedToParseAuthChallenge err) = do + let header = "Failed to parse authorization challenge" + body = err + Errata (Just header) [] (Just body) diff --git a/src/Control/Carrier/FossaApiClient/Internal/FossaAPIV1.hs b/src/Control/Carrier/FossaApiClient/Internal/FossaAPIV1.hs index d0087936ef..ba6107b6d1 100644 --- a/src/Control/Carrier/FossaApiClient/Internal/FossaAPIV1.hs +++ b/src/Control/Carrier/FossaApiClient/Internal/FossaAPIV1.hs @@ -60,7 +60,7 @@ import App.Support ( reportFossaBugErrorMsg, reportNetworkErrorMsg, reportTransientErrorMsg, - requestReportIfPersists, + requestReportIfPersistsWithDebugBundle, ) import App.Types ( FullFileUploads (FullFileUploads), @@ -97,6 +97,7 @@ import Data.ByteString qualified as BS import Data.ByteString.Char8 qualified as C import Data.ByteString.Lazy (ByteString) import Data.Data (Proxy (Proxy)) +import Data.Error (DiagnosticStyle (..), SourceLocation, applyDiagnosticStyle, createBlock, createBody, getSourceLocation) import Data.List.NonEmpty (NonEmpty) import Data.List.NonEmpty qualified as NE import Data.Map (Map) @@ -113,9 +114,11 @@ import Effect.Logger ( indent, newlinePreceding, newlineTrailing, + renderIt, vsep, (<+>), ) +import Errata (Errata (..), errataSimple) import Fossa.API.Types ( AnalyzedPathDependenciesResp, ApiOpts, @@ -172,7 +175,6 @@ import Network.HTTP.Types (statusCode) import Network.HTTP.Types qualified as HTTP import Parse.XML (FromXML (..), child, parseXML, xmlErrorPretty) import Path (File, Path, Rel, toFilePath) -import Prettyprinter (viaShow) import Srclib.Types ( FullSourceUnit, LicenseSourceUnit, @@ -315,269 +317,475 @@ data FossaError instance ToDiagnostic FossaError where renderDiagnostic = \case - InternalException exception -> - vsep - [ "A socket-level error occurred when accessing the FOSSA API:" - , "" - , indent 4 $ pretty . displayException $ exception - , "" - , "These errors are usually related to TLS issues or the host being unreachable." - , "For troubleshooting steps with TLS issues, please refer to:" - , indent 4 $ pretty ("- " <> fossaSslCertDocsUrl) - , "" - , reportDefectMsg - ] - JsonDeserializeError err -> "An error occurred when deserializing a response from the FOSSA API:" <+> pretty err - BackendPublicFacingError pfe -> - vsep - [ "The FOSSA endpoint reported an error:" - , "" - , indent 4 $ pretty . fpeMessage $ pfe - , "" - , "Error UUID from API:" - , "" - , indent 4 $ pretty . fpeUuid $ pfe - , "" - , reportDefectMsg - , "Please include the error UUID in your request." - ] - InvalidUrlError url reason -> - vsep - [ "The URL provided is invalid." - , "" - , indent 4 $ "Provided:" <+> pretty url - , indent 6 $ "Reason:" <+> pretty reason - , "" - , reportDefectMsg - ] + InternalException exception -> do + let header = "A socket-level error occurred when accessing the FOSSA API" + content = + renderIt $ + vsep + [ indent 2 $ pretty . displayException $ exception + , "" + , "These errors are usually related to TLS issues or the host being unreachable." + ] + help = "For troubleshooting steps with TLS issues, please refer to the provided documentation" + support = renderIt reportDefectMsg + body = createBody (Just content) (Just fossaSslCertDocsUrl) (Just support) (Just help) Nothing + Errata (Just header) [] (Just body) + -- vsep + -- [ "A socket-level error occurred when accessing the FOSSA API:" + -- , "" + -- , indent 4 $ pretty . displayException $ exception + -- , "" + -- , "These errors are usually related to TLS issues or the host being unreachable." + -- , "For troubleshooting steps with TLS issues, please refer to:" + -- , indent 4 $ pretty ("- " <> fossaSslCertDocsUrl) + -- , "" + -- , reportDefectMsg + -- ] + JsonDeserializeError err -> do + let header = "An error occurred when deserializing a response from the FOSSA API:" <> toText err + Errata (Just header) [] Nothing + BackendPublicFacingError pfe -> do + let header = "The FOSSA endpoint reported an error: " <> fpeMessage pfe + content = "Error UUID from API: " <> fpeUuid pfe + support = (renderIt reportDefectMsg) <> "Please include the error UUID in your request." + body = createBody (Just content) Nothing (Just support) Nothing Nothing + Errata (Just header) [] (Just body) + -- vsep + -- [ "The FOSSA endpoint reported an error:" + -- , "" + -- , indent 4 $ pretty . fpeMessage $ pfe + -- , "" + -- , "Error UUID from API:" + -- , "" + -- , indent 4 $ pretty . fpeUuid $ pfe + -- , "" + -- , reportDefectMsg + -- , "Please include the error UUID in your request." + -- ] + InvalidUrlError url reason -> do + let header = "The URL provided is invalid" + content = "Reason: " <> toText reason + ctx = "Provided: " <> toText url + body = createBody (Just content) Nothing (Just $ renderIt reportDefectMsg) Nothing (Just ctx) + Errata (Just header) [] (Just body) + -- vsep + -- [ "The URL provided is invalid." + -- , "" + -- , indent 4 $ "Provided:" <+> pretty url + -- , indent 6 $ "Reason:" <+> pretty reason + -- , "" + -- , reportDefectMsg + -- ] StatusCodeError ereq eres -> case statusCode $ responseStatus eres of - 403 -> - vsep - [ "The endpoint returned status code 403." - , "" - , "Typically, this status code indicates an authentication problem with the API." - , "However, FOSSA reports invalid API keys using a different mechanism;" - , "this likely means that some other service on your network intercepted the request" - , "and reported this status code. This might be a proxy or some other network appliance." - , "" - , indent 4 $ "Request:" <+> renderRequest ereq - , indent 4 $ "Response:" <+> renderResponse eres - , "" - , reportNetworkErrorMsg - ] - other -> - vsep - [ "The FOSSA endpoint returned an unexpected status code: " <> viaShow other - , "" - , "While HTTP responses typically come from the FOSSA API," - , "it's also possible that some other device on the network sent this response." - , "" - , "For a list of HTTP status codes and what they typically mean, see:" - , "https://developer.mozilla.org/en-US/docs/Web/HTTP/Status." - , "" - , indent 4 $ "Request:" <+> renderRequest ereq - , indent 4 $ "Response:" <+> renderResponse eres - , "" - , reportTransientErrorMsg - ] - TooManyRedirectsError txns -> - newlineTrailing - "Too many redirects were encountered when communicating with the FOSSA endpoint." - <> "Network request log:" - <> vsep (fmap (\(ereq, eres) -> indent 4 $ renderRequestResponse ereq eres) txns) - <> newlinePreceding reportNetworkErrorMsg - OverlongHeadersError ereq -> - vsep - [ "The HTTP headers provided by the server were too long." - , "" - , indent 4 "Request:" <+> renderRequest ereq - , "" - , reportNetworkErrorMsg - ] - ResponseTimeoutError ereq -> - vsep - [ "A connection to the FOSSA endpoint was established, but the service took too long to respond." - , "" - , indent 4 "Request:" <+> renderRequest ereq - , "" - , reportNetworkErrorMsg - ] - ConnectionTimeoutError ereq -> - vsep - [ "The request to the FOSSA endpoint took too long to send." - , "" - , "This typically means that the CLI is being asked to send too much data" - , "with the current network speed (for example, uploading large archives)," - , "although this can also be a transient error caused by congested" - , "networking conditions between the CLI and the FOSSA API." - , "" - , "To reduce the likelihood of this error, ensure that only data you really" - , "need FOSSA to scan is being uploaded." - , "" - , indent 4 "Request:" <+> renderRequest ereq - , "" - , requestReportIfPersists - ] - ConnectionFailureError ereq err -> - vsep - [ "Connecting to the FOSSA endpoint failed:" - , "" - , indent 4 "Request:" <+> renderRequest ereq - , indent 4 "Error:" <+> pretty (displayException err) - , "" - , reportNetworkErrorMsg - ] - InvalidStatusLineError ereq status -> - vsep - [ "The FOSSA endpoint returned a status that could not be parsed:" - , "" - , indent 4 "Request:" <+> renderRequest ereq - , indent 4 "Status:" <+> pretty status - , "" - , reportFossaBugErrorMsg $ fossaEnvironment ereq - ] - InvalidResponseHeaderError ereq header -> - vsep - [ "The FOSSA endpoint returned a header which could not be parsed:" - , "" - , indent 4 "Request:" <+> renderRequest ereq - , indent 4 "Header:" <+> pretty header - , "" - , reportFossaBugErrorMsg $ fossaEnvironment ereq - ] - InvalidRequestHeaderError ereq header -> - vsep - [ "The FOSSA CLI provided a header which was not HTTP compliant:" - , "" - , indent 4 "Request:" <+> renderRequest ereq - , indent 4 "Header:" <+> pretty header - , "" - , reportCliBugErrorMsg - ] - ProxyConnectError ereq host port status -> - vsep - [ "The proxy specified for FOSSA to use returned an unexpected status code." - , "" - , indent 4 "Request:" <+> renderRequest ereq - , indent 4 "Proxy:" - , indent 6 "Server:" <+> pretty host <+> ":" <> pretty port - , indent 6 "Status:" <+> pretty (HTTP.statusCode status) - , "" - , reportNetworkErrorMsg - ] - NoResponseDataError ereq -> - vsep - [ "The connection to the FOSSA endpoint was closed without a response." - , "" - , indent 4 "Request:" <+> renderRequest ereq - , "" - , reportFossaBugErrorMsg $ fossaEnvironment ereq - ] - TlsNotSupportedError ereq -> - if fossaEnvironment ereq == FossaEnvironmentCloud - then - vsep - [ "The FOSSA endpoint reported that it does not support TLS connections." - , "This request is connecting to FOSSA's cloud environment, which only supports TLS connections." - , "" - , indent 4 "Request:" <+> renderRequest ereq - , "" - , reportNetworkErrorMsg - ] - else - vsep - [ "The FOSSA endpoint reported that it does not support TLS connections." - , "This request is not connecting to FOSSA's cloud environment, so this is up to the FOSSA administrators in your organization." - , "" - , indent 4 "Request:" <+> renderRequest ereq - , "" - , "Try again with an `http://` URL." - , "The FOSSA endpoint URL may be specified in `.fossa.yml` or with the `-e` or `--endpoint` arguments." - , "" - , reportDefectWithDebugBundle - ] - WrongRequestBodyStreamSizeError ereq expect got -> - vsep - [ "The FOSSA CLI did not provide a request body with the correct length." - , "" - , indent 4 "Request:" <+> renderRequest ereq - , indent 6 "Expected size (bytes):" <+> pretty (show expect) - , indent 6 "Provided size (bytes):" <+> pretty (show got) - , "" - , reportCliBugErrorMsg - ] - ResponseBodyTooShortError ereq expect got -> - vsep - [ "The FOSSA endpoint provided a response body that was too short." - , "" - , indent 4 "Request:" <+> renderRequest ereq - , indent 6 "Expected size (bytes):" <+> pretty (show expect) - , indent 6 "Provided size (bytes):" <+> pretty (show got) - , "" - , reportFossaBugErrorMsg $ fossaEnvironment ereq - ] - InvalidChunkHeadersError ereq -> - vsep - [ "The FOSSA endpoint provided a chunked response but it had invalid headers." - , "" - , indent 4 "Request:" <+> renderRequest ereq - , "" - , reportFossaBugErrorMsg $ fossaEnvironment ereq - ] - IncompleteHeadersError ereq -> - vsep - [ "The FOSSA endpoint returned an incomplete set of headers." - , "" - , indent 4 "Request:" <+> renderRequest ereq - , "" - , reportFossaBugErrorMsg $ fossaEnvironment ereq - ] - InvalidDestinationHostError ereq -> - vsep - [ "The host provided as the FOSSA CLI endpoint is invalid." - , "" - , indent 4 "Request:" <+> renderRequest ereq - , "" - , reportDefectMsg - ] - HttpZlibError ereq msg -> - vsep - [ "The FOSSA endpoint provided a response body that was unable to decompress." - , "" - , indent 4 "Request:" <+> renderRequest ereq - , indent 6 "Decompression error:" <+> pretty msg - , "" - , reportNetworkErrorMsg - ] - InvalidProxyEnvironmentVariableError ereq var val -> - vsep - [ "A provided environment variable used to configure the proxy connection is invalid." - , "" - , indent 4 "Request:" <+> renderRequest ereq - , indent 4 "Environment variable:" - , indent 6 "Name:" <+> pretty var - , indent 6 "Value:" <+> pretty val - , "" - , reportDefectMsg - ] - ConnectionClosedError ereq -> - vsep - [ "FOSSA CLI attempted to reuse a connection that was closed." - , "" - , indent 4 "Request:" <+> renderRequest ereq - , "" - , reportCliBugErrorMsg - ] - InvalidProxySettingsError ereq msg -> - vsep - [ "The proxy settings provided were not valid." - , "" - , indent 4 "Request:" <+> renderRequest ereq - , indent 4 "Proxy settings:" <+> pretty msg - , "" - , reportDefectMsg - ] + 403 -> do + let header = "The endpoint returned status code 403" + content = + renderIt $ + vsep + [ newlineTrailing "Response:" <+> renderResponse eres + , "Typically, this status code indicates an authentication problem with the API." + , "However, FOSSA reports invalid API keys using a different mechanism;" + , "this likely means that some other service on your network intercepted the request" + , "and reported this status code. This might be a proxy or some other network appliance." + , "" + , reportNetworkErrorMsg + ] + ctx = "Provided request: " <> renderIt (renderRequest ereq) + body = createBody (Just content) Nothing (Just $ renderIt requestReportIfPersistsWithDebugBundle) Nothing (Just ctx) + Errata (Just header) [] (Just body) + -- vsep + -- [ "The endpoint returned status code 403." + -- , "" + -- , "Typically, this status code indicates an authentication problem with the API." + -- , "However, FOSSA reports invalid API keys using a different mechanism;" + -- , "this likely means that some other service on your network intercepted the request" + -- , "and reported this status code. This might be a proxy or some other network appliance." + -- , "" + -- , indent 4 $ "Request:" <+> renderRequest ereq + -- , indent 4 $ "Response:" <+> renderResponse eres + -- , "" + -- , reportNetworkErrorMsg + -- ] + other -> do + let header = "The FOSSA endpoint returned an unexpected status code: " <> toText other + content = + renderIt $ + vsep + [ newlineTrailing "Response:" <+> renderResponse eres + , "While HTTP responses typically come from the FOSSA API, it's also possible that some other device on the network sent this response." + , reportTransientErrorMsg + ] + help = "For a list of HTTP status codes and what they typically mean, see: https://developer.mozilla.org/en-US/docs/Web/HTTP/Status" + ctx = "Request: " <> renderIt (renderRequest ereq) + body = createBody (Just content) Nothing (Just $ renderIt requestReportIfPersistsWithDebugBundle) (Just help) (Just ctx) + Errata (Just header) [] (Just body) + -- vsep + -- [ "The FOSSA endpoint returned an unexpected status code: " <> viaShow other + -- , "" + -- , "While HTTP responses typically come from the FOSSA API," + -- , "it's also possible that some other device on the network sent this response." + -- , "" + -- , "For a list of HTTP status codes and what they typically mean, see:" + -- , "https://developer.mozilla.org/en-US/docs/Web/HTTP/Status." + -- , "" + -- , indent 4 $ "Request:" <+> renderRequest ereq + -- , indent 4 $ "Response:" <+> renderResponse eres + -- , "" + -- , reportTransientErrorMsg + -- ] + TooManyRedirectsError txns -> do + let header = "Too many redirects were encountered when communicating with the FOSSA endpoint" + content = + renderIt $ + vsep + [ "Network request log:" + , vsep (fmap (\(ereq, eres) -> indent 2 $ renderRequestResponse ereq eres) txns) + , newlinePreceding reportNetworkErrorMsg + ] + body = createBody (Just content) Nothing (Just $ renderIt requestReportIfPersistsWithDebugBundle) Nothing Nothing + Errata (Just header) [] (Just body) + -- newlineTrailing + -- "Too many redirects were encountered when communicating with the FOSSA endpoint." + -- <> "Network request log:" + -- <> vsep (fmap (\(ereq, eres) -> indent 4 $ renderRequestResponse ereq eres) txns) + -- <> newlinePreceding reportNetworkErrorMsg + OverlongHeadersError ereq -> do + let header = "The HTTP headers provided by the server were too long" + ctx = "Request: " <> renderIt (renderRequest ereq) + body = createBody Nothing Nothing (Just $ renderIt requestReportIfPersistsWithDebugBundle) Nothing (Just ctx) + Errata (Just header) [] (Just body) + -- vsep + -- [ "The HTTP headers provided by the server were too long." + -- , "" + -- , indent 4 "Request:" <+> renderRequest ereq + -- , "" + -- , reportNetworkErrorMsg + -- ] + ResponseTimeoutError ereq -> do + let header = "A connection to the FOSSA endpoint was established, but the service took too long to respond" + ctx = "Request: " <> renderIt (renderRequest ereq) + body = createBody Nothing Nothing (Just $ renderIt requestReportIfPersistsWithDebugBundle) Nothing (Just ctx) + Errata (Just header) [] (Just body) + -- vsep + -- [ "A connection to the FOSSA endpoint was established, but the service took too long to respond." + -- , "" + -- , indent 4 "Request:" <+> renderRequest ereq + -- , "" + -- , reportNetworkErrorMsg + -- ] + ConnectionTimeoutError ereq -> do + let header = "The request to the FOSSA endpoint took too long to send" + content = + renderIt $ + vsep + [ "This typically means that the CLI is being asked to send too much data" + , "with the current network speed (for example, uploading large archives)," + , "although this can also be a transient error caused by congested" + , "networking conditions between the CLI and the FOSSA API." + ] + help = "To reduce the likelihood of this error, ensure that only data you really need FOSSA to scan is being uploaded" + ctx = "Request: " <> renderIt (renderRequest ereq) + body = createBody (Just content) Nothing (Just $ renderIt requestReportIfPersistsWithDebugBundle) (Just help) (Just ctx) + Errata (Just header) [] (Just body) + + -- vsep + -- [ "The request to the FOSSA endpoint took too long to send." + -- , "" + -- , "This typically means that the CLI is being asked to send too much data" + -- , "with the current network speed (for example, uploading large archives)," + -- , "although this can also be a transient error caused by congested" + -- , "networking conditions between the CLI and the FOSSA API." + -- , "" + -- , "To reduce the likelihood of this error, ensure that only data you really" + -- , "need FOSSA to scan is being uploaded." + -- , "" + -- , indent 4 "Request:" <+> renderRequest ereq + -- , "" + -- , requestReportIfPersists + -- ] + ConnectionFailureError ereq err -> do + let header = "Connecting to the FOSSA endpoint failed" + content = + renderIt $ + vsep + [ "Error:" <+> pretty (displayException err) + , newlinePreceding reportNetworkErrorMsg + ] + ctx = "Request: " <> renderIt (renderRequest ereq) + body = createBody (Just content) Nothing (Just $ renderIt requestReportIfPersistsWithDebugBundle) Nothing (Just ctx) + Errata (Just header) [] (Just body) + -- vsep + -- [ "Connecting to the FOSSA endpoint failed:" + -- , "" + -- , indent 4 "Request:" <+> renderRequest ereq + -- , indent 4 "Error:" <+> pretty (displayException err) + -- , "" + -- , reportNetworkErrorMsg + -- ] + InvalidStatusLineError ereq status -> do + let header = "The FOSSA endpoint returned a status that could not be parsed" + content = + renderIt $ + vsep + [ "Status:" <+> pretty status + , newlinePreceding $ reportFossaBugErrorMsg $ fossaEnvironment ereq + ] + ctx = "Request: " <> renderIt (renderRequest ereq) + body = createBody (Just content) Nothing (Just $ renderIt requestReportIfPersistsWithDebugBundle) Nothing (Just ctx) + Errata (Just header) [] (Just body) + -- vsep + -- [ "The FOSSA endpoint returned a status that could not be parsed:" + -- , "" + -- , indent 4 "Request:" <+> renderRequest ereq + -- , indent 4 "Status:" <+> pretty status + -- , "" + -- , reportFossaBugErrorMsg $ fossaEnvironment ereq + -- ] + InvalidResponseHeaderError ereq header -> do + let errHeader = "The FOSSA endpoint returned a header which could not be parsed" + content = + renderIt $ + vsep + [ "Header:" <+> pretty header + , newlinePreceding $ reportFossaBugErrorMsg $ fossaEnvironment ereq + ] + ctx = "Request: " <> renderIt (renderRequest ereq) + body = createBody (Just content) Nothing (Just $ renderIt requestReportIfPersistsWithDebugBundle) Nothing (Just ctx) + Errata (Just errHeader) [] (Just body) + -- vsep + -- [ "The FOSSA endpoint returned a header which could not be parsed:" + -- , "" + -- , indent 4 "Request:" <+> renderRequest ereq + -- , indent 4 "Header:" <+> pretty header + -- , "" + -- , reportFossaBugErrorMsg $ fossaEnvironment ereq + -- ] + InvalidRequestHeaderError ereq header -> do + let errHeader = "The FOSSA CLI provided a header which was not HTTP compliant" + content = + renderIt $ + vsep + [ "Header:" <+> pretty header + , reportCliBugErrorMsg + ] + ctx = "Request: " <> renderIt (renderRequest ereq) + body = createBody (Just content) Nothing (Just $ renderIt requestReportIfPersistsWithDebugBundle) Nothing (Just ctx) + Errata (Just errHeader) [] (Just body) + -- vsep + -- [ "The FOSSA CLI provided a header which was not HTTP compliant:" + -- , "" + -- , indent 4 "Request:" <+> renderRequest ereq + -- , indent 4 "Header:" <+> pretty header + -- , "" + -- , reportCliBugErrorMsg + -- ] + ProxyConnectError ereq host port status -> do + let header = "The FOSSA CLI provided a header which was not HTTP compliant" + content = + renderIt $ + vsep + [ "Proxy:" + , indent 2 "Server:" <+> pretty host <+> ":" <> pretty port + , indent 2 "Status:" <+> pretty (HTTP.statusCode status) + , newlinePreceding reportNetworkErrorMsg + ] + ctx = "Request: " <> renderIt (renderRequest ereq) + body = createBody (Just content) Nothing (Just $ renderIt requestReportIfPersistsWithDebugBundle) Nothing (Just ctx) + Errata (Just header) [] (Just body) + -- vsep + -- [ "The proxy specified for FOSSA to use returned an unexpected status code." + -- , "" + -- , indent 4 "Request:" <+> renderRequest ereq + -- , indent 4 "Proxy:" + -- , indent 6 "Server:" <+> pretty host <+> ":" <> pretty port + -- , indent 6 "Status:" <+> pretty (HTTP.statusCode status) + -- , "" + -- , reportNetworkErrorMsg + -- ] + NoResponseDataError ereq -> do + let header = "he connection to the FOSSA endpoint was closed without a response" + content = renderIt $ reportFossaBugErrorMsg $ fossaEnvironment ereq + ctx = "Request: " <> renderIt (renderRequest ereq) + body = createBody (Just content) Nothing (Just $ renderIt requestReportIfPersistsWithDebugBundle) Nothing (Just ctx) + Errata (Just header) [] (Just body) + -- vsep + -- [ "The connection to the FOSSA endpoint was closed without a response." + -- , "" + -- , indent 4 "Request:" <+> renderRequest ereq + -- , "" + -- , reportFossaBugErrorMsg $ fossaEnvironment ereq + -- ] + TlsNotSupportedError ereq -> do + let header = "The FOSSA endpoint reported that it does not support TLS connections" + ctx = renderIt $ renderRequest ereq + (content, support, maybeHelp) = + if fossaEnvironment ereq == FossaEnvironmentCloud + then + ( renderIt $ + vsep + [ "This request is connecting to FOSSA's cloud environment, which only supports TLS connections." + , newlinePreceding reportNetworkErrorMsg + ] + , renderIt requestReportIfPersistsWithDebugBundle + , Nothing + ) + else + ( renderIt $ vsep ["This request is not connecting to FOSSA's cloud environment, so this is up to the FOSSA administrators in your organization."] + , renderIt reportDefectWithDebugBundle + , Just "Try again with an `http://` URL. The FOSSA endpoint URL may be specified in `.fossa.yml` or with the `-e` or `--endpoint` arguments" + ) + body = createBody (Just content) Nothing (Just support) maybeHelp (Just ctx) + Errata (Just header) [] (Just body) + WrongRequestBodyStreamSizeError ereq expect got -> do + let header = "The FOSSA CLI did not provide a request body with the correct length" + ctx = "Request: " <> renderIt (renderRequest ereq) + content = + renderIt $ + vsep + [ "Expected size (bytes):" <+> pretty (show expect) + , "Actual size (bytes):" <+> pretty (show got) + , newlinePreceding reportCliBugErrorMsg + ] + body = createBody (Just content) Nothing (Just $ renderIt requestReportIfPersistsWithDebugBundle) Nothing (Just ctx) + Errata (Just header) [] (Just body) + -- vsep + -- [ "The FOSSA CLI did not provide a request body with the correct length." + -- , "" + -- , indent 4 "Request:" <+> renderRequest ereq + -- , indent 6 "Expected size (bytes):" <+> pretty (show expect) + -- , indent 6 "Provided size (bytes):" <+> pretty (show got) + -- , "" + -- , reportCliBugErrorMsg + -- ] + ResponseBodyTooShortError ereq expect got -> do + let header = "The FOSSA CLI did not provide a request body with the correct length" + ctx = "Request: " <> renderIt (renderRequest ereq) + content = + renderIt $ + vsep + [ "Expected size (bytes):" <+> pretty (show expect) + , "Actual size (bytes):" <+> pretty (show got) + , newlinePreceding $ reportFossaBugErrorMsg $ fossaEnvironment ereq + ] + body = createBody (Just content) Nothing (Just $ renderIt requestReportIfPersistsWithDebugBundle) Nothing (Just ctx) + Errata (Just header) [] (Just body) + -- vsep + -- [ "The FOSSA endpoint provided a response body that was too short." + -- , "" + -- , indent 4 "Request:" <+> renderRequest ereq + -- , indent 6 "Expected size (bytes):" <+> pretty (show expect) + -- , indent 6 "Provided size (bytes):" <+> pretty (show got) + -- , "" + -- , reportFossaBugErrorMsg $ fossaEnvironment ereq + -- ] + InvalidChunkHeadersError ereq -> do + let header = "The FOSSA endpoint provided a chunked response but it had invalid headers" + ctx = "Request: " <> renderIt (renderRequest ereq) + content = renderIt $ reportFossaBugErrorMsg $ fossaEnvironment ereq + body = createBody (Just content) Nothing (Just $ renderIt requestReportIfPersistsWithDebugBundle) Nothing (Just ctx) + Errata (Just header) [] (Just body) + -- vsep + -- [ "The FOSSA endpoint provided a chunked response but it had invalid headers." + -- , "" + -- , indent 4 "Request:" <+> renderRequest ereq + -- , "" + -- , reportFossaBugErrorMsg $ fossaEnvironment ereq + -- ] + IncompleteHeadersError ereq -> do + let header = "The FOSSA endpoint returned an incomplete set of headers" + ctx = "Request: " <> renderIt (renderRequest ereq) + content = renderIt $ reportFossaBugErrorMsg $ fossaEnvironment ereq + body = createBody (Just content) Nothing (Just $ renderIt requestReportIfPersistsWithDebugBundle) Nothing (Just ctx) + Errata (Just header) [] (Just body) + -- vsep + -- [ "The FOSSA endpoint returned an incomplete set of headers." + -- , "" + -- , indent 4 "Request:" <+> renderRequest ereq + -- , "" + -- , reportFossaBugErrorMsg $ fossaEnvironment ereq + -- ] + InvalidDestinationHostError ereq -> do + let header = "The host provided as the FOSSA CLI endpoint is invalid" + ctx = "Request: " <> renderIt (renderRequest ereq) + body = createBody Nothing Nothing (Just $ renderIt reportDefectMsg) Nothing (Just ctx) + Errata (Just header) [] (Just body) + -- vsep + -- [ "The host provided as the FOSSA CLI endpoint is invalid." + -- , "" + -- , indent 4 "Request:" <+> renderRequest ereq + -- , "" + -- , reportDefectMsg + -- ] + HttpZlibError ereq msg -> do + let header = "The FOSSA endpoint provided a response body that was unable to decompress" + ctx = "Request: " <> renderIt (renderRequest ereq) + content = + renderIt $ + vsep + [ "Decompression error:" <+> pretty msg + , newlinePreceding reportNetworkErrorMsg + ] + body = createBody (Just content) Nothing (Just $ renderIt requestReportIfPersistsWithDebugBundle) Nothing (Just ctx) + Errata (Just header) [] (Just body) + -- vsep + -- [ "The FOSSA endpoint provided a response body that was unable to decompress." + -- , "" + -- , indent 4 "Request:" <+> renderRequest ereq + -- , indent 6 "Decompression error:" <+> pretty msg + -- , "" + -- , reportNetworkErrorMsg + -- ] + InvalidProxyEnvironmentVariableError ereq var val -> do + let header = "A provided environment variable used to configure the proxy connection is invalid" + ctx = "Request: " <> renderIt (renderRequest ereq) + content = + renderIt $ + vsep + [ indent 2 "Environment variable:" + , indent 4 "Name:" <+> pretty var + , indent 4 "Value:" <+> pretty val + ] + body = createBody (Just content) Nothing (Just $ renderIt reportDefectMsg) Nothing (Just ctx) + Errata (Just header) [] (Just body) + -- vsep + -- [ "A provided environment variable used to configure the proxy connection is invalid." + -- , "" + -- , indent 4 "Request:" <+> renderRequest ereq + -- , indent 4 "Environment variable:" + -- , indent 6 "Name:" <+> pretty var + -- , indent 6 "Value:" <+> pretty val + -- , "" + -- , reportDefectMsg + -- ] + ConnectionClosedError ereq -> do + let header = "FOSSA CLI attempted to reuse a connection that was closed" + ctx = "Request: " <> renderIt (renderRequest ereq) + content = renderIt reportCliBugErrorMsg + body = createBody (Just content) Nothing (Just $ renderIt requestReportIfPersistsWithDebugBundle) Nothing (Just ctx) + Errata (Just header) [] (Just body) + -- vsep + -- [ "FOSSA CLI attempted to reuse a connection that was closed." + -- , "" + -- , indent 4 "Request:" <+> renderRequest ereq + -- , "" + -- , reportCliBugErrorMsg + -- ] + InvalidProxySettingsError ereq msg -> do + let header = "The proxy settings provided were not valid" + ctx = "Request: " <> renderIt (renderRequest ereq) + content = "Proxy settings:" <> msg + body = createBody (Just content) Nothing (Just $ renderIt reportDefectMsg) Nothing (Just ctx) + Errata (Just header) [] (Just body) + +-- vsep +-- [ "The proxy settings provided were not valid." +-- , "" +-- , indent 4 "Request:" <+> renderRequest ereq +-- , indent 4 "Proxy settings:" <+> pretty msg +-- , "" +-- , reportDefectMsg +-- ] containerUploadUrl :: Url scheme -> Url scheme containerUploadUrl baseurl = baseurl /: "api" /: "container" /: "upload" @@ -593,7 +801,7 @@ uploadNativeContainerScan apiOpts ProjectRevision{..} metadata scan = fossaReq $ supportsNativeScan <- orgSupportsNativeContainerScan <$> getOrganization apiOpts -- Sanity Check! if not supportsNativeScan - then fatal EndpointDoesNotSupportNativeContainerScan + then fatal (EndpointDoesNotSupportNativeContainerScan getSourceLocation) else do (baseUrl, baseOpts) <- useApiOpts apiOpts let locator = renderLocator $ Locator "custom" projectName (Just projectRevision) @@ -601,12 +809,12 @@ uploadNativeContainerScan apiOpts ProjectRevision{..} metadata scan = fossaReq $ "locator" =: locator <> "cliVersion" - =: cliVersion + =: cliVersion <> "managedBuild" - =: True + =: True <> maybe mempty ("branch" =:) projectBranch <> "scanType" - =: ("native" :: Text) + =: ("native" :: Text) <> mkMetadataOpts metadata projectName resp <- req POST (containerUploadUrl baseUrl) (ReqBodyJson scan) jsonResponse (baseOpts <> opts) pure $ responseBody resp @@ -647,9 +855,9 @@ uploadAnalysis apiOpts ProjectRevision{..} metadata sourceUnits = fossaReq $ do "locator" =: renderLocator (Locator "custom" projectName (Just projectRevision)) <> "cliVersion" - =: cliVersion + =: cliVersion <> "managedBuild" - =: True + =: True <> mkMetadataOpts metadata projectName -- Don't include branch if it doesn't exist, core may not handle empty string properly. <> maybe mempty ("branch" =:) projectBranch @@ -670,11 +878,11 @@ uploadAnalysisWithFirstPartyLicenses apiOpts ProjectRevision{..} metadata fullFi "locator" =: renderLocator (Locator "custom" projectName (Just projectRevision)) <> "cliVersion" - =: cliVersion + =: cliVersion <> "managedBuild" - =: True + =: True <> "cliLicenseScanType" - =: (fullFileUploadsToCliLicenseScanType fullFileUploads) + =: (fullFileUploadsToCliLicenseScanType fullFileUploads) <> mkMetadataOpts metadata projectName -- Don't include branch if it doesn't exist, core may not handle empty string properly. <> maybe mempty ("branch" =:) projectBranch @@ -1075,7 +1283,7 @@ getIssues apiOpts ProjectRevision{..} diffRevision = fossaReq $ do opts <- case (diffRevision, orgSupportsIssueDiffs org) of (Just (DiffRevision diffRev), True) -> pure (baseOpts <> "diffRevision" =: diffRev) - (Just _, False) -> fatal EndpointDoesNotSupportIssueDiffing + (Just _, False) -> fatal $ EndpointDoesNotSupportIssueDiffing getSourceLocation (Nothing, _) -> pure baseOpts response <- @@ -1088,15 +1296,14 @@ getIssues apiOpts ProjectRevision{..} diffRevision = fossaReq $ do pure (responseBody response) -data EndpointDoesNotSupportIssueDiffing = EndpointDoesNotSupportIssueDiffing +newtype EndpointDoesNotSupportIssueDiffing = EndpointDoesNotSupportIssueDiffing SourceLocation instance ToDiagnostic EndpointDoesNotSupportIssueDiffing where - renderDiagnostic (EndpointDoesNotSupportIssueDiffing) = - vsep - [ "Provided endpoint does not support issue diffing." - , "" - , "If this instance of FOSSA is on-premise, it likely needs to be updated." - ] + renderDiagnostic (EndpointDoesNotSupportIssueDiffing srcLoc) = do + let header = "Provided endpoint does not support issue diffing" + block = createBlock srcLoc Nothing Nothing + body = "If this instance of FOSSA is on-premise, it likely needs to be updated" + errataSimple (Just header) block (Just body) --------------- @@ -1128,11 +1335,11 @@ getAttributionJson apiOpts ProjectRevision{..} = fossaReq $ do opts = baseOpts <> "includeDeepDependencies" - =: True + =: True <> "includeHashAndVersionData" - =: True + =: True <> "dependencyInfoOptions[]" - =: packageDownloadUrl + =: packageDownloadUrl orgId <- organizationId <$> getOrganization apiOpts response <- req GET (attributionEndpoint baseUrl orgId (Locator "custom" projectName (Just projectRevision)) ReportJson) NoReqBody jsonResponse opts pure (responseBody response) diff --git a/src/Control/Carrier/Git.hs b/src/Control/Carrier/Git.hs index 9de1b43437..c8c58ac0f7 100644 --- a/src/Control/Carrier/Git.hs +++ b/src/Control/Carrier/Git.hs @@ -30,7 +30,6 @@ import Data.Time ( parseTimeM, ) import Data.Time.Format.ISO8601 (iso8601Show) -import Diag.Diagnostic (DiagnosticInfo (..)) import Effect.Exec ( AllowErr (Never), Command (..), @@ -38,6 +37,7 @@ import Effect.Exec ( Has, execThrow, ) +import Errata (Errata (..)) import Fossa.API.Types (Contributors (..)) import Path (Abs, Dir, Path) @@ -89,5 +89,5 @@ fetchGitContributors basedir = do data FailedToPerformGitLog = FailedToPerformGitLog instance ToDiagnostic FailedToPerformGitLog where renderDiagnostic _ = do - let ctx = "Could not retrieve git logs for contributor counting." - DiagnosticInfo Nothing Nothing Nothing Nothing Nothing (Just ctx) Nothing \ No newline at end of file + let header = "Could not retrieve git logs for contributor counting." + Errata (Just header) [] Nothing \ No newline at end of file diff --git a/src/Data/Error.hs b/src/Data/Error.hs index f5948a5c17..123b1ca92f 100644 --- a/src/Data/Error.hs +++ b/src/Data/Error.hs @@ -3,25 +3,22 @@ module Data.Error ( SourceLocation (..), + DiagnosticStyle (..), getSourceLocation, - buildErrorMessage, - buildHelpMessage, - buildDocumentationMessage, - buildContextMessage, createBlock, createBody, createError, - renderErrors, + renderErrataStack, + applyDiagnosticStyle, ) where -import Algebra.Graph.Export (render) import Data.Maybe (fromMaybe) +import Data.String.Conversion (ToText (toText)) import Data.Text (Text) import Data.Text.Lazy qualified as TL -import Errata (Block (..), Pointer (..), blockSimple, errataSimple, prettyErrors) +import Errata (Block (..), Errata (..), prettyErrors) import Errata.Source (Source (emptySource)) -import Errata.Styles (basicPointer, basicStyle, fancyRedPointer, fancyRedStyle, fancyStyle) -import Errata.Types (Errata (..)) +import Errata.Styles (fancyStyle) import GHC.Generics (Generic) import GHC.Stack (CallStack, SrcLoc (..), getCallStack) @@ -55,57 +52,49 @@ createBlock SourceLocation{..} maybeHeader = createBody :: Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Text createBody maybeContent maybeDocumentation maybeSupport maybeHelp maybeContext = do let content = fromMaybe "" maybeContent - documentation = maybe "" buildDocumentationMessage maybeDocumentation - support = maybe "" buildSupportMessage maybeSupport - help = maybe "" buildHelpMessage maybeHelp - context = maybe "" buildContextMessage maybeContext + documentation = maybe "" (buildMessageWithDiagnosticStyle DocumentationStyle) maybeDocumentation + support = maybe "" (buildMessageWithDiagnosticStyle SupportStyle) maybeSupport + help = maybe "" (buildMessageWithDiagnosticStyle HelpStyle) maybeHelp + context = maybe "" (buildMessageWithDiagnosticStyle ContextStyle) maybeContext content <> documentation <> support <> help <> context --- red ANSI escape code -errorColor :: Text -errorColor = "\x1b[31m" - --- yellow ANSI escape code -warningColor :: Text -warningColor = "\x1b[33m" - --- blue ANSI escape code -supportColor :: Text -supportColor = "\x1b[34m" - --- magenta ANSI escape code -documentationColor :: Text -documentationColor = "\x1b[35m" - --- cyan ANSI escape code -helpColor :: Text -helpColor = "\x1b[36m" - --- green ANSI escape code -contextColor :: Text -contextColor = "\x1b[32m" +data DiagnosticStyle + = ErrorStyle + | WarningStyle + | DocumentationStyle + | SupportStyle + | HelpStyle + | ContextStyle + +instance ToText DiagnosticStyle where + toText = \case + -- red ANSI escape code + ErrorStyle -> "\x1b[31m" <> "Error:" <> resetColor <> " " + -- yellow ANSI escape code + WarningStyle -> "\x1b[33m" <> "Warn:" <> resetColor <> " " + -- blue ANSI escape code + SupportStyle -> "\x1b[34m" <> "Support:" <> resetColor <> " " + -- magenta ANSI escape code + DocumentationStyle -> "\x1b[35m" <> "Documentation:" <> resetColor <> " " + -- cyan ANSI escape code + HelpStyle -> "\x1b[36m" <> "Help:" <> resetColor <> " " + -- green ANSI escape code + ContextStyle -> "\x1b[32m" <> "Context:" <> resetColor <> " " -- ANSI escape code to reset foreground text color resetColor :: Text resetColor = "\x1b[39m" -buildErrorMessage :: Text -> Text -buildErrorMessage msg = errorColor <> "Error:" <> resetColor <> " " <> msg - -buildSupportMessage :: Text -> Text -buildSupportMessage msg = supportColor <> "Support:" <> resetColor <> " " <> msg <> "\n" - -buildDocumentationMessage :: Text -> Text -buildDocumentationMessage msg = documentationColor <> "Documentation:" <> resetColor <> " " <> msg <> "\n" - -buildHelpMessage :: Text -> Text -buildHelpMessage msg = helpColor <> "Help:" <> resetColor <> " " <> msg <> "\n" +applyDiagnosticStyle :: DiagnosticStyle -> Errata -> Errata +applyDiagnosticStyle style Errata{..} = case errataHeader of + Just header -> Errata (Just $ toText style <> header) errataBlocks errataBody + _ -> Errata errataHeader errataBlocks errataBody -buildContextMessage :: Text -> Text -buildContextMessage msg = contextColor <> "Context:" <> resetColor <> " " <> msg +buildMessageWithDiagnosticStyle :: DiagnosticStyle -> Text -> Text +buildMessageWithDiagnosticStyle style msg = toText style <> msg <> "\n" -renderErrors :: [Errata] -> TL.Text -renderErrors = +renderErrataStack :: [Errata] -> TL.Text +renderErrataStack = prettyErrors @String emptySource \ No newline at end of file diff --git a/src/Data/String/Conversion.hs b/src/Data/String/Conversion.hs index 6df16933f5..0c68d25d19 100644 --- a/src/Data/String/Conversion.hs +++ b/src/Data/String/Conversion.hs @@ -60,6 +60,9 @@ instance ConvertUtf8 TL.Text BL.ByteString where class ToText a where toText :: a -> Text.Text +instance ToText Int where + toText = Text.pack . show + instance ToText Char where toText = Text.singleton diff --git a/src/Diag/Common.hs b/src/Diag/Common.hs index c5e41858cc..932a2f1374 100644 --- a/src/Diag/Common.hs +++ b/src/Diag/Common.hs @@ -4,22 +4,23 @@ module Diag.Common ( AllDirectDeps (..), ) where -import Diag.Diagnostic (DiagnosticInfo (..), ToDiagnostic (renderDiagnostic)) +import Diag.Diagnostic (ToDiagnostic (renderDiagnostic)) +import Errata (Errata (..)) data MissingDeepDeps = MissingDeepDeps instance ToDiagnostic MissingDeepDeps where renderDiagnostic (MissingDeepDeps) = do let header = "Could not analyze deep dependencies." - DiagnosticInfo (Just header) Nothing Nothing Nothing Nothing Nothing Nothing + Errata (Just header) [] Nothing data MissingEdges = MissingEdges instance ToDiagnostic MissingEdges where renderDiagnostic (MissingEdges) = do let header = "Could not analyze edges between dependencies." - DiagnosticInfo (Just header) Nothing Nothing Nothing Nothing Nothing Nothing + Errata (Just header) [] Nothing data AllDirectDeps = AllDirectDeps instance ToDiagnostic AllDirectDeps where renderDiagnostic (AllDirectDeps) = do let header = "Could not differentiate between direct and deep dependencies, all dependencies will be reported as direct." - DiagnosticInfo (Just header) Nothing Nothing Nothing Nothing Nothing Nothing + Errata (Just header) [] Nothing diff --git a/src/Diag/Diagnostic.hs b/src/Diag/Diagnostic.hs index 41eb66b4d4..b0d69e4e0d 100644 --- a/src/Diag/Diagnostic.hs +++ b/src/Diag/Diagnostic.hs @@ -3,34 +3,25 @@ module Diag.Diagnostic ( -- * ToDiagnostic ToDiagnostic (..), SomeDiagnostic (..), - DiagnosticInfo (..), ) where import Control.Exception (SomeException (SomeException)) import Data.Aeson (ToJSON, object, toJSON, (.=)) -import Data.Error (SourceLocation) import Data.String.Conversion (toText) import Data.Text (Text) - -data DiagnosticInfo = DiagnosticInfo - { header :: Maybe Text - , content :: Maybe Text - , documentation :: Maybe [Text] - , support :: Maybe Text - , help :: Maybe Text - , context :: Maybe Text - , sourceLocation :: Maybe SourceLocation - } - deriving (Eq, Ord, Show) +import Errata (Errata (..)) class ToDiagnostic a where - renderDiagnostic :: a -> DiagnosticInfo + renderDiagnostic :: a -> Errata instance ToDiagnostic Text where - renderDiagnostic t = DiagnosticInfo (Just t) Nothing Nothing Nothing Nothing Nothing Nothing + renderDiagnostic t = Errata (Just t) [] Nothing + +instance ToDiagnostic String where + renderDiagnostic s = Errata (Just $ toText s) [] Nothing instance ToDiagnostic SomeException where - renderDiagnostic (SomeException exc) = DiagnosticInfo (Just $ "An exception occurred:" <> toText (show exc)) Nothing Nothing Nothing Nothing Nothing Nothing + renderDiagnostic (SomeException exc) = Errata (Just $ "An exception occurred:" <> toText (show exc)) [] Nothing -- | A class of diagnostic types that can be rendered in a user-friendly way -- class ToDiagnostic a where diff --git a/src/Diag/Result.hs b/src/Diag/Result.hs index abc5221fee..4240baf654 100644 --- a/src/Diag/Result.hs +++ b/src/Diag/Result.hs @@ -35,10 +35,13 @@ module Diag.Result ( renderSuccess, ) where +import Data.Error (DiagnosticStyle (..), applyDiagnosticStyle, renderErrataStack) import Data.List.NonEmpty (NonEmpty) import Data.List.NonEmpty qualified as NE import Data.Text (Text) import Diag.Diagnostic (ToDiagnostic, renderDiagnostic) +import Errata (Errata) +import Errata.Types (Errata (..)) import GHC.Show (showLitString) import Prettyprinter import Prettyprinter.Render.Terminal @@ -186,29 +189,10 @@ resultToMaybe (Failure _ _) = Nothing renderFailure :: [EmittedWarn] -> ErrGroup -> Doc AnsiStyle -> Doc AnsiStyle renderFailure ws (ErrGroup _ ectx ehlp esup edoc es) headerDoc = header headerDoc <> renderedCtx <> renderedHelp <> renderedSupport <> renderedDoc <> renderedErrs <> renderedPossibleErrs where - renderedCtx :: Doc AnsiStyle - renderedCtx = - case ectx of - [] -> emptyDoc - _ -> section "Details" (vsep (map (\ctx -> renderErrCtx ctx <> line) ectx)) - - renderedHelp :: Doc AnsiStyle - renderedHelp = - case ehlp of - [] -> emptyDoc - _ -> section "Help" (vsep (map (\hlp -> renderErrHelp hlp <> line) ehlp)) - - renderedSupport :: Doc AnsiStyle - renderedSupport = - case esup of - [] -> emptyDoc - _ -> section "Support" (vsep (map (\s -> renderErrSupport s <> line) esup)) - - renderedDoc :: Doc AnsiStyle - renderedDoc = - case edoc of - [] -> emptyDoc - _ -> section "Documentation" (vsep (map (\d -> renderErrDoc d <> line) edoc)) + renderedCtx = renderErrCtxStack ectx + renderedHelp = renderErrHelpStack ehlp + renderedSupport = renderErrSupportStack esup + renderedDoc = renderErrDocStack edoc renderedErrs :: Doc AnsiStyle renderedErrs = @@ -248,21 +232,44 @@ renderSuccess ws headerDoc = ---------- Renering individual Result components: ErrCtx, EmittedWarn, SomeWarn, ErrWithStack -renderErrCtx :: ErrCtx -> Doc AnsiStyle -renderErrCtx (ErrCtx ctx) = renderDiagnostic ctx +renderErrCtxStack :: [ErrCtx] -> Doc AnsiStyle +renderErrCtxStack eCtxStack = case eCtxStack of + [] -> emptyDoc + _ -> pretty $ renderErrataStack (map ((applyDiagnosticStyle ContextStyle) . renderErrCtx) eCtxStack) + where + renderErrCtx :: ErrCtx -> Errata + renderErrCtx (ErrCtx c) = renderDiagnostic c -renderErrHelp :: ErrHelp -> Doc AnsiStyle -renderErrHelp (ErrHelp hlp) = renderDiagnostic hlp +renderErrHelpStack :: [ErrHelp] -> Doc AnsiStyle +renderErrHelpStack eHelpStack = case eHelpStack of + [] -> emptyDoc + _ -> pretty $ renderErrataStack (map ((applyDiagnosticStyle HelpStyle) . renderErrHelp) eHelpStack) + where + renderErrHelp :: ErrHelp -> Errata + renderErrHelp (ErrHelp h) = renderDiagnostic h -renderErrSupport :: ErrSupport -> Doc AnsiStyle -renderErrSupport (ErrSupport supp) = renderDiagnostic supp +renderErrSupportStack :: [ErrSupport] -> Doc AnsiStyle +renderErrSupportStack eSuppStack = case eSuppStack of + [] -> emptyDoc + _ -> pretty $ renderErrataStack (map ((applyDiagnosticStyle SupportStyle) . renderErrSupport) eSuppStack) + where + renderErrSupport :: ErrSupport -> Errata + renderErrSupport (ErrSupport s) = renderDiagnostic s -renderErrDoc :: ErrDoc -> Doc AnsiStyle -renderErrDoc (ErrDoc doc) = renderDiagnostic doc +renderErrDocStack :: [ErrDoc] -> Doc AnsiStyle +renderErrDocStack eDocStack = case eDocStack of + [] -> emptyDoc + _ -> pretty $ renderErrataStack ((map ((applyDiagnosticStyle DocumentationStyle) . renderErrDoc) eDocStack)) + where + renderErrDoc :: ErrDoc -> Errata + renderErrDoc (ErrDoc d) = renderDiagnostic d + +combineErrDetails :: [ErrDoc] -> [ErrSupport] -> [ErrHelp] -> [ErrCtx] -> Doc AnsiStyle +combineErrDetails edoc esupp ehelp ectx = renderErrDocStack edoc <> renderErrSupportStack esupp <> renderErrHelpStack ehelp <> renderErrCtxStack ectx renderErrWithStack :: ErrWithStack -> Doc AnsiStyle renderErrWithStack (ErrWithStack (Stack stack) (SomeErr err)) = - renderDiagnostic err + pretty (renderErrataStack [applyDiagnosticStyle ErrorStyle $ renderDiagnostic err]) <> line <> line <> annotate (color Cyan) "Traceback:" @@ -272,22 +279,17 @@ renderErrWithStack (ErrWithStack (Stack stack) (SomeErr err)) = _ -> indent 2 (vsep (map (pretty . ("- " <>)) stack)) renderEmittedWarn :: EmittedWarn -> Doc AnsiStyle -renderEmittedWarn (IgnoredErrGroup ectx ehlp esup edoc es) = renderedCtx <> renderedErrors +renderEmittedWarn (IgnoredErrGroup ectx ehlp esup edoc es) = errDetails <> renderedErrors where - renderedCtx = - case ectx of - [] -> emptyDoc - _ -> - (vsep (map (\ctx -> renderErrCtx ctx <> line) ectx)) - + errDetails = combineErrDetails edoc esup ehlp ectx renderedErrors = section "Relevant errors" $ subsection "Error" (map renderErrWithStack (NE.toList es)) -renderEmittedWarn (StandaloneWarn (SomeWarn warn)) = renderDiagnostic warn +renderEmittedWarn (StandaloneWarn warn) = pretty $ renderErrataStack [renderSomeWarn warn] renderEmittedWarn (WarnOnErrGroup ws ectx ehlp esup edoc es) = renderedWarnings <> renderedCtx <> renderedErrors where - renderedWarnings = vsep (map (\w -> renderSomeWarn w <> line) (NE.toList ws)) <> line + renderedWarnings = pretty $ renderErrataStack (map ((applyDiagnosticStyle WarningStyle) . renderSomeWarn) (NE.toList ws)) renderedCtx = case ectx of @@ -295,15 +297,15 @@ renderEmittedWarn (WarnOnErrGroup ws ectx ehlp esup edoc es) = renderedWarnings _ -> section "Details" - (vsep (map (\ctx -> renderErrCtx ctx <> line) ectx)) + $ combineErrDetails edoc esup ehlp ectx renderedErrors = section "Relevant errors" $ subsection "Error" (map renderErrWithStack (NE.toList es)) -renderSomeWarn :: SomeWarn -> Doc AnsiStyle -renderSomeWarn (SomeWarn w) = renderDiagnostic w +renderSomeWarn :: SomeWarn -> Errata +renderSomeWarn (SomeWarn w) = applyDiagnosticStyle WarningStyle $ renderDiagnostic w ---------- Rendering helpers diff --git a/src/Discovery/Archive.hs b/src/Discovery/Archive.hs index b747abd207..7305623ad2 100644 --- a/src/Discovery/Archive.hs +++ b/src/Discovery/Archive.hs @@ -33,7 +33,9 @@ import Data.List (isSuffixOf) import Data.String.Conversion (toText) import Discovery.Archive.RPM (extractRpm) import Discovery.Walk (WalkStep (WalkContinue), fileName, walk) +import Effect.Logger (renderIt) import Effect.ReadFS (ReadFS) +import Errata (Errata (..)) import Path ( Abs, Dir, @@ -57,12 +59,15 @@ unpackFailurePath :: ArchiveUnpackFailure -> Path Abs File unpackFailurePath (ArchiveUnpackFailure path _) = path instance ToDiagnostic ArchiveUnpackFailure where - renderDiagnostic (ArchiveUnpackFailure file exc) = - vsep - [ "An error occurred while attempting to unpack an archive." - , hsep ["Archive path:", pretty $ toText file] - , hsep ["Error text:", viaShow exc] - ] + renderDiagnostic (ArchiveUnpackFailure file exc) = do + let header = "An error occurred while attempting to unpack an archive" + body = + renderIt $ + vsep + [ hsep ["Archive path:", pretty $ toText file] + , hsep ["Error text:", viaShow exc] + ] + Errata (Just header) [] (Just body) -- | Converts a relative file path into a relative directory, where the passed in file path is suffixed by the archive suffix literal. -- In other words, this: diff --git a/src/Effect/Exec.hs b/src/Effect/Exec.hs index 187e818f83..68d18f08bd 100644 --- a/src/Effect/Exec.hs +++ b/src/Effect/Exec.hs @@ -68,6 +68,7 @@ import Data.Aeson ( ) import Data.Bifunctor (first) import Data.ByteString.Lazy qualified as BL +import Data.Error (createBody) import Data.Foldable (traverse_) import Data.List.NonEmpty (NonEmpty) import Data.List.NonEmpty qualified as NE @@ -78,8 +79,9 @@ import Data.Text (Text) import Data.Text qualified as Text import Data.Void (Void) import DepTypes (DepType (..)) -import Effect.Logger (Logger, logInfo) +import Effect.Logger (Logger, logInfo, renderIt) import Effect.ReadFS (ReadFS, getCurrentDir) +import Errata (Errata (..)) import GHC.Generics (Generic) import Path (Abs, Dir, Path, SomeBase (..), fromAbsDir, toFilePath) import Path.IO (AnyPath (makeAbsolute)) @@ -186,25 +188,28 @@ data ExecErr | ExecEnvNotSupported Text deriving (Eq, Ord, Show, Generic) -renderCmdFailure :: CmdFailure -> Doc AnsiStyle +renderCmdFailure :: CmdFailure -> Errata renderCmdFailure CmdFailure{..} = if isCmdNotAvailable - then - vsep - [ pretty $ "Could not find executable: `" <> cmdName cmdFailureCmd <> "`." - , pretty $ "Please ensure `" <> cmdName cmdFailureCmd <> "` exists in PATH prior to running fossa." - , "" - , reportDefectMsg - ] - else - vsep - [ "Command execution failed: " - , "" - , indent 4 details - , "" - , reportDefectMsg - ] + then do + let header = "Could not find executable: `" <> cmdName cmdFailureCmd + help = "Please ensure `" <> cmdName cmdFailureCmd <> "` exists in PATH prior to running fossa" + body = createBody Nothing Nothing (Just $ renderIt reportDefectMsg) (Just help) Nothing + Errata (Just header) [] (Just body) + else do + let header = "Command execution failed" + content = renderIt $ vsep [indent 2 details] + body = createBody (Just content) Nothing (Just $ renderIt reportDefectMsg) Nothing Nothing + Errata (Just header) [] (Just body) where + -- vsep + -- [ "Command execution failed: " + -- , "" + -- , indent 4 details + -- , "" + -- , reportDefectMsg + -- ] + -- Infer if the stderr is caused by not having executable in path. -- There is no easy way to check for @EBADF@ within process exception, -- with the library we use and effort required. @@ -283,16 +288,16 @@ renderCmdFailure CmdFailure{..} = instance ToDiagnostic ExecErr where renderDiagnostic = \case - ExecEnvNotSupported env -> pretty $ "Exec is not supported in: " <> env + ExecEnvNotSupported env -> do + let header = "Exec is not supported in: " <> env + Errata (Just header) [] Nothing CommandFailed err -> renderCmdFailure err - CommandParseError cmd err -> - vsep - [ "Failed to parse command output. command: " <> viaShow cmd <> "." - , "" - , indent 4 (pretty err) - , "" - , reportDefectMsg - ] + CommandParseError cmd err -> do + let header = "Failed to parse command output" + content = renderIt $ vsep [indent 2 (pretty err)] + ctx = "Command: " <> toText (show cmd) + body = createBody (Just content) Nothing (Just $ renderIt reportDefectMsg) Nothing (Just ctx) + Errata (Just header) [] (Just body) -- | Execute a command and return its @(exitcode, stdout, stderr)@ exec :: Has Exec sig m => Path Abs Dir -> Command -> m (Either CmdFailure Stdout) @@ -440,13 +445,10 @@ selectBestCmd workdir CandidateAnalysisCommands{..} = selectBestCmd' (NE.toList data CandidateCommandFailed = CandidateCommandFailed {failedCommand :: Text, failedArgs :: [Text]} instance ToDiagnostic CandidateCommandFailed where - renderDiagnostic CandidateCommandFailed{..} = - pretty $ - "Command " - <> show failedCommand - <> " not suitable: running with args " - <> show failedArgs - <> " resulted in a non-zero exit code" + renderDiagnostic CandidateCommandFailed{..} = do + let header = "Command: " <> failedCommand <> " not suitable" + body = "Running with args: " <> mconcat failedArgs <> " resulted in a non-zero exit code" + Errata (Just header) [] (Just body) argFromPath :: Path a b -> Text argFromPath = toText . toFilePath diff --git a/src/Effect/Grapher.hs b/src/Effect/Grapher.hs index 825995785b..336abea593 100644 --- a/src/Effect/Grapher.hs +++ b/src/Effect/Grapher.hs @@ -47,6 +47,7 @@ import Data.Set (Set) import Data.Set qualified as Set import Data.String.Conversion (toText) import Data.Text (Text) +import Errata (Errata (..)) import Graphing qualified as G import Prettyprinter (pretty) @@ -224,4 +225,6 @@ newtype MappingError deriving (Eq, Ord, Show) instance ToDiagnostic MappingError where - renderDiagnostic (MissingKey key) = "Missing associated value for key: " <> pretty key + renderDiagnostic (MissingKey key) = do + let header = "Missing associated value for key: " <> key + Errata (Just header) [] Nothing diff --git a/src/Effect/ReadFS.hs b/src/Effect/ReadFS.hs index 860951b899..a8567b1fde 100644 --- a/src/Effect/ReadFS.hs +++ b/src/Effect/ReadFS.hs @@ -61,7 +61,7 @@ module Effect.ReadFS ( module X, ) where -import App.Support (reportDefectWithFileMsg) +import App.Support (reportDefectWithFileMsg, supportUrl) import Control.Algebra as X import Control.Carrier.Simple ( Simple, @@ -73,6 +73,7 @@ import Control.Effect.Diagnostics ( Diagnostics, ToDiagnostic (..), context, + errSupport, fatal, fromEither, ) @@ -93,6 +94,8 @@ import Data.Text (Text) import Data.Text.Extra (showT) import Data.Void (Void) import Data.Yaml (decodeEither', prettyPrintParseException) +import Effect.Logger (renderIt) +import Errata (Errata (..)) import GHC.Generics (Generic) import Parse.XML (FromXML, parseXML, xmlErrorPretty) import Path ( @@ -176,37 +179,55 @@ deriving instance Ord (ReadFSF a) instance ToDiagnostic ReadFSErr where renderDiagnostic = \case - FileReadError path err -> "Error reading file " <> pretty path <> ":" <> line <> indent 4 (pretty err) - FileParseError path err -> - vsep - [ "Error parsing file: " <> pretty path <> "." - , "" - , indent 4 (pretty err) - , "" - , reportDefectWithFileMsg path - ] - ResolveError base rel err -> - "Error resolving a relative file:" - <> line - <> indent - 4 - ( vsep - [ "base: " <> pretty base - , "relative: " <> pretty rel - , "error: " <> pretty err - ] - ) - ListDirError dir err -> "Error listing directory contents at " <> pretty dir <> ":" <> line <> indent 2 (pretty err) - NotDirOrFile path -> "Path was not a dir or file, unknown type: " <> pretty path - UndeterminableFileType path -> - vsep - [ "Path is both a file and a directory, which should be impossible: " <> pretty path - , "Please report this as a bug, and include the following info if possible:" - , "- Operating system" - , "- File system" - , "- Output of 'fossa --version'" - ] - CurrentDirError err -> "Error resolving the current directory: " <> pretty err + FileReadError path err -> do + let header = "reading file: " <> toText path + body = renderIt $ vsep [indent 2 (pretty err)] + Errata (Just header) [] (Just body) + FileParseError path err -> do + let header = "parsing file: " <> toText path + body = renderIt $ vsep [indent 2 (pretty err)] + Errata (Just header) [] (Just body) + ResolveError base rel err -> do + let header = "resolving a relative file" + body = + renderIt $ + indent + 2 + ( vsep + [ "base: " <> pretty base + , "relative: " <> pretty rel + , "error: " <> pretty err + ] + ) + Errata (Just header) [] (Just body) + ListDirError dir err -> do + let header = "listing directory contents at: " <> toText dir + body = renderIt $ vsep [indent 2 (pretty err)] + Errata (Just header) [] (Just body) + NotDirOrFile path -> do + let header = "Path was not a dir or file, unknown type: " <> toText path + Errata (Just header) [] Nothing + UndeterminableFileType path -> do + let header = "Path is both a file and a directory, which should be impossible: " <> toText path + body = + renderIt $ + vsep + [ "Please report this as a bug to " <> pretty supportUrl <> ", and include the following info if possible:" + , indent 2 $ + vsep + [ "- Operating system" + , "- File system" + , "- Output of 'fossa --version'" + ] + ] + Errata (Just header) [] (Just body) + CurrentDirError err -> do + let header = "resolving the current directory " + body = renderIt $ vsep [indent 2 (pretty err)] + Errata (Just header) [] (Just body) + +fileParseErrorSupportMsg :: Path Abs File -> Text +fileParseErrorSupportMsg file = "If you believe this to be a defect, please report a bug to FOSSA support at " <> supportUrl <> ", with a copy of: " <> toText file -- | Read file contents into a strict 'ByteString' readContentsBS' :: Has ReadFS sig m => Path Abs File -> m (Either ReadFSErr ByteString) @@ -325,7 +346,7 @@ readContentsParser :: forall a sig m. (Has ReadFS sig m, Has Diagnostics sig m) readContentsParser parser file = context ("Parsing file '" <> toText (toString file) <> "'") $ do contents <- readContentsText file case runParser parser (toString file) contents of - Left err -> fatal $ FileParseError (toString file) (toText (errorBundlePretty err)) + Left err -> errSupport (fileParseErrorSupportMsg file) $ fatal $ FileParseError (toString file) (toText (errorBundlePretty err)) Right a -> pure a -- | Read from a file as a byte string, parsing its contents @@ -333,7 +354,7 @@ readContentsParserBS :: forall a sig m. (Has ReadFS sig m, Has Diagnostics sig m readContentsParserBS parser file = context ("Parsing file '" <> toText (toString file) <> "'") $ do contents <- readContentsBS file case runParser parser (toString file) contents of - Left err -> fatal $ FileParseError (toString file) (toText (errorBundlePretty err)) + Left err -> errSupport (fileParseErrorSupportMsg file) $ fatal $ FileParseError (toString file) (toText (errorBundlePretty err)) Right a -> pure a -- | Read JSON from a file @@ -341,14 +362,14 @@ readContentsJson :: (FromJSON a, Has ReadFS sig m, Has Diagnostics sig m) => Pat readContentsJson file = context ("Parsing JSON file '" <> toText (toString file) <> "'") $ do contents <- readContentsBS file case eitherDecodeStrict contents of - Left err -> fatal $ FileParseError (toString file) (toText err) + Left err -> errSupport (fileParseErrorSupportMsg file) $ fatal $ FileParseError (toString file) (toText err) Right a -> pure a readContentsToml :: (Has ReadFS sig m, Has Diagnostics sig m) => Toml.TomlCodec a -> Path Abs File -> m a readContentsToml codec file = context ("Parsing TOML file '" <> toText (toString file) <> "'") $ do contents <- readContentsText file case Toml.decode codec contents of - Left err -> fatal $ FileParseError (toString file) (Toml.prettyTomlDecodeErrors err) + Left err -> errSupport (fileParseErrorSupportMsg file) $ fatal $ FileParseError (toString file) (Toml.prettyTomlDecodeErrors err) Right a -> pure a -- | Read YAML from a file @@ -356,7 +377,7 @@ readContentsYaml :: (FromJSON a, Has ReadFS sig m, Has Diagnostics sig m) => Pat readContentsYaml file = context ("Parsing YAML file '" <> toText (toString file) <> "'") $ do contents <- readContentsBS file case decodeEither' contents of - Left err -> fatal $ FileParseError (toString file) (toText $ prettyPrintParseException err) + Left err -> errSupport (fileParseErrorSupportMsg file) $ fatal $ FileParseError (toString file) (toText $ prettyPrintParseException err) Right a -> pure a -- | Read XML from a file @@ -364,7 +385,7 @@ readContentsXML :: (FromXML a, Has ReadFS sig m, Has Diagnostics sig m) => Path readContentsXML file = context ("Parsing XML file '" <> toText (toString file) <> "'") $ do contents <- readContentsText file case parseXML contents of - Left err -> fatal $ FileParseError (toString file) (xmlErrorPretty err) + Left err -> errSupport (fileParseErrorSupportMsg file) $ fatal $ FileParseError (toString file) (xmlErrorPretty err) Right a -> pure a type ReadFSIOC = SimpleC ReadFSF diff --git a/src/Strategy/AlpineLinux/Parser.hs b/src/Strategy/AlpineLinux/Parser.hs index f511624fd8..14f4a314ac 100644 --- a/src/Strategy/AlpineLinux/Parser.hs +++ b/src/Strategy/AlpineLinux/Parser.hs @@ -50,8 +50,8 @@ import Data.String.Conversion (toText) import Data.Text (Text) import Data.Text qualified as Text import Data.Void (Void) -import Diag.Diagnostic (DiagnosticInfo (..)) import Effect.Logger (pretty) +import Errata (Errata (..)) import Strategy.AlpineLinux.Types (AlpinePackage (..)) import Text.Megaparsec ( MonadParsec (eof, takeWhileP), @@ -76,13 +76,13 @@ data PackageError instance ToDiagnostic PackageError where renderDiagnostic MissingPackageName = do let header = "Could not identify alpine package name" - DiagnosticInfo (Just header) Nothing Nothing Nothing Nothing Nothing Nothing + Errata (Just header) [] Nothing renderDiagnostic (MissingPackageArchitecture name) = do let header = "Could not identify architecture associated with " <> name - DiagnosticInfo (Just header) Nothing Nothing Nothing Nothing Nothing Nothing + Errata (Just header) [] Nothing renderDiagnostic (MissingPackageVersion name) = do let header = "Could not identify version associated with " <> name - DiagnosticInfo (Just header) Nothing Nothing Nothing Nothing Nothing Nothing + Errata (Just header) [] Nothing type Parser = Parsec Void Text diff --git a/src/Strategy/Bundler.hs b/src/Strategy/Bundler.hs index 74c66312be..77fd73f2ec 100644 --- a/src/Strategy/Bundler.hs +++ b/src/Strategy/Bundler.hs @@ -15,6 +15,8 @@ import Control.Effect.Diagnostics ( Diagnostics, context, errCtx, + errDoc, + errHelp, warnOnErr, (<||>), ) @@ -39,6 +41,8 @@ import Path (Abs, Dir, File, Path, toFilePath) import Strategy.Ruby.BundleShow qualified as BundleShow import Strategy.Ruby.Errors ( BundlerMissingLockFile (..), + bundlerLockFileRationaleUrl, + rubyFossaDocUrl, ) import Strategy.Ruby.GemfileLock qualified as GemfileLock import Strategy.Ruby.Parse (Assignment (Assignment, label, value), gemspecLicenseValuesP, readAssignments) @@ -132,7 +136,10 @@ analyzeGemfileLock :: (Has ReadFS sig m, Has Diagnostics sig m) => BundlerProjec analyzeGemfileLock project = warnOnErr AllDirectDeps . warnOnErr MissingEdges - . errCtx (BundlerMissingLockFile $ bundlerGemfile project) + . errCtx (BundlerMissingLockFileCtx $ bundlerGemfile project) + . errHelp BundlerMissingLockFileHelp + . errDoc bundlerLockFileRationaleUrl + . errDoc rubyFossaDocUrl $ do lockFile <- context "Retrieve Gemfile.lock" (Diag.fromMaybeText "No Gemfile.lock present in the project" (bundlerGemfileLock project)) graph <- context "Gemfile.lock analysis" . GemfileLock.analyze' $ lockFile diff --git a/src/Strategy/Cargo.hs b/src/Strategy/Cargo.hs index f44272b43a..e88a6713b1 100644 --- a/src/Strategy/Cargo.hs +++ b/src/Strategy/Cargo.hs @@ -65,10 +65,10 @@ import Effect.Grapher ( withLabeling, ) import Effect.ReadFS (ReadFS, readContentsToml) +import Errata (Errata (..)) import GHC.Generics (Generic) import Graphing (Graphing, stripRoot) import Path (Abs, Dir, File, Path, parent, parseRelFile, toFilePath, ()) -import Prettyprinter (Pretty (pretty)) import Toml (TomlCodec, dioptional, diwrap, (.=)) import Toml qualified import Types ( @@ -331,11 +331,15 @@ analyze (CargoProject manifestDir manifestFile) = do newtype FailedToGenLockFile = FailedToGenLockFile (Path Abs File) instance ToDiagnostic FailedToGenLockFile where - renderDiagnostic (FailedToGenLockFile path) = pretty $ "Could not generate lock file for cargo manifest: " <> (show path) + renderDiagnostic (FailedToGenLockFile path) = do + let header = "Could not generate lock file for cargo manifest: " <> toText path + Errata (Just header) [] Nothing newtype FailedToRetrieveCargoMetadata = FailedToRetrieveCargoMetadata (Path Abs File) instance ToDiagnostic FailedToRetrieveCargoMetadata where - renderDiagnostic (FailedToRetrieveCargoMetadata path) = pretty $ "Could not retrieve machine readable cargo metadata for: " <> (show path) + renderDiagnostic (FailedToRetrieveCargoMetadata path) = do + let header = "Could not retrieve machine readable cargo metadata for: " <> toText path + Errata (Just header) [] Nothing toDependency :: PackageId -> Set CargoLabel -> Dependency toDependency pkg = diff --git a/src/Strategy/Carthage.hs b/src/Strategy/Carthage.hs index ef42a660e9..662e742ef0 100644 --- a/src/Strategy/Carthage.hs +++ b/src/Strategy/Carthage.hs @@ -18,6 +18,7 @@ import Control.Effect.Diagnostics ( ToDiagnostic (..), context, errCtx, + errHelp, recover, warnOnErr, ) @@ -37,7 +38,6 @@ import DepTypes ( Dependency (..), VerConstraint (CEq), ) -import Diag.Diagnostic qualified as DI import Discovery.Filters (AllFilters) import Discovery.Simple (simpleDiscover) import Discovery.Walk ( @@ -47,6 +47,7 @@ import Discovery.Walk ( ) import Effect.Grapher (Grapher, direct, edge, evalGrapher) import Effect.ReadFS (ReadFS, readContentsParser) +import Errata (Errata (..)) import GHC.Generics (Generic) import Graphing qualified as G import Path ( @@ -60,7 +61,6 @@ import Path ( parseRelDir, (), ) -import Prettyprinter (pretty, viaShow, vsep) import Text.Megaparsec ( MonadParsec (eof), Parsec, @@ -178,7 +178,8 @@ analyze topPath = evalGrapher $ do deeper <- recover . warnOnErr (MissingCarthageDeepDep entry) - . errCtx (MissingResolvedFile $ checkoutPath $(mkRelFile "Cartfile.resolved")) + . errCtx (MissingResolvedFileCtx $ checkoutPath $(mkRelFile "Cartfile.resolved")) + . errHelp MissingResolvedFileHelp $ analyzeSingle (checkoutPath $(mkRelFile "Cartfile.resolved")) traverse_ (traverse_ (edge entry)) deeper @@ -186,14 +187,18 @@ newtype MissingCarthageDeepDep = MissingCarthageDeepDep ResolvedEntry instance ToDiagnostic MissingCarthageDeepDep where renderDiagnostic (MissingCarthageDeepDep entry) = do let header = "Failed to find transitive dependencies for: " <> (resolvedName entry) - DI.DiagnosticInfo (Just header) Nothing Nothing Nothing Nothing Nothing Nothing + Errata (Just header) [] Nothing -newtype MissingResolvedFile = MissingResolvedFile (Path Abs File) +data MissingResolvedFile + = MissingResolvedFileCtx (Path Abs File) + | MissingResolvedFileHelp instance ToDiagnostic MissingResolvedFile where - renderDiagnostic (MissingResolvedFile path) = do - let ctx = "Could not find or parse resolved file in: " <> toText (show path) - help = "Ensure your carthage project is built prior to running fossa" - DI.DiagnosticInfo Nothing Nothing Nothing Nothing (Just help) (Just ctx) Nothing + renderDiagnostic (MissingResolvedFileCtx path) = do + let header = "Could not find or parse resolved file in: " <> toText (show path) + Errata (Just header) [] Nothing + renderDiagnostic MissingResolvedFileHelp = do + let header = "Ensure your carthage project is built prior to running fossa" + Errata (Just header) [] Nothing entryToCheckoutName :: ResolvedEntry -> Text entryToCheckoutName entry = diff --git a/src/Strategy/Cocoapods.hs b/src/Strategy/Cocoapods.hs index 5cde587b28..9fd3d905ae 100644 --- a/src/Strategy/Cocoapods.hs +++ b/src/Strategy/Cocoapods.hs @@ -9,7 +9,8 @@ module Strategy.Cocoapods ( import App.Fossa.Analyze.LicenseAnalyze (LicenseAnalyzeProject, licenseAnalyzeProject) import App.Fossa.Analyze.Types (AnalyzeProject, analyzeProject, analyzeProject') import Control.Applicative ((<|>)) -import Control.Effect.Diagnostics (Diagnostics, context, errCtx, warnOnErr, (<||>)) +import Control.Carrier.Diagnostics (errHelp) +import Control.Effect.Diagnostics (Diagnostics, context, errCtx, errDoc, warnOnErr, (<||>)) import Control.Effect.Diagnostics qualified as Diag import Control.Effect.Reader (Reader) import Data.Aeson (ToJSON) @@ -31,7 +32,7 @@ import Effect.Logger (Logger) import Effect.ReadFS (Has, ReadFS, readContentsParser) import GHC.Generics (Generic) import Path (Abs, Dir, File, Path, toFilePath) -import Strategy.Cocoapods.Errors (MissingPodLockFile (MissingPodLockFile)) +import Strategy.Cocoapods.Errors (MissingPodLockFile (..), refPodDocUrl) import Strategy.Cocoapods.Podfile qualified as Podfile import Strategy.Cocoapods.PodfileLock qualified as PodfileLock import Strategy.Ruby.Parse (Assignment (label, value), PodSpecAssignmentValue (PodspecDict, PodspecStr), Symbol (Symbol), findBySymbol, podspecAssignmentValuesP, readAssignments) @@ -116,7 +117,9 @@ getDeps project = "Podfile.lock analysis" ( warnOnErr MissingEdges . warnOnErr MissingDeepDeps - . errCtx MissingPodLockFile + . errCtx MissingPodLockFileCtx + . errHelp MissingPodLockFileHelp + . errDoc refPodDocUrl $ (analyzePodfileLock project) ) <||> context "Podfile analysis" (analyzePodfile project) @@ -128,7 +131,9 @@ getDeps' project = "Podfile.lock analysis" ( warnOnErr MissingEdges . warnOnErr MissingDeepDeps - . errCtx MissingPodLockFile + . errCtx MissingPodLockFileCtx + . errHelp MissingPodLockFileHelp + . errDoc refPodDocUrl $ (analyzePodfileLockStatically project) ) <||> context "Podfile analysis" (analyzePodfile project) diff --git a/src/Strategy/Cocoapods/Errors.hs b/src/Strategy/Cocoapods/Errors.hs index 60b650a9c2..904e86b54c 100644 --- a/src/Strategy/Cocoapods/Errors.hs +++ b/src/Strategy/Cocoapods/Errors.hs @@ -6,20 +6,19 @@ module Strategy.Cocoapods.Errors ( import App.Docs (platformDocUrl) import Data.Text (Text) import Diag.Diagnostic (ToDiagnostic (..)) -import Prettyprinter (Pretty (pretty), indent, vsep) +import Errata (Errata (..)) refPodDocUrl :: Text refPodDocUrl = platformDocUrl "ios/cocoapods.md" -data MissingPodLockFile = MissingPodLockFile +data MissingPodLockFile + = MissingPodLockFileCtx + | MissingPodLockFileHelp instance ToDiagnostic MissingPodLockFile where - renderDiagnostic (MissingPodLockFile) = - vsep - [ "We could not perform analysis using Podfile.lock." - , "" - , "Ensure a valid Podfile.lock file exists prior to using fossa-cli." - , "" - , "Refer to:" - , indent 2 $ pretty $ "- " <> refPodDocUrl - ] + renderDiagnostic MissingPodLockFileCtx = do + let header = "Could not perform analysis using Podfile.lock" + Errata (Just header) [] Nothing + renderDiagnostic MissingPodLockFileHelp = do + let header = "Ensure a valid Podfile.lock file exists prior to using fossa-cli" + Errata (Just header) [] Nothing diff --git a/src/Strategy/Conan/ConanGraph.hs b/src/Strategy/Conan/ConanGraph.hs index fab6b7886d..783cc27f2d 100644 --- a/src/Strategy/Conan/ConanGraph.hs +++ b/src/Strategy/Conan/ConanGraph.hs @@ -10,7 +10,7 @@ module Strategy.Conan.ConanGraph ( toDependency, ) where -import Control.Effect.Diagnostics (Diagnostics, errCtx, run) +import Control.Effect.Diagnostics (Diagnostics, errCtx, errHelp, run) import Data.Aeson ( FromJSON (parseJSON), Key, @@ -39,7 +39,7 @@ import DepTypes ( Dependency (..), VerConstraint (CEq), ) -import Diag.Diagnostic (DiagnosticInfo (..), ToDiagnostic (renderDiagnostic)) +import Diag.Diagnostic (ToDiagnostic (renderDiagnostic)) import Effect.Exec ( AllowErr (Never), Command (..), @@ -48,6 +48,7 @@ import Effect.Exec ( execJson, ) import Effect.Grapher (Grapher, deep, direct, edge, evalGrapher) +import Errata (Errata (..)) import Graphing (Graphing) import Network.HTTP.Types (renderQueryText) import Path (Abs, Dir, Path) @@ -302,14 +303,18 @@ analyzeFromConanGraph dir = do -- would ensure source code is always retrieved. Also, the -- equivalent command of "conan info ." in conan v1 -- does not provide used settings for the dependency. - errCtx ConanV2IsRequired $ guardConanVersion2Gt dir + errCtx ConanV2IsRequiredCtx $ errHelp ConanV2IsRequiredHelp $ guardConanVersion2Gt dir conanGraph <- execJson dir $ conanV2GraphCmd [] pure $ buildGraph conanGraph -data ConanV2IsRequired = ConanV2IsRequired +data ConanV2IsRequired + = ConanV2IsRequiredCtx + | ConanV2IsRequiredHelp instance ToDiagnostic ConanV2IsRequired where - renderDiagnostic (ConanV2IsRequired) = do - let ctx = "Conan analysis requires conan v2.0.0 or greater" - help = "Ensure you are using conan v2 by running, conan --version" - DiagnosticInfo Nothing Nothing Nothing Nothing (Just help) (Just ctx) Nothing + renderDiagnostic ConanV2IsRequiredCtx = do + let header = "Conan analysis requires conan v2.0.0 or greater" + Errata (Just header) [] Nothing + renderDiagnostic ConanV2IsRequiredHelp = do + let header = "Ensure you are using conan v2 by running, conan --version" + Errata (Just header) [] Nothing diff --git a/src/Strategy/Conan/Enrich.hs b/src/Strategy/Conan/Enrich.hs index baeb1af842..dfee31232c 100644 --- a/src/Strategy/Conan/Enrich.hs +++ b/src/Strategy/Conan/Enrich.hs @@ -11,12 +11,12 @@ import App.Fossa.VendoredDependency (VendoredDependency (..), VendoredDependency import App.Types (FullFileUploads (..)) import Control.Algebra (Has) import Control.Carrier.Lift (Lift) -import Control.Effect.Diagnostics (Diagnostics, ToDiagnostic, fatal) +import Control.Effect.Diagnostics (Diagnostics, ToDiagnostic, errHelp, errSupport, fatal) import Control.Effect.FossaApiClient (FossaApiClient) import Control.Effect.StickyLogger (StickyLogger) import Control.Monad (unless) import Data.Either (partitionEithers) -import Data.Error (SourceLocation, getSourceLocation) +import Data.Error (SourceLocation, createBlock, getSourceLocation) import Data.List (find) import Data.List.NonEmpty (NonEmpty, nonEmpty, toList) import Data.List.NonEmpty qualified as NE @@ -27,10 +27,11 @@ import Data.String.Conversion (toText) import Data.Text (Text, intercalate) import Data.Text.Extra (splitOnceOn) import DepTypes (DepType (ArchiveType, ConanType), Dependency (..), VerConstraint (CEq)) -import Diag.Diagnostic (DiagnosticInfo (..), ToDiagnostic (renderDiagnostic)) +import Diag.Diagnostic (ToDiagnostic (renderDiagnostic)) import Effect.Exec (Exec) import Effect.Logger (Logger, indent, pretty, renderIt, vsep) import Effect.ReadFS (ReadFS) +import Errata (errataSimple) import Graphing (Graphing, gmap, vertexList) import Path (Abs, Dir, Path) import Srclib.Converter (fetcherToDepType, toLocator, verConstraintToRevision) @@ -63,7 +64,7 @@ conanToArchives rootPath fullfileUploads g = -- need to do any work! case (null unableToTransformConanDep, transformedVendorDep) of (True, Nothing) -> pure g - (False, _) -> fatal $ FailedToTransformConanDependency getSourceLocation unableToTransformConanDep + (False, _) -> errHelp ("Ensure location is provided for conan dependency" :: Text) $ fatal $ FailedToTransformConanDependency getSourceLocation unableToTransformConanDep (True, Just depsAndVendorDeps) -> do let vendorDeps = NE.map snd depsAndVendorDeps @@ -88,14 +89,15 @@ conanToArchives rootPath fullfileUploads g = toList archiveLocators unless (null failed) $ - fatal $ - FailedToTransformLocators getSourceLocation failed + errSupport enrichSupportMessage $ + fatal $ + FailedToTransformLocators getSourceLocation failed -- 3. We replace all conan dependencies with archive dependencies from -- original graph. If we are unable to find twin of archive dep -- (e.g. sourcing conan dep), we fail fatally! case fromList <$> archiveToConanDep archiveDeps of - Left lonelyArchiveDeps -> fatal $ UnableToFindTwinOfArchiveDep getSourceLocation lonelyArchiveDeps + Left lonelyArchiveDeps -> errSupport enrichSupportMessage $ fatal $ UnableToFindTwinOfArchiveDep getSourceLocation lonelyArchiveDeps Right registry -> pure $ gmap (\graphDep -> Map.findWithDefault graphDep graphDep registry) g where allDeps :: [Dependency] @@ -199,16 +201,19 @@ findArchiveTwin archiveDeps conanDep = case find unOrg :: Text -> Text unOrg t = snd $ splitOnceOn "/" t +enrichSupportMessage :: Text +enrichSupportMessage = "This is likely a defect, please contact FOSSA support at: https://support.fossa.com/" + data FailedToTransformConanDependency = FailedToTransformConanDependency SourceLocation [Dependency] instance ToDiagnostic FailedToTransformConanDependency where renderDiagnostic (FailedToTransformConanDependency srcLoc deps) = do let header = "Could not transform analyzed conan dependency to vendored dependency" - content = + body = renderIt $ vsep [indent 2 $ vsep $ map (pretty . renderDep) deps] - help = "Ensure location is provided for conan dependency" - DiagnosticInfo (Just header) (Just content) Nothing Nothing (Just help) Nothing (Just srcLoc) + block = createBlock srcLoc Nothing Nothing + errataSimple (Just header) block (Just body) where renderDep :: Dependency -> Text renderDep d = @@ -220,22 +225,22 @@ data FailedToTransformLocators = FailedToTransformLocators SourceLocation [Locat instance ToDiagnostic FailedToTransformLocators where renderDiagnostic (FailedToTransformLocators srcLoc locs) = do let header = "Could not transform vendored dependency to archive dependency" - content = + body = renderIt $ vsep [vsep $ map (pretty . toText) locs] - support = "This is likely a defect, please contact FOSSA support at: https://support.fossa.com/" - DiagnosticInfo (Just header) (Just content) Nothing (Just support) Nothing Nothing (Just srcLoc) + block = createBlock srcLoc Nothing Nothing + errataSimple (Just header) block (Just body) data UnableToFindTwinOfArchiveDep = UnableToFindTwinOfArchiveDep SourceLocation LonelyDeps instance ToDiagnostic UnableToFindTwinOfArchiveDep where renderDiagnostic (UnableToFindTwinOfArchiveDep srcLoc (LonelyDeps deps)) = do let header = "Could not identify conan dependency" - content = + body = renderIt $ vsep [ "We could not identify conan dependency for following dependencies:" , indent 2 $ vsep $ map (pretty . toText . toLocator) deps ] - support = "This is likely a defect, please contact FOSSA support at: https://support.fossa.com/" - DiagnosticInfo (Just header) (Just content) Nothing (Just support) Nothing Nothing (Just srcLoc) + block = createBlock srcLoc Nothing Nothing + errataSimple (Just header) block (Just body) diff --git a/src/Strategy/Dart/Errors.hs b/src/Strategy/Dart/Errors.hs index 2e01718734..85813d085a 100644 --- a/src/Strategy/Dart/Errors.hs +++ b/src/Strategy/Dart/Errors.hs @@ -6,20 +6,19 @@ module Strategy.Dart.Errors ( import App.Docs (strategyLangDocUrl) import Data.Text (Text) import Diag.Diagnostic (ToDiagnostic (..)) -import Prettyprinter (Pretty (pretty), indent, vsep) +import Errata (Errata (..)) refPubDocUrl :: Text refPubDocUrl = strategyLangDocUrl "dart/dart.md" -data PubspecLimitation = PubspecLimitation +data PubspecLimitation + = PubspecLimitationCtx + | PubspecLimitationHelp instance ToDiagnostic PubspecLimitation where - renderDiagnostic (PubspecLimitation) = - vsep - [ "Could not perform analysis using lockfile." - , "" - , "Build your project and ensure pubspec.lock file exists and is readable prior to using fossa-cli." - , "" - , "Refer to:" - , indent 2 $ pretty $ "- " <> refPubDocUrl - ] + renderDiagnostic PubspecLimitationCtx = do + let header = "Could not perform analysis using lockfile" + Errata (Just header) [] Nothing + renderDiagnostic PubspecLimitationHelp = do + let header = "Build your project and ensure pubspec.lock file exists and is readable prior to using fossa-cli" + Errata (Just header) [] Nothing diff --git a/src/Strategy/Go/GoListPackages.hs b/src/Strategy/Go/GoListPackages.hs index 36e1c7a48c..979433e861 100644 --- a/src/Strategy/Go/GoListPackages.hs +++ b/src/Strategy/Go/GoListPackages.hs @@ -23,6 +23,7 @@ import Control.Monad (unless, void, when, (>=>)) import Data.Aeson (FromJSON (parseJSON), Value, withObject, (.!=), (.:), (.:?)) import Data.Aeson.Encode.Pretty (encodePretty) import Data.Aeson.Types (formatError) +import Data.Error (SourceLocation, createBlock, getSourceLocation) import Data.Foldable (traverse_) import Data.HashMap.Strict qualified as HashMap import Data.HashSet qualified as HashSet @@ -44,6 +45,7 @@ import DepTypes ( ) import Effect.Exec (AllowErr (Never), Command (Command, cmdAllowErr, cmdArgs, cmdName), Exec, ExecErr (CommandParseError), execThrow, renderCommand) import Effect.Grapher (Grapher, LabeledGrapherC, Labels, deep, direct, edge, label, runLabeledGrapher) +import Errata (Errata (..), errataSimple) import GHC.Generics (Generic) import Graphing qualified import Path (Abs, Dir, Path) @@ -68,12 +70,14 @@ newtype GoListPackageError = GoListPackageError Value deriving (Eq, Ord, Show, FromJSON) instance ToDiagnostic GoListPackageError where - renderDiagnostic (GoListPackageError v) = - pretty @Text $ - "'go list -json -deps all' reported a package error: \n" - <> (decodeUtf8 . encodePretty $ v) - <> "\nThis may affect analysis results for this package, but often FOSSA can still analyze it." - <> "\nVerify the analysis results for the affected package on fossa.com." + renderDiagnostic (GoListPackageError v) = do + let header = "'go list -json -deps all' reported a package error" + body = + "package error: \n" + <> (decodeUtf8 . encodePretty $ v) + <> "\nThis may affect analysis results for this package, but often FOSSA can still analyze it." + <> "\nVerify the analysis results for the affected package on fossa.com." + Errata (Just header) [] (Just body) data GoPackage = GoPackage { importPath :: ImportPath @@ -183,7 +187,7 @@ buildGraph goModDir rawPackages = do where (mainPackages, stdLibImportPaths, pkgsNoStdLibImports) = foldl' go ([], HashSet.empty, HashMap.empty) rawPackages - getMainPackages = if null mainPackages then fatal (MissingMainModuleErr goModDir) else pure mainPackages + getMainPackages = if null mainPackages then fatal (MissingMainModuleErr getSourceLocation goModDir) else pure mainPackages go :: ([GoPackage], HashSet.HashSet ImportPath, HashMap.HashMap ImportPath GoPackage) -> GoPackage -> ([GoPackage], HashSet.HashSet ImportPath, HashMap.HashMap ImportPath GoPackage) go (maybeMains, stdLibPaths, otherPackages) gPkg@GoPackage{standard, importPath, moduleInfo} @@ -229,13 +233,13 @@ buildGraph goModDir rawPackages = do maybeEdge d = maybe (pure ()) (edge d) lookupPackage :: Has Diagnostics sig m => ImportPath -> m GoPackage - lookupPackage impPath = Diagnostics.fromMaybe (MissingModuleErr impPath) $ HashMap.lookup impPath pkgsNoStdLibImports + lookupPackage impPath = Diagnostics.fromMaybe (MissingModuleErr getSourceLocation impPath) $ HashMap.lookup impPath pkgsNoStdLibImports getModuleInfo :: Has Diagnostics sig m => GoPackage -> m GoModule getModuleInfo pkg@GoPackage{importPath} = case getFinalModuleInfo pkg of Just m -> pure m - Nothing -> fatal $ MissingModuleErr importPath + Nothing -> fatal $ MissingModuleErr getSourceLocation importPath -- \|Convert a graph of 'GoPackage's with associated labels to a graph of 'Dependency's. pkgGraphToDepGraph :: Has Diagnostics sig m => Graphing.Graphing GoPackage -> Labels GoPackage DepEnvironment -> m (Graphing.Graphing Dependency) @@ -258,17 +262,23 @@ buildGraph goModDir rawPackages = do Graphing.gtraverse pkgToDep graph' -newtype MissingModuleErr = MissingModuleErr ImportPath +data MissingModuleErr = MissingModuleErr SourceLocation ImportPath deriving (Eq, Show) instance ToDiagnostic MissingModuleErr where - renderDiagnostic (MissingModuleErr (ImportPath i)) = pretty $ "Could not find module for " <> i + renderDiagnostic (MissingModuleErr srcLoc (ImportPath i)) = do + let header = "Could not find module for: " <> i + block = createBlock srcLoc Nothing Nothing + errataSimple (Just header) block Nothing -newtype MissingMainModuleErr = MissingMainModuleErr (Path Abs Dir) +data MissingMainModuleErr = MissingMainModuleErr SourceLocation (Path Abs Dir) deriving (Eq, Show) instance ToDiagnostic MissingMainModuleErr where - renderDiagnostic (MissingMainModuleErr path) = pretty @Text $ "No main module for project " <> toText path + renderDiagnostic (MissingMainModuleErr srcLoc path) = do + let header = "No main module for project: " <> toText path + block = createBlock srcLoc Nothing Nothing + errataSimple (Just header) block Nothing -- | A module is a path dep if its import path starts with './' or '../'. -- Checking for ./ or ../ is the documented way of detecting path deps. diff --git a/src/Strategy/Go/Transitive.hs b/src/Strategy/Go/Transitive.hs index 11ccf26e42..8301b8f804 100644 --- a/src/Strategy/Go/Transitive.hs +++ b/src/Strategy/Go/Transitive.hs @@ -50,6 +50,7 @@ import Effect.Exec ( renderCommand, ) import Effect.Grapher (edge, label) +import Errata (Errata (..)) import Path (Abs, Dir, Path) import Prettyprinter (pretty) import Strategy.Go.Types ( @@ -173,11 +174,9 @@ fillInTransitive dir = context "Getting deep dependencies" $ do data GoListCmdFailed = GoListCmdFailed instance ToDiagnostic GoListCmdFailed where - renderDiagnostic _ = - pretty $ - "We could not perform `" - <> renderCommand goListCmd - <> "` successfully to infer deep dependencies." + renderDiagnostic _ = do + let header = "We could not perform `" <> renderCommand goListCmd <> "` successfully to infer deep dependencies." + Errata (Just header) [] Nothing -- HACK(fossas/team-analysis#514) `go list -json all` emits golang dependencies -- at the _package_ level; e.g., `github.com/example/foo/some/package`. The diff --git a/src/Strategy/Googlesource/RepoManifest.hs b/src/Strategy/Googlesource/RepoManifest.hs index d057528826..93d39de120 100644 --- a/src/Strategy/Googlesource/RepoManifest.hs +++ b/src/Strategy/Googlesource/RepoManifest.hs @@ -53,6 +53,7 @@ import Effect.ReadFS ( readContentsText, readContentsXML, ) +import Errata (Errata (..)) import GHC.Generics (Generic) import Graphing (Graphing, unfold) import Parse.XML (FromXML (..), attr, child, children) @@ -336,6 +337,12 @@ data ManifestGitConfigError instance ToDiagnostic ManifestGitConfigError where renderDiagnostic = \case - InvalidRemote remote -> "An invalid remote was encountered when parsing manifest files: " <> pretty remote - GitConfigParse err -> "An error occurred when parsing a git config: " <> pretty err - MissingGitConfig path -> "A git config was missing: " <> pretty path + InvalidRemote remote -> do + let header = "An invalid remote was encountered when parsing manifest files: " <> remote + Errata (Just header) [] Nothing + GitConfigParse err -> do + let header = "An error occurred when parsing a git config: " <> err + Errata (Just header) [] Nothing + MissingGitConfig path -> do + let header = "A git config was missing: " <> path + Errata (Just header) [] Nothing diff --git a/src/Strategy/Gradle.hs b/src/Strategy/Gradle.hs index 204c06bbf1..2411c9a980 100644 --- a/src/Strategy/Gradle.hs +++ b/src/Strategy/Gradle.hs @@ -20,11 +20,14 @@ module Strategy.Gradle ( import App.Fossa.Analyze.Types (AnalyzeProject (analyzeProject'), analyzeProject) import App.Fossa.Config.Analyze (ExperimentalAnalyzeConfig (allowedGradleConfigs)) +import App.Support (reportDefectWithDebugBundle) import Control.Algebra (Has) import Control.Effect.Diagnostics ( Diagnostics, context, errCtx, + errHelp, + errSupport, fatalText, recover, warnOnErr, @@ -54,7 +57,7 @@ import Discovery.Filters (AllFilters) import Discovery.Simple (simpleDiscover) import Discovery.Walk (WalkStep (..), fileName, findFileInAncestor, walkWithFilters') import Effect.Exec (AllowErr (..), Command (..), Exec, execThrow) -import Effect.Logger (Logger, Pretty (pretty), logDebug) +import Effect.Logger (Logger, Pretty (pretty), logDebug, renderIt) import Effect.ReadFS (ReadFS) import GHC.Generics (Generic) import Graphing (Graphing) @@ -63,7 +66,7 @@ import Strategy.Gradle.Common ( ConfigName (..), getDebugMessages, ) -import Strategy.Gradle.Errors (FailedToListProjects (FailedToListProjects), FailedToRunGradleAnalysis (FailedToRunGradleAnalysis), GradleWrapperFailed (GradleWrapperFailed)) +import Strategy.Gradle.Errors (FailedGradleHelp (FailedGradleHelp), FailedToListProjects (FailedToListProjects), FailedToRunGradleAnalysis (FailedToRunGradleAnalysis), GradleWrapperFailed (GradleWrapperFailed)) import Strategy.Gradle.ResolutionApi qualified as ResolutionApi import System.FilePath qualified as FilePath import Types (BuildTarget (..), DependencyResults (..), DiscoveredProject (..), DiscoveredProjectType (GradleProjectType), FoundTargets (..), GraphBreadth (..)) @@ -134,6 +137,7 @@ findProjects = walkWithFilters' $ \dir _ files -> do projectsStdout <- recover . warnOnErr (FailedToListProjects dir) + . errHelp FailedGradleHelp . context ("Listing gradle projects at '" <> toText dir <> "'") $ runGradle dir gradleProjectsCmd @@ -270,7 +274,7 @@ analyze foundTargets dir = withSystemTempDir "fossa-gradle" $ \tmpDir -> do FoundTargets targets -> gradleJsonDepsCmdTargets initScriptFilepath (toSet targets) ProjectWithoutTargets -> gradleJsonDepsCmd initScriptFilepath - stdout <- context "running gradle script" $ errCtx FailedToRunGradleAnalysis $ runGradle dir cmd + stdout <- context "running gradle script" $ errCtx FailedToRunGradleAnalysis $ errHelp FailedGradleHelp $ errSupport (renderIt reportDefectWithDebugBundle) $ runGradle dir cmd onlyConfigurations <- do configs <- asks allowedGradleConfigs diff --git a/src/Strategy/Gradle/Errors.hs b/src/Strategy/Gradle/Errors.hs index 3d0d656885..63ac1ce26f 100644 --- a/src/Strategy/Gradle/Errors.hs +++ b/src/Strategy/Gradle/Errors.hs @@ -2,49 +2,41 @@ module Strategy.Gradle.Errors ( FailedToListProjects (..), GradleWrapperFailed (..), FailedToRunGradleAnalysis (..), + FailedGradleHelp (..), refGradleDocUrl, ) where import App.Docs (strategyLangDocUrl) -import App.Support (reportDefectWithDebugBundle) + +import Data.String.Conversion (toText) import Data.Text (Text) import Diag.Diagnostic (ToDiagnostic (renderDiagnostic)) -import Effect.Logger (viaShow) +import Errata (Errata (..)) import Path (Abs, Dir, Path) -import Prettyprinter (indent, vsep) refGradleDocUrl :: Text refGradleDocUrl = strategyLangDocUrl "gradle/gradle.md" newtype FailedToListProjects = FailedToListProjects (Path Abs Dir) deriving (Eq, Ord, Show) instance ToDiagnostic FailedToListProjects where - renderDiagnostic (FailedToListProjects dir) = - vsep - [ "Found a gradle build manifest in " <> viaShow dir <> " but, could not list projects." - , "" - , "Ensure you can run one of:" - , "" - , indent 2 "gradlew projects" - , indent 2 "gradlew.bat projects" - , indent 2 "gradle projects" - ] + renderDiagnostic (FailedToListProjects dir) = do + let header = "Found a gradle build manifest in " <> toText dir <> " but, could not list projects" + Errata (Just header) [] Nothing + +data FailedGradleHelp = FailedGradleHelp +instance ToDiagnostic FailedGradleHelp where + renderDiagnostic FailedGradleHelp = do + let header = "Ensure you can run of the following: `gradlew projects`, `gradlew.bat projects`, `gradle projects`" + Errata (Just header) [] Nothing data FailedToRunGradleAnalysis = FailedToRunGradleAnalysis deriving (Eq, Ord, Show) instance ToDiagnostic FailedToRunGradleAnalysis where - renderDiagnostic (FailedToRunGradleAnalysis) = - vsep - [ "Failed to perform gradle analysis." - , "" - , "Ensure your gradle project can be built successfully:" - , "" - , indent 2 "gradlew build" - , indent 2 "gradlew.bat build" - , indent 2 "gradle build" - , "" - , reportDefectWithDebugBundle - ] + renderDiagnostic (FailedToRunGradleAnalysis) = do + let header = "Failed to perform gradle analysis." + Errata (Just header) [] Nothing data GradleWrapperFailed = GradleWrapperFailed deriving (Eq, Ord, Show) instance ToDiagnostic GradleWrapperFailed where - renderDiagnostic (GradleWrapperFailed) = - "Failed to use gradle wrapper, analysis may be inaccurate if gradle executable version differs from expected gradle version." + renderDiagnostic (GradleWrapperFailed) = do + let header = "Failed to use gradle wrapper, analysis may be inaccurate if gradle executable version differs from expected gradle version." + Errata (Just header) [] Nothing diff --git a/src/Strategy/Haskell/Cabal.hs b/src/Strategy/Haskell/Cabal.hs index d7f7ced897..9694e6097a 100644 --- a/src/Strategy/Haskell/Cabal.hs +++ b/src/Strategy/Haskell/Cabal.hs @@ -64,6 +64,7 @@ import Effect.Grapher ( withMapping, ) import Effect.ReadFS (ReadFS, readContentsJson) +import Errata (Errata (..)) import GHC.Generics (Generic) import Graphing (Graphing) import Graphing qualified as G @@ -248,4 +249,6 @@ analyze project = do data FailedToGenCabalPlan = FailedToGenCabalPlan instance ToDiagnostic FailedToGenCabalPlan where - renderDiagnostic _ = "We could not dry run cabal build for dependency analysis." + renderDiagnostic _ = do + let header = "Could not dry run cabal build for dependency analysis" + Errata (Just header) [] Nothing diff --git a/src/Strategy/Leiningen.hs b/src/Strategy/Leiningen.hs index 2b77fa5f43..b27defa256 100644 --- a/src/Strategy/Leiningen.hs +++ b/src/Strategy/Leiningen.hs @@ -46,7 +46,6 @@ import Data.Text (Text) import Data.Text qualified as Text import Data.Text.Lazy qualified as TL import Data.Vector qualified as V -import Diag.Diagnostic qualified as DI import Discovery.Filters (AllFilters) import Discovery.Simple (simpleDiscover) import Discovery.Walk ( @@ -70,6 +69,7 @@ import Effect.Grapher ( withLabeling, ) import Effect.ReadFS (ReadFS) +import Errata (Errata (..)) import GHC.Generics (Generic) import Graphing (Graphing) import Path (Abs, Dir, File, Path, parent) @@ -166,8 +166,8 @@ analyze file = do data FailedToRetrieveLeinDependencies = FailedToRetrieveLeinDependencies instance ToDiagnostic FailedToRetrieveLeinDependencies where renderDiagnostic _ = do - let ctx = "Could not successfully retrieve dependencies information using lein deps subcommand" - DI.DiagnosticInfo Nothing Nothing Nothing Nothing Nothing (Just ctx) Nothing + let header = "Could not successfully retrieve dependencies information using lein deps subcommand" + Errata (Just header) [] Nothing -- node type for our LabeledGrapher data ClojureNode = ClojureNode diff --git a/src/Strategy/Maven/PluginStrategy.hs b/src/Strategy/Maven/PluginStrategy.hs index 4e73c14d7f..d146bdeb96 100644 --- a/src/Strategy/Maven/PluginStrategy.hs +++ b/src/Strategy/Maven/PluginStrategy.hs @@ -28,11 +28,11 @@ import DepTypes ( Dependency (..), VerConstraint (CEq), ) -import Diag.Diagnostic qualified as DI import Effect.Exec (CandidateCommandEffs) import Effect.Grapher (Grapher, edge, evalGrapher) import Effect.Grapher qualified as Grapher import Effect.ReadFS (ReadFS) +import Errata (Errata (..)) import Graphing (Graphing) import Path (Abs, Dir, Path) import Strategy.Maven.Common (MavenDependency (..)) @@ -109,20 +109,20 @@ analyze dir plugin = do data MvnPluginInstallFailed = MvnPluginInstallFailed instance ToDiagnostic MvnPluginInstallFailed where renderDiagnostic (MvnPluginInstallFailed) = do - let ctx = "Failed to install maven plugin for analysis" - DI.DiagnosticInfo Nothing Nothing Nothing Nothing Nothing (Just ctx) Nothing + let header = "Failed to install maven plugin for analysis" + Errata (Just header) [] Nothing data MvnPluginExecFailed = MvnPluginExecFailed instance ToDiagnostic MvnPluginExecFailed where renderDiagnostic (MvnPluginExecFailed) = do - let ctx = "Failed to execute maven plugin for analysis" - DI.DiagnosticInfo Nothing Nothing Nothing Nothing Nothing (Just ctx) Nothing + let header = "Failed to execute maven plugin for analysis" + Errata (Just header) [] Nothing data MayIncludeSubmodule = MayIncludeSubmodule instance ToDiagnostic MayIncludeSubmodule where renderDiagnostic MayIncludeSubmodule = do let header = "Failed to run reactor, submodules may be included in the output graph." - DI.DiagnosticInfo (Just header) Nothing Nothing Nothing Nothing Nothing Nothing + Errata (Just header) [] Nothing -- | The graphs returned by the depgraph plugin look like this: -- diff --git a/src/Strategy/Nim/NimbleLock.hs b/src/Strategy/Nim/NimbleLock.hs index bfcb8f9ecd..a9b8ae143a 100644 --- a/src/Strategy/Nim/NimbleLock.hs +++ b/src/Strategy/Nim/NimbleLock.hs @@ -48,6 +48,7 @@ import DepTypes ( import Diag.Diagnostic qualified as DI import Effect.Exec (AllowErr (Always), Command (..), Exec, execJson) import Effect.ReadFS (Has, ReadFS, readContentsJson) +import Errata (Errata (..)) import GHC.Generics (Generic) import Graphing ( Graphing, @@ -216,10 +217,10 @@ data MissingEdgesBetweenDirectDeps = MissingEdgesBetweenDirectDeps instance ToDiagnostic MissingEdgesBetweenDirectDeps where renderDiagnostic _ = do let header = "Could not infer edges between direct dependencies" - DI.DiagnosticInfo (Just header) Nothing Nothing Nothing Nothing Nothing Nothing + Errata (Just header) [] Nothing data CmdNimbleDumpFailed = CmdNimbleDumpFailed instance ToDiagnostic CmdNimbleDumpFailed where renderDiagnostic _ = do - let ctx = "Could not retrieve nimble packages metadata using nimble's dump subcommand." - DI.DiagnosticInfo Nothing Nothing Nothing Nothing Nothing (Just ctx) Nothing + let header = "Could not retrieve nimble packages metadata using nimble's dump subcommand." + Errata (Just header) [] Nothing diff --git a/src/Strategy/Node.hs b/src/Strategy/Node.hs index 1845f56b7e..0af1c65f97 100644 --- a/src/Strategy/Node.hs +++ b/src/Strategy/Node.hs @@ -13,11 +13,13 @@ import Algebra.Graph.AdjacencyMap qualified as AM import Algebra.Graph.AdjacencyMap.Extra qualified as AME import App.Fossa.Analyze.LicenseAnalyze (LicenseAnalyzeProject, licenseAnalyzeProject) import App.Fossa.Analyze.Types (AnalyzeProject (analyzeProject, analyzeProject')) +import Control.Carrier.Diagnostics (errDoc) import Control.Effect.Diagnostics ( Diagnostics, Has, context, errCtx, + errHelp, fatalText, fromEitherShow, fromMaybe, @@ -70,7 +72,7 @@ import Path ( toFilePath, (), ) -import Strategy.Node.Errors (CyclicPackageJson (CyclicPackageJson), MissingNodeLockFile (MissingNodeLockFile)) +import Strategy.Node.Errors (CyclicPackageJson (CyclicPackageJson), MissingNodeLockFile (..), fossaNodeDocUrl, npmLockFileDocUrl, yarnLockfileDocUrl, yarnV2LockfileDocUrl) import Strategy.Node.Npm.PackageLock qualified as PackageLock import Strategy.Node.Npm.PackageLockV3 qualified as PackageLockV3 import Strategy.Node.PackageJson ( @@ -190,7 +192,12 @@ analyzeNpm wsGraph = do . recover . warnOnErr MissingEdges . warnOnErr MissingDeepDeps - . errCtx (MissingNodeLockFile) + . errCtx MissingNodeLockFileCtx + . errHelp MissingNodeLockFileHelp + . errDoc fossaNodeDocUrl + . errDoc npmLockFileDocUrl + . errDoc yarnLockfileDocUrl + . errDoc yarnV2LockfileDocUrl $ fatalText "Lock files - yarn.lock or package-lock.json were not discovered." graph <- PackageJson.analyze $ Map.elems $ jsonLookup wsGraph diff --git a/src/Strategy/Node/Errors.hs b/src/Strategy/Node/Errors.hs index f2c9bb2ee6..d920ecabe7 100644 --- a/src/Strategy/Node/Errors.hs +++ b/src/Strategy/Node/Errors.hs @@ -10,7 +10,9 @@ module Strategy.Node.Errors ( import App.Docs (strategyLangDocUrl) import Data.Text (Text) import Diag.Diagnostic (ToDiagnostic, renderDiagnostic) -import Prettyprinter (Pretty (pretty), indent, vsep) +import Effect.Logger (renderIt) +import Errata (Errata (..)) +import Prettyprinter (indent, vsep) yarnLockfileDocUrl :: Text yarnLockfileDocUrl = "https://classic.yarnpkg.com/lang/en/docs/yarn-lock/" @@ -26,27 +28,23 @@ fossaNodeDocUrl = strategyLangDocUrl "nodejs/nodejs.md" data CyclicPackageJson = CyclicPackageJson instance ToDiagnostic CyclicPackageJson where - renderDiagnostic (CyclicPackageJson) = "We detected cyclic references between package.json files in the workspace." + renderDiagnostic (CyclicPackageJson) = do + let header = "Detected cyclic references between package.json files in the workspace" + Errata (Just header) [] Nothing -data MissingNodeLockFile = MissingNodeLockFile +data MissingNodeLockFile + = MissingNodeLockFileCtx + | MissingNodeLockFileHelp instance ToDiagnostic MissingNodeLockFile where - renderDiagnostic (MissingNodeLockFile) = - vsep - [ "We could not perform lockfile analysis for your nodejs project." - , "" - , indent 2 $ - vsep - [ "Ensure valid lockfile exist and is readable prior to running fossa." - , indent 2 "For yarn package manager, you can perform: `yarn install` to install dependencies and generate lockfile." - , indent 2 "For node package manager, you can perform: `npm install` to install dependencies and generate lockfile." - ] - , "" - , "Refer to:" - , indent 2 $ - vsep - [ pretty $ "- " <> fossaNodeDocUrl - , pretty $ "- " <> npmLockFileDocUrl - , pretty $ "- " <> yarnLockfileDocUrl - , pretty $ "- " <> yarnV2LockfileDocUrl - ] - ] + renderDiagnostic MissingNodeLockFileCtx = do + let header = "Could not perform lockfile analysis for your nodejs project" + Errata (Just header) [] Nothing + renderDiagnostic MissingNodeLockFileHelp = do + let header = + renderIt $ + vsep + [ "Ensure valid lockfile exist and is readable prior to running fossa." + , indent 2 "For yarn package manager, you can perform: `yarn install` to install dependencies and generate lockfile." + , indent 2 "For node package manager, you can perform: `npm install` to install dependencies and generate lockfile." + ] + Errata (Just header) [] Nothing diff --git a/src/Strategy/Node/YarnV1/YarnLock.hs b/src/Strategy/Node/YarnV1/YarnLock.hs index cdacb3a948..909d961c20 100644 --- a/src/Strategy/Node/YarnV1/YarnLock.hs +++ b/src/Strategy/Node/YarnV1/YarnLock.hs @@ -6,7 +6,7 @@ module Strategy.Node.YarnV1.YarnLock ( mangleParseErr, ) where -import Control.Effect.Diagnostics (Diagnostics, Has, context, tagError, warn) +import Control.Effect.Diagnostics (Diagnostics, Has, ToDiagnostic, context, renderDiagnostic, tagError, warn) import Control.Monad (when) import Data.Foldable (for_, traverse_) import Data.List.NonEmpty qualified as NE @@ -33,13 +33,8 @@ import Effect.Grapher ( label, withLabeling, ) -import Effect.Logger ( - AnsiStyle, - Doc, - hsep, - pretty, - ) import Effect.ReadFS (ReadFS, ReadFSErr (FileParseError), readContentsText) +import Errata (Errata (..)) import Graphing (Graphing) import Path (Abs, File, Path) import Strategy.Node.PackageJson (Development, FlatDeps (..), NodePackage (..), Production) @@ -153,19 +148,16 @@ logMaybePackage key something = do -- partially succeed anyway, so we just log a warning for now. -- If a valid case is discovered, it's likely a bug elsewhere (perhaps -- in the 'yarn-lock' package), and should be fixed. - Nothing -> warn $ missingResolvedVersionErrorMsg key + Nothing -> warn $ MissingResolvedVersion key _ -> pure () pure something -missingResolvedVersionErrorMsg :: YL.PackageKey -> Doc AnsiStyle -missingResolvedVersionErrorMsg key = - hsep - [ "Yarn graph error: could not resolve" - , pretty $ extractFullName key - , "in the yarn lockfile." - , "It may not be present in the list of dependencies," - , "or it may have an unresolved or incorrect version." - ] +newtype MissingResolvedVersion = MissingResolvedVersion YL.PackageKey +instance ToDiagnostic MissingResolvedVersion where + renderDiagnostic (MissingResolvedVersion key) = do + let header = "Yarn graph error: could not resolve " <> extractFullName key <> " in the yarn lockfile." + body = "It may not be present in the list of dependencies, or it may have an unresolved or incorrect version." + Errata (Just header) [] (Just body) pairToPackage :: YL.PackageKey -> YL.Package -> YarnV1Package pairToPackage key pkg = YarnV1Package (extractFullName key) (YL.version pkg) diff --git a/src/Strategy/Pub.hs b/src/Strategy/Pub.hs index 204767f8d7..2cb009d68b 100644 --- a/src/Strategy/Pub.hs +++ b/src/Strategy/Pub.hs @@ -2,6 +2,7 @@ module Strategy.Pub (discover) where import App.Fossa.Analyze.Types (AnalyzeProject (analyzeProject'), analyzeProject) +import Control.Carrier.Diagnostics (errDoc, errHelp) import Control.Effect.Diagnostics (Diagnostics, errCtx, fatalText, recover, warnOnErr, (<||>)) import Control.Effect.Reader (Reader) import Control.Monad (void) @@ -18,7 +19,7 @@ import Effect.Logger (Logger) import Effect.ReadFS (ReadFS) import GHC.Generics (Generic) import Path (Abs, Dir, File, Path) -import Strategy.Dart.Errors (PubspecLimitation (..)) +import Strategy.Dart.Errors (PubspecLimitation (..), refPubDocUrl) import Strategy.Dart.PubDeps (analyzeDepsCmd) import Strategy.Dart.PubSpec (analyzePubSpecFile) import Strategy.Dart.PubSpecLock (analyzePubLockFile) @@ -71,7 +72,9 @@ getDeps project = do void . recover $ warnOnErr MissingDeepDeps . warnOnErr MissingEdges - $ errCtx PubspecLimitation (fatalText "Missing pubspec.lock file") + $ errCtx PubspecLimitationCtx + $ errHelp PubspecLimitationHelp + $ errDoc refPubDocUrl (fatalText "Missing pubspec.lock file") analyzePubSpecFile $ pubSpec project pure $ DependencyResults @@ -88,7 +91,9 @@ getDeps' project = do void . recover $ warnOnErr MissingDeepDeps . warnOnErr MissingEdges - $ errCtx PubspecLimitation (fatalText "Missing pubspec.lock file") + $ errCtx PubspecLimitationCtx + $ errHelp PubspecLimitationHelp + $ errDoc refPubDocUrl (fatalText "Missing pubspec.lock file") analyzePubSpecFile $ pubSpec project pure $ DependencyResults diff --git a/src/Strategy/Python/Errors.hs b/src/Strategy/Python/Errors.hs index 9cd7a976fc..2d681cf0db 100644 --- a/src/Strategy/Python/Errors.hs +++ b/src/Strategy/Python/Errors.hs @@ -6,38 +6,34 @@ module Strategy.Python.Errors ( commitPoetryLockToVCS, ) where +import Data.String.Conversion (toText) import Data.Text (Text) import Diag.Diagnostic (ToDiagnostic, renderDiagnostic) import Effect.Exec (Command, renderCommand) +import Errata (Errata (..)) import Path (Abs, File, Path) -import Prettyprinter (Pretty (pretty), indent, viaShow, vsep) commitPoetryLockToVCS :: Text commitPoetryLockToVCS = "https://python-poetry.org/docs/basic-usage/#commit-your-poetrylock-file-to-version-control" -newtype PipenvCmdFailed = PipenvCmdFailed Command +data PipenvCmdFailed + = PipenvCmdFailedCtx Command + | PipenvCmdFailedHelp instance ToDiagnostic PipenvCmdFailed where - renderDiagnostic (PipenvCmdFailed cmd) = - vsep - [ pretty $ "We could not perform pipenv graph analysis using, command:" <> renderCommand cmd - , "" - , indent 2 $ - vsep - [ "Ensure pipenv executable is in your PATH." - ] - ] + renderDiagnostic (PipenvCmdFailedCtx cmd) = do + let header = "We could not perform pipenv graph analysis using, command:" <> renderCommand cmd + Errata (Just header) [] Nothing + renderDiagnostic PipenvCmdFailedHelp = do + let header = "Ensure pipenv executable is in your PATH" + Errata (Just header) [] Nothing -newtype MissingPoetryLockFile = MissingPoetryLockFile (Path Abs File) +data MissingPoetryLockFile + = MissingPoetryLockFileCtx (Path Abs File) + | MissingPoetryLockFileHelp instance ToDiagnostic MissingPoetryLockFile where - renderDiagnostic (MissingPoetryLockFile path) = - vsep - [ "We could not perform poetry.lock analysis for: " <> viaShow path - , "" - , indent 2 $ - vsep - [ "Ensure valid poetry.lock exists and is readable." - ] - , "" - , "Refer to:" - , indent 2 $ pretty $ "- " <> commitPoetryLockToVCS - ] + renderDiagnostic (MissingPoetryLockFileCtx path) = do + let header = "We could not perform poetry.lock analysis for: " <> toText path + Errata (Just header) [] Nothing + renderDiagnostic MissingPoetryLockFileHelp = do + let header = "Ensure valid poetry.lock exists and is readable." + Errata (Just header) [] Nothing diff --git a/src/Strategy/Python/Pip.hs b/src/Strategy/Python/Pip.hs index c7bf8a543f..db4965f605 100644 --- a/src/Strategy/Python/Pip.hs +++ b/src/Strategy/Python/Pip.hs @@ -12,7 +12,7 @@ import Data.String.Conversion (toText) import Data.Text (Text) import Data.Text qualified as Text import Data.Void (Void) -import Diag.Diagnostic (DiagnosticInfo (..), ToDiagnostic (..)) +import Diag.Diagnostic (ToDiagnostic (..)) import Effect.Exec ( AllowErr (Never), Command (..), @@ -22,6 +22,7 @@ import Effect.Exec ( execParser, ) import Effect.Logger (vsep) +import Errata (Errata (..)) import GHC.Generics (Generic) import Path (Abs, Dir, Path) import Text.Megaparsec @@ -50,7 +51,7 @@ data PipListCommandFailed = PipListCommandFailed instance ToDiagnostic PipListCommandFailed where renderDiagnostic PipListCommandFailed = do let header = "Failed to run pip command" - DiagnosticInfo (Just header) Nothing Nothing Nothing Nothing Nothing Nothing + Errata (Just header) [] Nothing pythonPip :: [Text] -> Command pythonPip args = diff --git a/src/Strategy/Python/Pipenv.hs b/src/Strategy/Python/Pipenv.hs index 3bbe77a811..53d7a02f50 100644 --- a/src/Strategy/Python/Pipenv.hs +++ b/src/Strategy/Python/Pipenv.hs @@ -20,6 +20,7 @@ import Control.Effect.Diagnostics ( Has, context, errCtx, + errHelp, recover, run, warnOnErr, @@ -69,7 +70,7 @@ import Effect.ReadFS (ReadFS, readContentsJson) import GHC.Generics (Generic) import Graphing (Graphing) import Path (Abs, Dir, File, Path, parent) -import Strategy.Python.Errors (PipenvCmdFailed (PipenvCmdFailed)) +import Strategy.Python.Errors (PipenvCmdFailed (..)) import Types ( DependencyResults (..), DiscoveredProject (..), @@ -101,7 +102,8 @@ getDeps project = context "Pipenv" $ do $ recover . warnOnErr MissingDeepDeps . warnOnErr MissingEdges - . errCtx (PipenvCmdFailed pipenvGraphCmd) + . errCtx (PipenvCmdFailedCtx pipenvGraphCmd) + . errHelp PipenvCmdFailedHelp $ execJson (parent (pipenvLockfile project)) pipenvGraphCmd graph <- context "Building dependency graph" $ pure (buildGraph lock maybeDeps) diff --git a/src/Strategy/Python/Poetry.hs b/src/Strategy/Python/Poetry.hs index c3dc9f94bc..e138832052 100644 --- a/src/Strategy/Python/Poetry.hs +++ b/src/Strategy/Python/Poetry.hs @@ -10,7 +10,7 @@ module Strategy.Python.Poetry ( import App.Fossa.Analyze.Types (AnalyzeProject (analyzeProject'), analyzeProject) import Control.Algebra (Has) import Control.Applicative ((<|>)) -import Control.Effect.Diagnostics (Diagnostics, context, errCtx, fatalText, recover, warnOnErr) +import Control.Effect.Diagnostics (Diagnostics, context, errCtx, errDoc, errHelp, fatalText, recover, warnOnErr) import Control.Effect.Reader (Reader) import Control.Monad (void) import Data.Aeson (ToJSON) @@ -37,7 +37,8 @@ import Graphing (Graphing) import Graphing qualified import Path (Abs, Dir, File, Path) import Strategy.Python.Errors ( - MissingPoetryLockFile (MissingPoetryLockFile), + MissingPoetryLockFile (..), + commitPoetryLockToVCS, ) import Strategy.Python.Poetry.Common (getPoetryBuildBackend, logIgnoredDeps, pyProjectDeps, toCanonicalName, toMap) import Strategy.Python.Poetry.PoetryLock (PackageName (..), PoetryLock (..), PoetryLockPackage (..), poetryLockCodec) @@ -165,7 +166,9 @@ analyze PoetryProject{pyProjectToml, poetryLock} = do . recover . warnOnErr MissingDeepDeps . warnOnErr MissingEdges - . errCtx (MissingPoetryLockFile (pyProjectTomlPath pyProjectToml)) + . errCtx (MissingPoetryLockFileCtx (pyProjectTomlPath pyProjectToml)) + . errHelp MissingPoetryLockFileHelp + . errDoc commitPoetryLockToVCS $ fatalText "poetry.lock file was not discovered" graph <- context "Building dependency graph from only pyproject.toml" $ pure $ Graphing.fromList $ pyProjectDeps pyproject pure $ diff --git a/src/Strategy/Python/ReqTxt.hs b/src/Strategy/Python/ReqTxt.hs index 654768091b..c918235527 100644 --- a/src/Strategy/Python/ReqTxt.hs +++ b/src/Strategy/Python/ReqTxt.hs @@ -9,8 +9,8 @@ import Data.Foldable (asum) import Data.String.Conversion (toText) import Data.Text (Text) import Data.Void (Void) -import Diag.Diagnostic qualified as DI import Effect.ReadFS +import Errata (Errata (..)) import Graphing (Graphing) import Path import Strategy.Python.Pip (PythonPackage) @@ -21,15 +21,19 @@ import Types analyze' :: (Has ReadFS sig m, Has Diagnostics sig m) => Maybe [PythonPackage] -> Path Abs File -> m (Graphing Dependency) analyze' packages file = do - reqs <- errCtx (ReqsTxtFailed file) $ readContentsParser requirementsTxtParser file + reqs <- errCtx (ReqsTxtFailedCtx file) $ errHelp ReqsTxtFailedHelp $ readContentsParser requirementsTxtParser file context "Building dependency graph" $ pure (buildGraph packages reqs) -newtype ReqsTxtFailed = ReqsTxtFailed (Path Abs File) +data ReqsTxtFailed + = ReqsTxtFailedCtx (Path Abs File) + | ReqsTxtFailedHelp instance ToDiagnostic ReqsTxtFailed where - renderDiagnostic (ReqsTxtFailed path) = do - let ctx = "Failed to parse: " <> toText (show path) - let help = "Ignore this error if this file isn't a python requirements.txt file." - DI.DiagnosticInfo Nothing Nothing Nothing Nothing (Just help) (Just ctx) Nothing + renderDiagnostic (ReqsTxtFailedCtx path) = do + let header = "Failed to parse: " <> toText (show path) + Errata (Just header) [] Nothing + renderDiagnostic ReqsTxtFailedHelp = do + let header = "Ignore this error if this file isn't a python requirements.txt file." + Errata (Just header) [] Nothing type Parser = Parsec Void Text diff --git a/src/Strategy/R.hs b/src/Strategy/R.hs index b4392618af..ccae21d2b3 100644 --- a/src/Strategy/R.hs +++ b/src/Strategy/R.hs @@ -5,6 +5,7 @@ module Strategy.R ( ) where import App.Fossa.Analyze.Types (AnalyzeProject (analyzeProject, analyzeProject')) +import Control.Carrier.Diagnostics (errDoc, errHelp) import Control.Effect.Diagnostics (Diagnostics, errCtx, fatalText, recover, warnOnErr) import Control.Effect.Reader (Reader) import Control.Monad (void) @@ -27,6 +28,8 @@ import Strategy.R.Errors ( MissingDescriptionFile (..), MissingRenvLockFile (..), VersionConstraintsIgnored (..), + rEnvLockFileDocUrl, + rEnvLockFileGenerateDocUrl, ) import Strategy.R.Renv ( analyzeDescription, @@ -130,7 +133,10 @@ getDeps (DescriptionOnly _ (RDescriptionFile descriptionFile)) = do . warnOnErr MissingEdges . warnOnErr MissingDeepDeps . warnOnErr VersionConstraintsIgnored - . errCtx MissingRenvLockFile + . errCtx MissingRenvLockFileCtx + . errHelp MissingRenvLockFileHelp + . errDoc rEnvLockFileDocUrl + . errDoc rEnvLockFileGenerateDocUrl $ fatalText "renv.lock file is missing." (graph, graphBreadth) <- analyzeDescription descriptionFile diff --git a/src/Strategy/R/Errors.hs b/src/Strategy/R/Errors.hs index 1f2c930f3c..9e88076149 100644 --- a/src/Strategy/R/Errors.hs +++ b/src/Strategy/R/Errors.hs @@ -8,7 +8,7 @@ module Strategy.R.Errors ( import Data.Text (Text) import Diag.Diagnostic (ToDiagnostic, renderDiagnostic) -import Prettyprinter (Pretty (pretty), indent, vsep) +import Errata (Errata (..)) rEnvLockFileDocUrl :: Text rEnvLockFileDocUrl = "https://rstudio.github.io/renv/" @@ -18,35 +18,23 @@ rEnvLockFileGenerateDocUrl = "https://rstudio.github.io/renv/reference/snapshot. data MissingDescriptionFile = MissingDescriptionFile instance ToDiagnostic MissingDescriptionFile where - renderDiagnostic (MissingDescriptionFile) = - vsep - [ "Provide DESCRIPTION file in same path as `renv.lock`, so FOSSA CLI can infer direct dependencies." - ] + renderDiagnostic (MissingDescriptionFile) = do + let header = "Provide DESCRIPTION file in same path as `renv.lock`, so FOSSA CLI can infer direct dependencies." + Errata (Just header) [] Nothing data VersionConstraintsIgnored = VersionConstraintsIgnored instance ToDiagnostic VersionConstraintsIgnored where - renderDiagnostic (VersionConstraintsIgnored) = - vsep - [ "Version constraints (if specified) in the DESCRIPTION file will be ignored." - , "Please use renv to create renv.lock file, so package versions as pinned, can be analyzed." - ] + renderDiagnostic (VersionConstraintsIgnored) = do + let header = "Version constraints (if specified) in the DESCRIPTION file will be ignored. Please use renv to create renv.lock file, so package versions as pinned, can be analyzed." + Errata (Just header) [] Nothing -data MissingRenvLockFile = MissingRenvLockFile +data MissingRenvLockFile + = MissingRenvLockFileCtx + | MissingRenvLockFileHelp instance ToDiagnostic MissingRenvLockFile where - renderDiagnostic (MissingRenvLockFile) = - vsep - [ "We could not perform lockfile analysis for your r project." - , "" - , indent 2 $ - vsep - [ "Ensure valid lockfile exist and is readable prior to running fossa." - , "If you are using renv, you will likely need to run: renv::snapshot() to create renv.lock" - ] - , "" - , "Refer to:" - , indent 2 $ - vsep - [ pretty $ "- " <> rEnvLockFileDocUrl - , pretty $ "- " <> rEnvLockFileGenerateDocUrl - ] - ] + renderDiagnostic MissingRenvLockFileCtx = do + let header = "Could not perform lockfile analysis for your r project" + Errata (Just header) [] Nothing + renderDiagnostic MissingRenvLockFileHelp = do + let header = "Ensure valid lockfile exist and is readable prior to running fossa. If you are using renv, you will likely need to run: renv::snapshot() to create renv.lock" + Errata (Just header) [] Nothing diff --git a/src/Strategy/Ruby/Errors.hs b/src/Strategy/Ruby/Errors.hs index b9d22d9eb6..c4584474c0 100644 --- a/src/Strategy/Ruby/Errors.hs +++ b/src/Strategy/Ruby/Errors.hs @@ -9,7 +9,8 @@ module Strategy.Ruby.Errors ( import App.Docs (strategyLangDocUrl) import Data.String.Conversion (toText) import Data.Text (Text) -import Diag.Diagnostic (DiagnosticInfo (..), ToDiagnostic, renderDiagnostic) +import Diag.Diagnostic (ToDiagnostic, renderDiagnostic) +import Errata (Errata (..)) import Path bundlerLockFileRationaleUrl :: Text @@ -18,10 +19,14 @@ bundlerLockFileRationaleUrl = "https://bundler.io/rationale.html#sharing-your-ap rubyFossaDocUrl :: Text rubyFossaDocUrl = strategyLangDocUrl "ruby/ruby.md" -newtype BundlerMissingLockFile = BundlerMissingLockFile (Path Abs File) +data BundlerMissingLockFile + = BundlerMissingLockFileCtx (Path Abs File) + | BundlerMissingLockFileHelp + instance ToDiagnostic BundlerMissingLockFile where - renderDiagnostic (BundlerMissingLockFile path) = do - let ctx = "We could not perform Gemfile.lock analysis for Gemfile: " <> toText (show path) - help = "Ensure valid Gemfile.lock exists, and is readable by user. If you are using bundler, run `bundler install` to generate Gemfile.lock." - documentationReferences = [rubyFossaDocUrl, bundlerLockFileRationaleUrl] - DiagnosticInfo Nothing Nothing (Just documentationReferences) Nothing (Just help) (Just ctx) Nothing + renderDiagnostic (BundlerMissingLockFileCtx path) = do + let header = "We could not perform Gemfile.lock analysis for Gemfile: " <> toText (show path) + Errata (Just header) [] Nothing + renderDiagnostic BundlerMissingLockFileHelp = do + let header = "Ensure valid Gemfile.lock exists, and is readable by user. If you are using bundler, run `bundler install` to generate Gemfile.lock." + Errata (Just header) [] Nothing diff --git a/src/Strategy/Scala.hs b/src/Strategy/Scala.hs index 5365247ebc..04aab4dc9a 100644 --- a/src/Strategy/Scala.hs +++ b/src/Strategy/Scala.hs @@ -13,15 +13,8 @@ module Strategy.Scala ( ) where import App.Fossa.Analyze.Types (AnalyzeProject (analyzeProject'), analyzeProject) -import Control.Effect.Diagnostics ( - Diagnostics, - errCtx, - fatalText, - fromMaybeText, - recover, - warnOnErr, - (<||>), - ) +import Control.Carrier.Diagnostics (errDoc) +import Control.Effect.Diagnostics (Diagnostics, errCtx, errHelp, fatalText, fromMaybeText, recover, warnOnErr, (<||>)) import Control.Effect.Reader (Reader) import Control.Effect.Stack (context) import Data.Aeson (KeyValue ((.=)), ToJSON (toJSON), object) @@ -64,7 +57,7 @@ import Strategy.Maven.Pom.Closure (MavenProjectClosure, buildProjectClosures, cl import Strategy.Maven.Pom.PomFile (RawPom (rawPomArtifact, rawPomGroup, rawPomVersion)) import Strategy.Maven.Pom.Resolver (buildGlobalClosure) import Strategy.Scala.Common (mkSbtCommand) -import Strategy.Scala.Errors (FailedToListProjects (FailedToListProjects), MaybeWithoutDependencyTreeTask (MaybeWithoutDependencyTreeTask), MissingFullDependencyPlugin (MissingFullDependencyPlugin)) +import Strategy.Scala.Errors (FailedToListProjects (FailedToListProjects), MaybeWithoutDependencyTreeTask (..), MissingFullDependencyPlugin (..), sbtDepsGraphPluginUrl, scalaFossaDocUrl) import Strategy.Scala.Plugin (genTreeJson, hasDependencyPlugins) import Strategy.Scala.SbtDependencyTree (SbtArtifact (SbtArtifact), analyze, sbtDepTreeCmd) import Strategy.Scala.SbtDependencyTreeJson qualified as TreeJson @@ -176,8 +169,11 @@ findProjects = walkWithFilters' $ \dir _ files -> do depTreeStdOut <- recover $ context ("inferring dependencies") $ - errCtx (MaybeWithoutDependencyTreeTask) $ - execThrow dir sbtDepTreeCmd + errCtx MaybeWithoutDependencyTreeTaskCtx $ + errHelp MaybeWithoutDependencyTreeTaskHelp $ + errDoc sbtDepsGraphPluginUrl $ + errDoc scalaFossaDocUrl $ + execThrow dir sbtDepTreeCmd case (length projects > 1, depTreeStdOut) of -- not emitting warning or error, to avoid duplication from @@ -198,7 +194,12 @@ analyzeWithPoms (ScalaProject _ _ closure) = context "Analyzing sbt dependencies analyzeWithDepTreeJson :: (Has ReadFS sig m, Has Diagnostics sig m) => ScalaProject -> m DependencyResults analyzeWithDepTreeJson (ScalaProject _ treeJson closure) = context "Analyzing sbt dependencies using dependencyBrowseTreeHTML" $ do - treeJson' <- errCtx MissingFullDependencyPlugin $ fromMaybeText "Could not retrieve output from sbt dependencyBrowseTreeHTML" treeJson + treeJson' <- + errCtx MissingFullDependencyPluginCtx $ + errHelp MissingFullDependencyPluginHelp $ + errDoc sbtDepsGraphPluginUrl $ + errDoc scalaFossaDocUrl $ + fromMaybeText "Could not retrieve output from sbt dependencyBrowseTreeHTML" treeJson projectGraph <- TreeJson.analyze treeJson' pure $ DependencyResults diff --git a/src/Strategy/Scala/Errors.hs b/src/Strategy/Scala/Errors.hs index 20d27a4624..bc2fcf7c78 100644 --- a/src/Strategy/Scala/Errors.hs +++ b/src/Strategy/Scala/Errors.hs @@ -9,10 +9,11 @@ module Strategy.Scala.Errors ( ) where import App.Docs (strategyLangDocUrl) +import Data.String.Conversion (toText) import Data.Text (Text) import Diag.Diagnostic (ToDiagnostic, renderDiagnostic) +import Errata (Errata (..)) import Path (Abs, Dir, Path) -import Prettyprinter (Pretty (pretty), indent, viaShow, vsep) scalaFossaDocUrl :: Text scalaFossaDocUrl = strategyLangDocUrl "scala/sbt.md" @@ -20,45 +21,34 @@ scalaFossaDocUrl = strategyLangDocUrl "scala/sbt.md" sbtDepsGraphPluginUrl :: Text sbtDepsGraphPluginUrl = "https://github.com/sbt/sbt-dependency-graph" -data MaybeWithoutDependencyTreeTask = MaybeWithoutDependencyTreeTask +data MaybeWithoutDependencyTreeTask + = MaybeWithoutDependencyTreeTaskCtx + | MaybeWithoutDependencyTreeTaskHelp instance ToDiagnostic MaybeWithoutDependencyTreeTask where - renderDiagnostic (MaybeWithoutDependencyTreeTask) = - vsep - [ "We could not perform dynamic sbt analysis via sbt dependencyTree" - , indent 2 $ - vsep - [ "Ensure you can run sbt dependencyTree. If you are using older version than sbt v1.4.0 (e.g. v1.3.13)" - , "please install following plugin prior to running fossa:" - , indent 2 $ pretty sbtDepsGraphPluginUrl - , "" - ] - , "" - , "Refer to:" - , indent 2 $ pretty $ "- " <> scalaFossaDocUrl - ] + renderDiagnostic MaybeWithoutDependencyTreeTaskCtx = do + let header = "Could not perform dynamic sbt analysis via sbt dependencyTree" + Errata (Just header) [] Nothing + renderDiagnostic MaybeWithoutDependencyTreeTaskHelp = do + let header = "Ensure you can run sbt dependencyTree. Install the sbt plugin if you are using a version older than sbt v1.4.0 (e.g. v1.3.13)" + Errata (Just header) [] Nothing -data MissingFullDependencyPlugin = MissingFullDependencyPlugin +data MissingFullDependencyPlugin + = MissingFullDependencyPluginCtx + | MissingFullDependencyPluginHelp instance ToDiagnostic MissingFullDependencyPlugin where - renderDiagnostic (MissingFullDependencyPlugin) = - vsep - [ "We could not perform dynamic sbt analysis via `sbt dependencyBrowseTreeHTML`" - , indent 2 $ - vsep - [ "Ensure you can run `sbt dependencyBrowseTreeHTML`." - , "" - , "If you are not able run the aforementioned command," - , "you need to install following sbt plugin for your project, prior to using FOSSA CLI:" - , indent 2 $ pretty sbtDepsGraphPluginUrl - ] - , "" - , "Refer to:" - , indent 2 $ pretty $ "- " <> scalaFossaDocUrl - ] + renderDiagnostic MissingFullDependencyPluginCtx = do + let header = "Could not perform dynamic sbt analysis via `sbt dependencyBrowseTreeHTML`" + Errata (Just header) [] Nothing + renderDiagnostic MissingFullDependencyPluginHelp = do + let header = "Ensure you can run `sbt dependencyBrowseTreeHTML`. Install the sbt plugin if you are not able to run the aforementationed command." + Errata (Just header) [] Nothing newtype FailedToListProjects = FailedToListProjects (Path Abs Dir) deriving (Eq, Ord, Show) instance ToDiagnostic FailedToListProjects where - renderDiagnostic (FailedToListProjects dir) = "Failed to discover and analyze sbt projects, for sbt build manifest at:" <> viaShow dir + renderDiagnostic (FailedToListProjects dir) = do + let header = "Failed to discover and analyze sbt projects, for sbt build manifest at: " <> toText dir + Errata (Just header) [] Nothing diff --git a/src/Strategy/Swift/Errors.hs b/src/Strategy/Swift/Errors.hs index e9637fa1ab..9bd53a63d0 100644 --- a/src/Strategy/Swift/Errors.hs +++ b/src/Strategy/Swift/Errors.hs @@ -1,5 +1,6 @@ module Strategy.Swift.Errors ( MissingPackageResolvedFile (..), + MissingPackageResolvedFileHelp (..), -- * docs swiftFossaDocUrl, @@ -10,9 +11,9 @@ module Strategy.Swift.Errors ( import App.Docs (platformDocUrl) import Data.String.Conversion (toText) import Data.Text (Text) -import Diag.Diagnostic (DiagnosticInfo (..), ToDiagnostic, renderDiagnostic) +import Diag.Diagnostic (ToDiagnostic, renderDiagnostic) +import Errata (Errata (..)) import Path -import Prettyprinter (Pretty (pretty), indent, viaShow, vsep) swiftFossaDocUrl :: Text swiftFossaDocUrl = platformDocUrl "ios/swift.md" @@ -24,10 +25,15 @@ xcodeCoordinatePkgVersion :: Text xcodeCoordinatePkgVersion = "https://developer.apple.com/documentation/swift_packages/adding_package_dependencies_to_your_app" newtype MissingPackageResolvedFile = MissingPackageResolvedFile (Path Abs File) +data MissingPackageResolvedFileHelp = MissingPackageResolvedFileHelp instance ToDiagnostic MissingPackageResolvedFile where + renderDiagnostic :: MissingPackageResolvedFile -> Errata renderDiagnostic (MissingPackageResolvedFile path) = do - let ctx = "We could not perform Package.resolved analysis for: " <> toText (show path) - help = "Ensure valid Package.resolved exists, and is readable by user" - documentationReferences = [swiftPackageResolvedRef, xcodeCoordinatePkgVersion, swiftFossaDocUrl] - DiagnosticInfo Nothing Nothing (Just documentationReferences) Nothing (Just help) (Just ctx) Nothing + let header = "We could not perform Package.resolved analysis for: " <> toText (show path) + Errata (Just header) [] Nothing + +instance ToDiagnostic MissingPackageResolvedFileHelp where + renderDiagnostic MissingPackageResolvedFileHelp = do + let header = "Ensure valid Package.resolved exists, and is readable by user" + Errata (Just header) [] Nothing diff --git a/src/Strategy/Swift/PackageSwift.hs b/src/Strategy/Swift/PackageSwift.hs index a0f0214c84..eb30f66cba 100644 --- a/src/Strategy/Swift/PackageSwift.hs +++ b/src/Strategy/Swift/PackageSwift.hs @@ -13,7 +13,7 @@ module Strategy.Swift.PackageSwift ( ) where import Control.Applicative (Alternative ((<|>)), optional) -import Control.Effect.Diagnostics (Diagnostics, context, errCtx, fatalText, recover, warnOnErr) +import Control.Effect.Diagnostics (Diagnostics, context, errCtx, errDoc, errHelp, fatalText, recover, warnOnErr) import Control.Monad (void) import Data.Foldable (asum) import Data.Map.Strict qualified as Map @@ -25,7 +25,7 @@ import Diag.Common (MissingDeepDeps (MissingDeepDeps)) import Effect.ReadFS (Has, ReadFS, readContentsJson, readContentsParser) import Graphing (Graphing, deeps, directs, induceJust, promoteToDirect) import Path -import Strategy.Swift.Errors (MissingPackageResolvedFile (..)) +import Strategy.Swift.Errors (MissingPackageResolvedFile (..), MissingPackageResolvedFileHelp (..), swiftFossaDocUrl, swiftPackageResolvedRef, xcodeCoordinatePkgVersion) import Strategy.Swift.PackageResolved (SwiftPackageResolvedFile, resolvedDependenciesOf) import Text.Megaparsec ( MonadParsec (takeWhile1P, try), @@ -217,6 +217,10 @@ analyzePackageSwift manifestFile resolvedFile = do recover . warnOnErr MissingDeepDeps . errCtx (MissingPackageResolvedFile manifestFile) + . errHelp MissingPackageResolvedFileHelp + . errDoc swiftFossaDocUrl + . errDoc swiftPackageResolvedRef + . errDoc xcodeCoordinatePkgVersion $ fatalText "Package.resolved file was not discovered" Just packageResolved -> context "Identifying dependencies in Package.resolved" $ readContentsJson packageResolved diff --git a/src/Strategy/Swift/Xcode/Pbxproj.hs b/src/Strategy/Swift/Xcode/Pbxproj.hs index 2ed600341b..5aee101244 100644 --- a/src/Strategy/Swift/Xcode/Pbxproj.hs +++ b/src/Strategy/Swift/Xcode/Pbxproj.hs @@ -8,7 +8,7 @@ module Strategy.Swift.Xcode.Pbxproj ( swiftPackageReferencesOf, ) where -import Control.Effect.Diagnostics (Diagnostics, ToDiagnostic (renderDiagnostic), context, errCtx, fatalText, recover, warnOnErr) +import Control.Effect.Diagnostics (Diagnostics, ToDiagnostic (renderDiagnostic), context, errCtx, errDoc, errHelp, fatalText, recover, warnOnErr) import Data.Map (Map) import Data.Map.Strict qualified as Map import Data.Maybe (mapMaybe) @@ -17,13 +17,16 @@ import Data.String.Conversion (toText) import Data.Text (Text) import DepTypes (DepType (GitType, SwiftType), Dependency (..)) import Diag.Common (MissingDeepDeps (MissingDeepDeps)) -import Diag.Diagnostic qualified as DI import Effect.ReadFS (Has, ReadFS, readContentsJson, readContentsParser) +import Errata (Errata (..)) import Graphing (Graphing, deeps, directs, promoteToDirect) import Path -import Prettyprinter import Strategy.Swift.Errors ( - MissingPackageResolvedFile (MissingPackageResolvedFile), + MissingPackageResolvedFile (..), + MissingPackageResolvedFileHelp (..), + swiftFossaDocUrl, + swiftPackageResolvedRef, + xcodeCoordinatePkgVersion, ) import Strategy.Swift.PackageResolved (SwiftPackageResolvedFile, resolvedDependenciesOf) import Strategy.Swift.PackageSwift ( @@ -103,8 +106,8 @@ buildGraph projFile maybeResolvedContent = newtype FailedToParseProjFile = FailedToParseProjFile (Path Abs File) instance ToDiagnostic FailedToParseProjFile where renderDiagnostic (FailedToParseProjFile path) = do - let ctx = "Could not parse project.pbxproj file: " <> toText (show path) - DI.DiagnosticInfo Nothing Nothing Nothing Nothing Nothing (Just ctx) Nothing + let header = "Could not parse project.pbxproj file: " <> toText (show path) + Errata (Just header) [] Nothing -- | Checks if XCode Project File has at-least one swift dependency. -- It does by counting instances of `XCRemoteSwiftPackageReference` in the project file. @@ -125,6 +128,10 @@ analyzeXcodeProjForSwiftPkg xcodeProjFile resolvedFile = do recover . warnOnErr MissingDeepDeps . errCtx (MissingPackageResolvedFile xcodeProjFile) + . errHelp MissingPackageResolvedFileHelp + . errDoc swiftFossaDocUrl + . errDoc swiftPackageResolvedRef + . errDoc xcodeCoordinatePkgVersion $ fatalText "Package.resolved file was not discovered" Just packageResolved -> context "Identifying dependencies in Package.resolved" $ From a7c482d53f994b23001c31a0bc45a0d5ce2efce9 Mon Sep 17 00:00:00 2001 From: Jeffrey Huynh Date: Wed, 17 Jan 2024 11:02:27 -0800 Subject: [PATCH 04/17] update changes --- src/App/Fossa/Analyze.hs | 3 +-- src/Diag/Monad.hs | 2 +- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/src/App/Fossa/Analyze.hs b/src/App/Fossa/Analyze.hs index cbee5bb9f2..52eb6889a7 100644 --- a/src/App/Fossa/Analyze.hs +++ b/src/App/Fossa/Analyze.hs @@ -92,7 +92,7 @@ import Control.Monad (join, unless, void, when) import Data.Aeson ((.=)) import Data.Aeson qualified as Aeson import Data.ByteString.Lazy qualified as BL -import Data.Error (SourceLocation, createBlock, createBody, getSourceLocation) +import Data.Error (SourceLocation, createBlock, getSourceLocation) import Data.Flag (Flag, fromFlag) import Data.Foldable (traverse_) import Data.List.NonEmpty qualified as NE @@ -116,7 +116,6 @@ import Effect.Logger ( ) import Effect.ReadFS (ReadFS) import Errata (errataSimple) -import Errata qualified as E import Path (Abs, Dir, Path, toFilePath) import Path.IO (makeRelative) import Prettyprinter ( diff --git a/src/Diag/Monad.hs b/src/Diag/Monad.hs index cc965a6db9..7eed8a00ad 100644 --- a/src/Diag/Monad.hs +++ b/src/Diag/Monad.hs @@ -19,7 +19,7 @@ module Diag.Monad ( import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Trans.Class (MonadTrans, lift) import Data.List.NonEmpty qualified as NE -import Diag.Result (EmittedWarn (..), ErrCtx (..), ErrDoc, ErrGroup (..), ErrHelp, ErrSupport, ErrWithStack (..), Result (..), SomeErr (..), SomeWarn (..), Stack (..)) +import Diag.Result (EmittedWarn (..), ErrCtx (..), ErrDoc (..), ErrGroup (..), ErrHelp (..), ErrSupport, ErrWithStack (..), Result (..), SomeErr (..), SomeWarn (..), Stack (..)) -- | A monad transformer that adds error-/warning-reporting capabilities to -- other monads From fca09232195784c8870e35ae36d41f716aaf7c73 Mon Sep 17 00:00:00 2001 From: Jeffrey Huynh Date: Sun, 28 Jan 2024 17:38:17 -0800 Subject: [PATCH 05/17] fix lint --- src/App/Fossa/ManualDeps.hs | 18 +++++++-------- .../Fossa/VSI/DynLinked/Internal/Binary.hs | 2 +- .../FossaApiClient/Internal/FossaAPIV1.hs | 22 +++++++++---------- src/Control/Carrier/Git.hs | 3 ++- src/Strategy/Conda/CondaEnvCreate.hs | 4 ++-- 5 files changed, 25 insertions(+), 24 deletions(-) diff --git a/src/App/Fossa/ManualDeps.hs b/src/App/Fossa/ManualDeps.hs index 8e6ddf4bda..ff7786a67d 100644 --- a/src/App/Fossa/ManualDeps.hs +++ b/src/App/Fossa/ManualDeps.hs @@ -431,24 +431,24 @@ instance FromJSON ReferencedDependency where <$> (obj `neText` "name") <*> pure depType <*> (unTextLike <$$> obj .:? "version") - <* forbidNonRefDepFields obj - <* forbidLinuxFields depType obj - <* forbidEpoch depType obj + <* forbidNonRefDepFields obj + <* forbidLinuxFields depType obj + <* forbidEpoch depType obj ) parseApkOrDebDependency :: Object -> DepType -> Parser ReferencedDependency parseApkOrDebDependency obj depType = LinuxApkDebDep <$> parseLinuxDependency obj depType - <* forbidNonRefDepFields obj - <* forbidEpoch depType obj + <* forbidNonRefDepFields obj + <* forbidEpoch depType obj parseRpmDependency :: Object -> DepType -> Parser ReferencedDependency parseRpmDependency obj depType = LinuxRpmDep <$> parseLinuxDependency obj depType <*> (unTextLike <$$> obj .:? "epoch") - <* forbidNonRefDepFields obj + <* forbidNonRefDepFields obj parseLinuxDependency :: Object -> DepType -> Parser LinuxReferenceDependency parseLinuxDependency obj depType = @@ -515,7 +515,7 @@ instance FromJSON CustomDependency where <*> (obj `neText` "license") <*> obj .:? "metadata" - <* forbidMembers "custom dependencies" ["type", "path", "url"] obj + <* forbidMembers "custom dependencies" ["type", "path", "url"] obj instance FromJSON RemoteDependency where parseJSON = withObject "RemoteDependency" $ \obj -> do @@ -525,7 +525,7 @@ instance FromJSON RemoteDependency where <*> (obj `neText` "url") <*> obj .:? "metadata" - <* forbidMembers "remote dependencies" ["license", "path", "type"] obj + <* forbidMembers "remote dependencies" ["license", "path", "type"] obj validateRemoteDep :: (Has Diagnostics sig m) => RemoteDependency -> Organization -> m RemoteDependency validateRemoteDep r org = @@ -588,7 +588,7 @@ instance FromJSON DependencyMetadata where .:? "description" <*> obj .:? "homepage" - <* forbidMembers "metadata" ["url"] obj + <* forbidMembers "metadata" ["url"] obj -- Parse supported dependency types into their respective type or return Nothing. depTypeFromText :: Text -> Maybe DepType diff --git a/src/App/Fossa/VSI/DynLinked/Internal/Binary.hs b/src/App/Fossa/VSI/DynLinked/Internal/Binary.hs index ddbe02363f..14144719ab 100644 --- a/src/App/Fossa/VSI/DynLinked/Internal/Binary.hs +++ b/src/App/Fossa/VSI/DynLinked/Internal/Binary.hs @@ -124,7 +124,7 @@ lddParseLocalDependencies = <|> try lddConsumeLinker <|> try lddParseDependency ) - <* eof + <* eof lddParseDependency :: Parser (Maybe LocalDependency) lddParseDependency = Just <$> (LocalDependency <$> (linePrefix *> ident) <* symbol "=>" <*> path <* printedHex) diff --git a/src/Control/Carrier/FossaApiClient/Internal/FossaAPIV1.hs b/src/Control/Carrier/FossaApiClient/Internal/FossaAPIV1.hs index 36ee16ae27..bc36c4c899 100644 --- a/src/Control/Carrier/FossaApiClient/Internal/FossaAPIV1.hs +++ b/src/Control/Carrier/FossaApiClient/Internal/FossaAPIV1.hs @@ -595,12 +595,12 @@ uploadNativeContainerScan apiOpts ProjectRevision{..} metadata scan = fossaReq $ "locator" =: locator <> "cliVersion" - =: cliVersion + =: cliVersion <> "managedBuild" - =: True + =: True <> maybe mempty ("branch" =:) projectBranch <> "scanType" - =: ("native" :: Text) + =: ("native" :: Text) <> mkMetadataOpts metadata projectName resp <- req POST (containerUploadUrl baseUrl) (ReqBodyJson scan) jsonResponse (baseOpts <> opts) pure $ responseBody resp @@ -641,9 +641,9 @@ uploadAnalysis apiOpts ProjectRevision{..} metadata sourceUnits = fossaReq $ do "locator" =: renderLocator (Locator "custom" projectName (Just projectRevision)) <> "cliVersion" - =: cliVersion + =: cliVersion <> "managedBuild" - =: True + =: True <> mkMetadataOpts metadata projectName -- Don't include branch if it doesn't exist, core may not handle empty string properly. <> maybe mempty ("branch" =:) projectBranch @@ -664,11 +664,11 @@ uploadAnalysisWithFirstPartyLicenses apiOpts ProjectRevision{..} metadata fullFi "locator" =: renderLocator (Locator "custom" projectName (Just projectRevision)) <> "cliVersion" - =: cliVersion + =: cliVersion <> "managedBuild" - =: True + =: True <> "cliLicenseScanType" - =: (fullFileUploadsToCliLicenseScanType fullFileUploads) + =: (fullFileUploadsToCliLicenseScanType fullFileUploads) <> mkMetadataOpts metadata projectName -- Don't include branch if it doesn't exist, core may not handle empty string properly. <> maybe mempty ("branch" =:) projectBranch @@ -1121,11 +1121,11 @@ getAttributionJson apiOpts ProjectRevision{..} = fossaReq $ do opts = baseOpts <> "includeDeepDependencies" - =: True + =: True <> "includeHashAndVersionData" - =: True + =: True <> "dependencyInfoOptions[]" - =: packageDownloadUrl + =: packageDownloadUrl orgId <- organizationId <$> getOrganization apiOpts response <- req GET (attributionEndpoint baseUrl orgId (Locator "custom" projectName (Just projectRevision)) ReportJson) NoReqBody jsonResponse opts pure (responseBody response) diff --git a/src/Control/Carrier/Git.hs b/src/Control/Carrier/Git.hs index c8c58ac0f7..9ffb0303c0 100644 --- a/src/Control/Carrier/Git.hs +++ b/src/Control/Carrier/Git.hs @@ -90,4 +90,5 @@ data FailedToPerformGitLog = FailedToPerformGitLog instance ToDiagnostic FailedToPerformGitLog where renderDiagnostic _ = do let header = "Could not retrieve git logs for contributor counting." - Errata (Just header) [] Nothing \ No newline at end of file + Errata (Just header) [] Nothing + \ No newline at end of file diff --git a/src/Strategy/Conda/CondaEnvCreate.hs b/src/Strategy/Conda/CondaEnvCreate.hs index 5c58006012..17ab28f388 100644 --- a/src/Strategy/Conda/CondaEnvCreate.hs +++ b/src/Strategy/Conda/CondaEnvCreate.hs @@ -110,9 +110,9 @@ parseCondaEnvDep = CondaEnvDep <$> parseChannel <*> takeWhile1P (Just "platform") (/= ':') - <* chunk "::" + <* chunk "::" <*> takeWhile1P (Just "package name") (/= '=') - <* chunk "==" + <* chunk "==" <*> takeWhile1P (Just "version") (/= '=') where -- Parse '/'. From d2c02a78a8a3377ecc8e1b0140e31af3a48e9f7e Mon Sep 17 00:00:00 2001 From: Jeffrey Huynh Date: Sun, 28 Jan 2024 17:45:09 -0800 Subject: [PATCH 06/17] fix lint --- spectrometer.cabal | 3 +-- src/Control/Carrier/Git.hs | 1 - 2 files changed, 1 insertion(+), 3 deletions(-) diff --git a/spectrometer.cabal b/spectrometer.cabal index 07316f86f0..8341153f9f 100644 --- a/spectrometer.cabal +++ b/spectrometer.cabal @@ -99,7 +99,7 @@ common deps , containers ^>=0.6.0 , cpio-conduit ^>=0.7.0 , crypton ^>=0.33 - , deepseq ^>=1.4 + , deepseq ^>=1.4 , direct-sqlite ^>=2.3.27 , directory ^>=1.3.6.1 , either ^>=5.0.2 @@ -112,7 +112,6 @@ common deps , git-config ^>=0.1.2 , githash ^>=0.1.4.0 , hashable >=1.0.0.1 - , haskell-src >=1.0.4 , hedn ^>=0.3.0.1 , http-client ^>=0.7.1 , http-conduit ^>=2.3.0 diff --git a/src/Control/Carrier/Git.hs b/src/Control/Carrier/Git.hs index 9ffb0303c0..8918a5a696 100644 --- a/src/Control/Carrier/Git.hs +++ b/src/Control/Carrier/Git.hs @@ -91,4 +91,3 @@ instance ToDiagnostic FailedToPerformGitLog where renderDiagnostic _ = do let header = "Could not retrieve git logs for contributor counting." Errata (Just header) [] Nothing - \ No newline at end of file From 31a9d9b9a1bd8f071291dd95e24148dea8229c66 Mon Sep 17 00:00:00 2001 From: Jeffrey Huynh Date: Sun, 28 Jan 2024 18:12:12 -0800 Subject: [PATCH 07/17] update --- src/App/Fossa/Analyze.hs | 4 +--- src/App/Support.hs | 8 -------- src/Diag/Diagnostic.hs | 20 +------------------- src/Diag/Result.hs | 3 --- src/Effect/ReadFS.hs | 4 ++-- src/Strategy/Maven.hs | 13 +++++-------- 6 files changed, 9 insertions(+), 43 deletions(-) diff --git a/src/App/Fossa/Analyze.hs b/src/App/Fossa/Analyze.hs index b293c635dc..fc06e7674c 100644 --- a/src/App/Fossa/Analyze.hs +++ b/src/App/Fossa/Analyze.hs @@ -415,7 +415,7 @@ analyze cfg = Diag.context "fossa-analyze" $ do (False, FilteredAll) -> Diag.errDoc userGuideUrl $ Diag.fatal $ ErrFilteredAllProjects getSourceLocation (True, FilteredAll) -> Diag.fatal $ ErrOnlyKeywordSearchResultsFound getSourceLocation (_, CountedScanUnits scanUnits) -> doUpload outputResult iatAssertion destination basedir jsonOutput revision scanUnits - Diag.errHelp ("Another help message" :: Text) $ Diag.errHelp ("Make sure your project is supported" :: Text) $ Diag.errDoc userGuideUrl $ Diag.fatal $ ErrNoProjectsDiscovered getSourceLocation + pure outputResult where doUpload result iatAssertion destination basedir jsonOutput revision scanUnits = @@ -509,8 +509,6 @@ data AnalyzeError | ErrFilteredAllProjects (SourceLocation) | ErrOnlyKeywordSearchResultsFound (SourceLocation) --- instance Error.toErrata AnalyzeError where - instance Diag.ToDiagnostic AnalyzeError where renderDiagnostic (ErrNoProjectsDiscovered srcLoc) = do let header = "No analysis targets found in directory" diff --git a/src/App/Support.hs b/src/App/Support.hs index 2d6750d344..a5c24a91f8 100644 --- a/src/App/Support.hs +++ b/src/App/Support.hs @@ -114,14 +114,6 @@ reportTransientErrorMsg = "This error is often transient, so trying again in a f requestReportIfPersists :: Doc ann requestReportIfPersists = "If this issue persists, please contact FOSSA support at " <> pretty supportUrl -withRequestReportIfPersists :: Doc ann -> Doc ann -withRequestReportIfPersists msg = - vsep - [ msg - , "" - , requestReportIfPersists - ] - withDebugBundle :: Doc ann -> Doc ann withDebugBundle msg = vsep diff --git a/src/Diag/Diagnostic.hs b/src/Diag/Diagnostic.hs index b0d69e4e0d..ba92088199 100644 --- a/src/Diag/Diagnostic.hs +++ b/src/Diag/Diagnostic.hs @@ -11,6 +11,7 @@ import Data.String.Conversion (toText) import Data.Text (Text) import Errata (Errata (..)) +-- | A class of diagnostic types that can be rendered in a user-friendly way class ToDiagnostic a where renderDiagnostic :: a -> Errata @@ -23,25 +24,6 @@ instance ToDiagnostic String where instance ToDiagnostic SomeException where renderDiagnostic (SomeException exc) = Errata (Just $ "An exception occurred:" <> toText (show exc)) [] Nothing --- | A class of diagnostic types that can be rendered in a user-friendly way --- class ToDiagnostic a where --- renderDiagnostic :: a -> Doc AnsiStyle - --- instance ToDiagnostic (Doc AnsiStyle) where --- renderDiagnostic = id - --- instance ToDiagnostic Text where --- renderDiagnostic = pretty - --- instance ToDiagnostic String where --- renderDiagnostic = pretty - --- instance ToDiagnostic Errata where --- renderDiagnostic err = pretty $ renderErrors [err] - --- instance ToDiagnostic SomeException where --- renderDiagnostic (SomeException exc) = "An exception occurred: " <> pretty (show exc) - -- | An error with a ToDiagnostic instance and an associated stack trace data SomeDiagnostic where SomeDiagnostic :: ToDiagnostic a => [Text] -> a -> SomeDiagnostic diff --git a/src/Diag/Result.hs b/src/Diag/Result.hs index 84fbe9a4e9..3e98d59beb 100644 --- a/src/Diag/Result.hs +++ b/src/Diag/Result.hs @@ -350,8 +350,5 @@ section name content = <> indent 2 content <> line -subsection :: Doc AnsiStyle -> [Doc AnsiStyle] -> Doc AnsiStyle -subsection name = vsep . map (\single -> annotate (color Yellow) name <> line <> line <> indent 2 single <> line) - unannotatedSubsection :: [Doc AnsiStyle] -> Doc AnsiStyle unannotatedSubsection = vsep . map (indent 2) diff --git a/src/Effect/ReadFS.hs b/src/Effect/ReadFS.hs index a8567b1fde..3f04897a43 100644 --- a/src/Effect/ReadFS.hs +++ b/src/Effect/ReadFS.hs @@ -61,7 +61,7 @@ module Effect.ReadFS ( module X, ) where -import App.Support (reportDefectWithFileMsg, supportUrl) +import App.Support (supportUrl) import Control.Algebra as X import Control.Carrier.Simple ( Simple, @@ -111,7 +111,7 @@ import Path ( ) import Path.Extra (SomePath (..)) import Path.IO qualified as PIO -import Prettyprinter (indent, line, pretty, vsep) +import Prettyprinter (indent, pretty, vsep) import System.Directory qualified as Directory import System.FilePath qualified as FP import System.IO (IOMode (ReadMode), withFile) diff --git a/src/Strategy/Maven.hs b/src/Strategy/Maven.hs index 9bc34e0fea..93654b1f1e 100644 --- a/src/Strategy/Maven.hs +++ b/src/Strategy/Maven.hs @@ -140,9 +140,7 @@ getDepsPlugin :: ) => MavenProjectClosure -> m (Graphing MavenDependency, GraphBreadth) -getDepsPlugin closure = fatal MissingDeepDeps - --- context "Plugin analysis" (Plugin.analyze' . parent $ PomClosure.closurePath closure) +getDepsPlugin closure = context "Plugin analysis" (Plugin.analyze' . parent $ PomClosure.closurePath closure) getDepsPluginLegacy :: ( CandidateCommandEffs sig m @@ -160,11 +158,10 @@ getDepsTreeCmd :: ) => MavenProjectClosure -> m (Graphing MavenDependency, GraphBreadth) -getDepsTreeCmd closure = fatal MissingEdges - --- context "Dynamic analysis" $ --- DepTreeCmd.analyze . parent $ --- PomClosure.closurePath closure +getDepsTreeCmd closure = + context "Dynamic analysis" $ + DepTreeCmd.analyze . parent $ + PomClosure.closurePath closure getStaticAnalysis :: ( Has (Lift IO) sig m From 24cd122d93c2057c159bf8f46552c6592d55463e Mon Sep 17 00:00:00 2001 From: Jeffrey Huynh Date: Sun, 28 Jan 2024 18:38:23 -0800 Subject: [PATCH 08/17] removing redundant imports --- src/App/Fossa/Config/ConfigFile.hs | 4 ---- src/Effect/Grapher.hs | 1 - src/Strategy/AlpineLinux/Parser.hs | 1 - src/Strategy/Nim/NimbleLock.hs | 1 - src/Strategy/Python/Pip.hs | 1 - 5 files changed, 8 deletions(-) diff --git a/src/App/Fossa/Config/ConfigFile.hs b/src/App/Fossa/Config/ConfigFile.hs index 9b80f4c189..9a7784a055 100644 --- a/src/App/Fossa/Config/ConfigFile.hs +++ b/src/App/Fossa/Config/ConfigFile.hs @@ -52,14 +52,10 @@ import Data.String.Conversion (ToString (toString), ToText (toText)) import Data.Text (Text, strip, toLower) import Diag.Diagnostic (ToDiagnostic (..)) import Effect.Logger ( - AnsiStyle, - Doc, Logger, - Pretty (pretty), logDebug, logWarn, viaShow, - vsep, ) import Effect.ReadFS (ReadFS, doesFileExist, getCurrentDir, readContentsYaml) import Errata (Errata (..)) diff --git a/src/Effect/Grapher.hs b/src/Effect/Grapher.hs index 336abea593..6901c37ee0 100644 --- a/src/Effect/Grapher.hs +++ b/src/Effect/Grapher.hs @@ -49,7 +49,6 @@ import Data.String.Conversion (toText) import Data.Text (Text) import Errata (Errata (..)) import Graphing qualified as G -import Prettyprinter (pretty) data SGrapher ty k where Direct :: ty -> SGrapher ty () diff --git a/src/Strategy/AlpineLinux/Parser.hs b/src/Strategy/AlpineLinux/Parser.hs index 14f4a314ac..ca1d9dee72 100644 --- a/src/Strategy/AlpineLinux/Parser.hs +++ b/src/Strategy/AlpineLinux/Parser.hs @@ -50,7 +50,6 @@ import Data.String.Conversion (toText) import Data.Text (Text) import Data.Text qualified as Text import Data.Void (Void) -import Effect.Logger (pretty) import Errata (Errata (..)) import Strategy.AlpineLinux.Types (AlpinePackage (..)) import Text.Megaparsec ( diff --git a/src/Strategy/Nim/NimbleLock.hs b/src/Strategy/Nim/NimbleLock.hs index a9b8ae143a..ebcc4578c2 100644 --- a/src/Strategy/Nim/NimbleLock.hs +++ b/src/Strategy/Nim/NimbleLock.hs @@ -45,7 +45,6 @@ import DepTypes ( Dependency (Dependency), VerConstraint (CEq), ) -import Diag.Diagnostic qualified as DI import Effect.Exec (AllowErr (Always), Command (..), Exec, execJson) import Effect.ReadFS (Has, ReadFS, readContentsJson) import Errata (Errata (..)) diff --git a/src/Strategy/Python/Pip.hs b/src/Strategy/Python/Pip.hs index db4965f605..8671b4de0b 100644 --- a/src/Strategy/Python/Pip.hs +++ b/src/Strategy/Python/Pip.hs @@ -21,7 +21,6 @@ import Effect.Exec ( execJson, execParser, ) -import Effect.Logger (vsep) import Errata (Errata (..)) import GHC.Generics (Generic) import Path (Abs, Dir, Path) From ff7594c7b06539489bc905d9b32b3a3a1321a79b Mon Sep 17 00:00:00 2001 From: Jeffrey Huynh Date: Sun, 28 Jan 2024 18:50:52 -0800 Subject: [PATCH 09/17] fix imports --- src/App/Fossa/Config/Report.hs | 2 +- src/App/Fossa/Config/Test.hs | 2 +- src/Strategy/Conan/ConanGraph.hs | 1 - src/Strategy/Go/Transitive.hs | 1 - src/Strategy/Googlesource/RepoManifest.hs | 1 - src/Strategy/Maven.hs | 2 +- 6 files changed, 3 insertions(+), 6 deletions(-) diff --git a/src/App/Fossa/Config/Report.hs b/src/App/Fossa/Config/Report.hs index bd62c8160e..6c10991a49 100644 --- a/src/App/Fossa/Config/Report.hs +++ b/src/App/Fossa/Config/Report.hs @@ -52,7 +52,7 @@ import Options.Applicative ( switch, ) import Options.Applicative.Builder (helpDoc) -import Prettyprinter (Doc, comma, hardline, pretty, punctuate, viaShow) +import Prettyprinter (Doc, comma, hardline, punctuate, viaShow) import Prettyprinter.Render.Terminal (AnsiStyle, Color (Green, Red)) import Style (applyFossaStyle, boldItalicized, coloredBoldItalicized, formatDoc, stringToHelpDoc, styledDivider) diff --git a/src/App/Fossa/Config/Test.hs b/src/App/Fossa/Config/Test.hs index ee0c47f012..890309a180 100644 --- a/src/App/Fossa/Config/Test.hs +++ b/src/App/Fossa/Config/Test.hs @@ -45,7 +45,7 @@ import Data.String.Conversion (toText) import Data.Text (Text) import Diag.Diagnostic (ToDiagnostic (renderDiagnostic)) import Effect.Exec (Exec) -import Effect.Logger (Logger, Pretty (pretty), Severity (SevDebug, SevInfo), logWarn, vsep) +import Effect.Logger (Logger, Severity (SevDebug, SevInfo), logWarn, vsep) import Effect.ReadFS (ReadFS, getCurrentDir, resolveDir) import Errata (Errata (..)) import Fossa.API.Types (ApiOpts) diff --git a/src/Strategy/Conan/ConanGraph.hs b/src/Strategy/Conan/ConanGraph.hs index 783cc27f2d..5df4401534 100644 --- a/src/Strategy/Conan/ConanGraph.hs +++ b/src/Strategy/Conan/ConanGraph.hs @@ -52,7 +52,6 @@ import Errata (Errata (..)) import Graphing (Graphing) import Network.HTTP.Types (renderQueryText) import Path (Abs, Dir, Path) -import Prettyprinter (indent, vsep) import Strategy.Conan.Version (guardConanVersion2Gt) -- | Represents `conan install . -f json`. diff --git a/src/Strategy/Go/Transitive.hs b/src/Strategy/Go/Transitive.hs index 8301b8f804..7bb82d9b24 100644 --- a/src/Strategy/Go/Transitive.hs +++ b/src/Strategy/Go/Transitive.hs @@ -52,7 +52,6 @@ import Effect.Exec ( import Effect.Grapher (edge, label) import Errata (Errata (..)) import Path (Abs, Dir, Path) -import Prettyprinter (pretty) import Strategy.Go.Types ( GolangGrapher, GolangPackage, diff --git a/src/Strategy/Googlesource/RepoManifest.hs b/src/Strategy/Googlesource/RepoManifest.hs index f3377a4021..703635a1aa 100644 --- a/src/Strategy/Googlesource/RepoManifest.hs +++ b/src/Strategy/Googlesource/RepoManifest.hs @@ -69,7 +69,6 @@ import Path ( parseRelFile, (), ) -import Prettyprinter (pretty) import Text.GitConfig.Parser (Section (..), parseConfig) import Text.Megaparsec (errorBundlePretty) import Text.URI (URI, mkURI, relativeTo, render) diff --git a/src/Strategy/Maven.hs b/src/Strategy/Maven.hs index 93654b1f1e..c5845584ee 100644 --- a/src/Strategy/Maven.hs +++ b/src/Strategy/Maven.hs @@ -8,7 +8,7 @@ module Strategy.Maven ( import App.Fossa.Analyze.LicenseAnalyze (LicenseAnalyzeProject, licenseAnalyzeProject) import App.Fossa.Analyze.Types (AnalyzeProject (analyzeProjectStaticOnly), analyzeProject) import Control.Algebra (Has) -import Control.Effect.Diagnostics (Diagnostics, context, fatal, warnOnErr, (<||>)) +import Control.Effect.Diagnostics (Diagnostics, context, warnOnErr, (<||>)) import Control.Effect.Lift (Lift) import Control.Effect.Reader (Reader, ask) import Data.Aeson (ToJSON) From 140675e2fb6d4ef026b4a26a4759806bd8593937 Mon Sep 17 00:00:00 2001 From: Jeffrey Huynh Date: Sun, 28 Jan 2024 19:09:04 -0800 Subject: [PATCH 10/17] imports --- src/Control/Carrier/FossaApiClient/Internal/FossaAPIV1.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/Control/Carrier/FossaApiClient/Internal/FossaAPIV1.hs b/src/Control/Carrier/FossaApiClient/Internal/FossaAPIV1.hs index bc36c4c899..39493d36f7 100644 --- a/src/Control/Carrier/FossaApiClient/Internal/FossaAPIV1.hs +++ b/src/Control/Carrier/FossaApiClient/Internal/FossaAPIV1.hs @@ -75,7 +75,6 @@ import Codec.Compression.GZip qualified as GZIP import Container.Errors (EndpointDoesNotSupportNativeContainerScan (EndpointDoesNotSupportNativeContainerScan)) import Container.Types qualified as NativeContainer import Control.Algebra (Algebra, Has, type (:+:)) -import Control.Carrier.Diagnostics (errHelp) import Control.Carrier.Empty.Maybe (Empty, EmptyC, runEmpty) import Control.Effect.Debug (Debug, debugLog) import Control.Effect.Diagnostics (Diagnostics, ToDiagnostic (..), context, fatal, fatalText, fromMaybeText) @@ -98,7 +97,7 @@ import Data.ByteString qualified as BS import Data.ByteString.Char8 qualified as C import Data.ByteString.Lazy (ByteString) import Data.Data (Proxy (Proxy)) -import Data.Error (DiagnosticStyle (..), SourceLocation, applyDiagnosticStyle, createBlock, createBody, getSourceLocation) +import Data.Error (SourceLocation, createBlock, createBody, getSourceLocation) import Data.List.NonEmpty (NonEmpty) import Data.List.NonEmpty qualified as NE import Data.Map (Map) From 50cce033c21a7e0663a86c89659332e7b3dec176 Mon Sep 17 00:00:00 2001 From: Jeffrey Huynh Date: Sun, 28 Jan 2024 19:20:56 -0800 Subject: [PATCH 11/17] imports --- src/App/Fossa/LicenseScanner.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/App/Fossa/LicenseScanner.hs b/src/App/Fossa/LicenseScanner.hs index 370edea0fc..1ff621bbaa 100644 --- a/src/App/Fossa/LicenseScanner.hs +++ b/src/App/Fossa/LicenseScanner.hs @@ -71,7 +71,7 @@ import Fossa.API.Types ( ) import Path (Abs, Dir, File, Path, SomeBase (Abs, Rel), fileExtension, parent, ()) import Path.Extra (SomePath (..), tryMakeRelative) -import Prettyprinter (Pretty (pretty), squotes) +import Prettyprinter (Pretty (pretty)) import Srclib.Types ( LicenseScanType (CliLicenseScanned), LicenseSourceUnit (..), From 41ff90c5e6f7ce54457d07b2501b3e04eaa9d7ee Mon Sep 17 00:00:00 2001 From: Jeffrey Huynh Date: Sun, 28 Jan 2024 19:33:28 -0800 Subject: [PATCH 12/17] removing test work --- src/App/Fossa/LicenseScan.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/App/Fossa/LicenseScan.hs b/src/App/Fossa/LicenseScan.hs index 40717a1c55..50d2a64a48 100644 --- a/src/App/Fossa/LicenseScan.hs +++ b/src/App/Fossa/LicenseScan.hs @@ -98,7 +98,6 @@ outputVendoredDeps :: BaseDir -> m () outputVendoredDeps (BaseDir dir) = runStickyLogger SevInfo $ do - Diag.fatal (NoVendoredDeps getSourceLocation) config <- resolveConfigFile dir Nothing manualDepsFile <- fromMaybe (MissingFossaDepsFile getSourceLocation) =<< findFossaDepsFile dir manualDeps <- readFoundDeps manualDepsFile From d7a9d0913686481bebc59ff6ce595a631e90dba8 Mon Sep 17 00:00:00 2001 From: Jeffrey Huynh Date: Sun, 28 Jan 2024 19:45:55 -0800 Subject: [PATCH 13/17] import --- src/App/Fossa/LicenseScan.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/App/Fossa/LicenseScan.hs b/src/App/Fossa/LicenseScan.hs index 50d2a64a48..633aa17e9c 100644 --- a/src/App/Fossa/LicenseScan.hs +++ b/src/App/Fossa/LicenseScan.hs @@ -22,7 +22,6 @@ import App.Fossa.VendoredDependency ( dedupVendoredDeps, ) import App.Types (BaseDir (BaseDir), FullFileUploads (FullFileUploads)) -import Control.Carrier.Diagnostics qualified as Diag import Control.Carrier.StickyLogger ( Has, StickyLogger, From 8003e71bd8f323dc63acb933e414220f394c1b5f Mon Sep 17 00:00:00 2001 From: Jeffrey Huynh Date: Fri, 9 Feb 2024 13:51:46 -0800 Subject: [PATCH 14/17] pr comments --- docs/contributing/README.md | 7 +++- docs/contributing/diagnostics.md | 14 +++---- src/App/Fossa/API/BuildWait.hs | 16 ++++---- src/App/Fossa/Analyze.hs | 23 +++++------ src/App/Fossa/Analyze/ScanSummary.hs | 2 +- src/App/Fossa/Config/Report.hs | 14 +++---- src/App/Fossa/LicenseScan.hs | 17 ++++---- src/App/Fossa/LicenseScanner.hs | 39 +++++++------------ src/App/Fossa/ManualDeps.hs | 34 ++++++++-------- src/App/Fossa/PreflightChecks.hs | 13 +++---- src/App/Support.hs | 2 +- src/Container/Docker/OciManifest.hs | 10 ++--- src/Container/Errors.hs | 15 +++---- .../FossaApiClient/Internal/FossaAPIV1.hs | 37 +++++++++--------- src/Data/Error.hs | 23 +++++------ src/Diag/Result.hs | 2 +- src/Effect/Exec.hs | 8 ++-- src/Strategy/Conan/Enrich.hs | 25 ++++++------ src/Strategy/Go/GoListPackages.hs | 16 ++++---- src/Strategy/Scala/Errors.hs | 2 +- 20 files changed, 148 insertions(+), 171 deletions(-) diff --git a/docs/contributing/README.md b/docs/contributing/README.md index bbc91416b6..a37b341078 100644 --- a/docs/contributing/README.md +++ b/docs/contributing/README.md @@ -9,7 +9,7 @@ as providing some info about our CI setup. ## Style Guide -Our [Style Guide](STYLE-GUIDE.md) las out stylistic and idiomatic standards for all contributions. +Our [Style Guide](STYLE-GUIDE.md) contains our stylistic and idiomatic standards for all contributions. We are in the process of fully aligning to that guide, but any new contributions should follow the style guide. ## Parsing and best practices @@ -41,6 +41,11 @@ To allow the user to prevent us from including certain sets of results in an ana work involved, we allow users to filter at both the discovery level and analysis level. [More details can be in the filtering document](filtering.md). +## Errors and Warnings + +Error handling and warnings are done through our [diagnostics effect](diagnostics.md). +In order to render errors and warnings through the diagnostic, refer to our [rendering guidelines](diagnostics.md#rendering-todiagnostic). + ## Releases We have a release process that manages building our archives and updating our release notes. [Read more about our releases here](releases.md). diff --git a/docs/contributing/diagnostics.md b/docs/contributing/diagnostics.md index 6103041a0a..6ecb4fd827 100644 --- a/docs/contributing/diagnostics.md +++ b/docs/contributing/diagnostics.md @@ -488,24 +488,22 @@ getSourceLocation = case getCallStack ?callStack of _ -> SourceLocation "Unknown" 0 0 -- wrapper to create an Errata block -createBlock :: SourceLocation -> Maybe Text -> Maybe Text -> Block -createBlock SourceLocation{..} maybeHeader = +createEmptyBlock :: SourceLocation -> Block +createEmptyBlock SourceLocation{..} = Block fancyStyle (filePath, line, col) - maybeHeader + Nothing [] + Nothing -- concrete error type data SampleError = SampleError Text SourceLocation instance toDiagnostic SampleError where - renderDiagnostic (SampleError errDetails srcLoc) = do - let header = "Failed to peform action" - block = createBlock srcLoc Nothing Nothing - - Errata (Just header) [block] (Just errDetails) + renderDiagnostic (SampleError errDetails srcLoc) = + Errata (Just $ "Failed to peform action") (createEmptyBlock srcLoc) (Just errDetails) exampleFunc = do x <- someAction diff --git a/src/App/Fossa/API/BuildWait.hs b/src/App/Fossa/API/BuildWait.hs index cfc64cc6bd..1662ef92b3 100644 --- a/src/App/Fossa/API/BuildWait.hs +++ b/src/App/Fossa/API/BuildWait.hs @@ -28,9 +28,10 @@ import Control.Effect.FossaApiClient ( import Control.Effect.StickyLogger (StickyLogger, logSticky') import Control.Monad (void, when) import Control.Timeout (Cancel, checkForCancel, delay) -import Data.Error (SourceLocation, createBlock, getSourceLocation) +import Data.Error (SourceLocation, createEmptyBlock, getSourceLocation) import Effect.Logger (Logger, viaShow) import Errata (errataSimple) +import Errata.Types (Errata) import Fossa.API.Types ( ApiOpts (apiOptsPollDelay), Build (buildTask), @@ -51,14 +52,11 @@ data WaitError deriving (Eq, Ord, Show) instance ToDiagnostic WaitError where - renderDiagnostic (BuildFailed srcLoc) = do - let header = "The build failed. Check the FOSSA webapp for more details" - block = createBlock srcLoc Nothing Nothing - errataSimple (Just header) block Nothing - renderDiagnostic (LocalTimeout srcLoc) = do - let header = "Build/Issue scan was not completed on the FOSSA server, and the --timeout duration has expired" - block = createBlock srcLoc Nothing Nothing - errataSimple (Just header) block Nothing + renderDiagnostic :: WaitError -> Errata + renderDiagnostic (BuildFailed srcLoc) = + errataSimple (Just "The build failed. Check the FOSSA webapp for more details") (createEmptyBlock srcLoc) Nothing + renderDiagnostic (LocalTimeout srcLoc) = + errataSimple (Just "Build/Issue scan was not completed on the FOSSA server, and the --timeout duration has expired") (createEmptyBlock srcLoc) Nothing -- | Wait for either a normal build completion or a monorepo scan completion. -- Try to detect the correct method, use provided fallback diff --git a/src/App/Fossa/Analyze.hs b/src/App/Fossa/Analyze.hs index adbb77e938..5d3362b5f8 100644 --- a/src/App/Fossa/Analyze.hs +++ b/src/App/Fossa/Analyze.hs @@ -94,7 +94,7 @@ import Control.Monad (join, unless, void, when) import Data.Aeson ((.=)) import Data.Aeson qualified as Aeson import Data.ByteString.Lazy qualified as BL -import Data.Error (SourceLocation, createBlock, getSourceLocation) +import Data.Error (SourceLocation, createEmptyBlock, getSourceLocation) import Data.Flag (Flag, fromFlag) import Data.Foldable (traverse_) import Data.List.NonEmpty qualified as NE @@ -117,7 +117,7 @@ import Effect.Logger ( renderIt, ) import Effect.ReadFS (ReadFS) -import Errata (errataSimple) +import Errata (Errata, errataSimple) import Path (Abs, Dir, Path, toFilePath) import Path.IO (makeRelative) import Prettyprinter ( @@ -516,13 +516,11 @@ data AnalyzeError | ErrOnlyKeywordSearchResultsFound (SourceLocation) instance Diag.ToDiagnostic AnalyzeError where - renderDiagnostic (ErrNoProjectsDiscovered srcLoc) = do - let header = "No analysis targets found in directory" - block = createBlock srcLoc Nothing Nothing - errataSimple (Just header) block Nothing + renderDiagnostic :: AnalyzeError -> Errata + renderDiagnostic (ErrNoProjectsDiscovered srcLoc) = + errataSimple (Just "No analysis targets found in directory") (createEmptyBlock srcLoc) Nothing renderDiagnostic (ErrFilteredAllProjects srcLoc) = do - let header = "Filtered out all projects" - body = + let body = renderIt $ vsep [ "This may be occurring because: " @@ -533,18 +531,15 @@ instance Diag.ToDiagnostic AnalyzeError where , vsep $ map (\i -> pretty $ " * " <> toText i) ignoredPaths , "" ] - block = createBlock srcLoc Nothing Nothing - errataSimple (Just header) block (Just body) + errataSimple (Just "Filtered out all projects") (createEmptyBlock srcLoc) (Just body) renderDiagnostic (ErrOnlyKeywordSearchResultsFound srcLoc) = do - let header = "Only keyword search results found" - body = + let body = renderIt $ vsep [ "Matches to your keyword searches were found, but no other analysis targets were found." , "This error can be safely ignored if you are only expecting keyword search results." ] - block = createBlock srcLoc Nothing Nothing - errataSimple (Just header) block (Just body) + errataSimple (Just "Only keyword search results found") (createEmptyBlock srcLoc) (Just body) buildResult :: Flag IncludeAll -> [SourceUnit] -> [ProjectResult] -> Maybe LicenseSourceUnit -> Aeson.Value buildResult includeAll srcUnits projects licenseSourceUnits = diff --git a/src/App/Fossa/Analyze/ScanSummary.hs b/src/App/Fossa/Analyze/ScanSummary.hs index 526da03255..3b5d16a9bb 100644 --- a/src/App/Fossa/Analyze/ScanSummary.hs +++ b/src/App/Fossa/Analyze/ScanSummary.hs @@ -368,7 +368,7 @@ countWarnings ws = isIgnoredErrGroup IgnoredErrGroup{} = True isIgnoredErrGroup _ = False -dumpResultLogsToTempFile :: (Has (Lift IO) sig m) => Config.AnalyzeConfig -> Text -> AnalysisScanResult -> m (Path Abs File) +dumpResultLogsToTempFile :: (Has (Lift IO) sig m) => Config.AnalyzeConfig -> Data.Text.Text -> AnalysisScanResult -> m (Path Abs File) dumpResultLogsToTempFile cfg endpointVersion (AnalysisScanResult projects vsi binary manualDeps dynamicLinkingDeps lernieResults) = do let doc = renderStrict diff --git a/src/App/Fossa/Config/Report.hs b/src/App/Fossa/Config/Report.hs index 6c10991a49..caedf403c6 100644 --- a/src/App/Fossa/Config/Report.hs +++ b/src/App/Fossa/Config/Report.hs @@ -28,7 +28,7 @@ import Control.Effect.Diagnostics (Diagnostics, ToDiagnostic (renderDiagnostic), import Control.Effect.Lift (Has, Lift) import Control.Timeout (Duration (Seconds)) import Data.Aeson (ToJSON (toEncoding), defaultOptions, genericToEncoding) -import Data.Error (SourceLocation, createBlock, getSourceLocation) +import Data.Error (SourceLocation, createEmptyBlock, getSourceLocation) import Data.List (intercalate) import Data.String.Conversion (ToText, toText) import Effect.Exec (Exec) @@ -227,20 +227,20 @@ mergeOpts cfgfile envvars ReportCliOptions{..} = do newtype NoFormatProvided = NoFormatProvided SourceLocation instance ToDiagnostic NoFormatProvided where - renderDiagnostic (NoFormatProvided srcLoc) = do - let header = "No format provided" - block = createBlock srcLoc Nothing Nothing - errataSimple (Just header) block Nothing + renderDiagnostic :: NoFormatProvided -> Errata + renderDiagnostic (NoFormatProvided srcLoc) = + errataSimple (Just "No format provided") (createEmptyBlock srcLoc) Nothing data InvalidReportFormat = InvalidReportFormat SourceLocation String instance ToDiagnostic InvalidReportFormat where + renderDiagnostic :: InvalidReportFormat -> Errata renderDiagnostic (InvalidReportFormat srcLoc fmt) = do let header = "Report format: " <> toText fmt <> " is not supported" - block = createBlock srcLoc Nothing Nothing - errataSimple (Just header) block Nothing + errataSimple (Just header) (createEmptyBlock srcLoc) Nothing data ReportErrorHelp = ReportErrorHelp instance ToDiagnostic ReportErrorHelp where + renderDiagnostic :: ReportErrorHelp -> Errata renderDiagnostic ReportErrorHelp = do let header = "Provide a supported format via '--format'. Supported formats: " <> (toText reportOutputFormatList) Errata (Just header) [] Nothing diff --git a/src/App/Fossa/LicenseScan.hs b/src/App/Fossa/LicenseScan.hs index 633aa17e9c..ed63056afe 100644 --- a/src/App/Fossa/LicenseScan.hs +++ b/src/App/Fossa/LicenseScan.hs @@ -31,7 +31,7 @@ import Control.Effect.Diagnostics (Diagnostics, ToDiagnostic, fromMaybe) import Control.Effect.Lift (Lift) import Data.Aeson (KeyValue ((.=)), ToJSON (toJSON), object) import Data.Aeson qualified as Aeson -import Data.Error (SourceLocation, createBlock, getSourceLocation) +import Data.Error (SourceLocation, createEmptyBlock, getSourceLocation) import Data.List.NonEmpty (NonEmpty) import Data.List.NonEmpty qualified as NE import Data.String.Conversion (decodeUtf8) @@ -40,6 +40,7 @@ import Effect.Exec (Exec) import Effect.Logger (Logger, Severity (SevInfo), logStdout, renderIt) import Effect.ReadFS (ReadFS) import Errata (errataSimple) +import Errata.Types (Errata) import Path (Abs, Dir, Path) import Prettyprinter (vsep) import Srclib.Types (LicenseSourceUnit) @@ -49,22 +50,20 @@ newtype MissingFossaDepsFile = MissingFossaDepsFile SourceLocation newtype NoVendoredDeps = NoVendoredDeps SourceLocation instance ToDiagnostic MissingFossaDepsFile where + renderDiagnostic :: MissingFossaDepsFile -> Errata renderDiagnostic (MissingFossaDepsFile srcLoc) = do - let header = "Missing fossa-deps file" - body = + let body = renderIt $ vsep [ "'fossa license-scan fossa-deps' requires pointing to a directory with a fossa-deps file." , "The file can have one of the extensions: .yaml .yml .json" ] - block = createBlock srcLoc Nothing Nothing - errataSimple (Just header) block (Just body) + errataSimple (Just "Missing fossa-deps file") (createEmptyBlock srcLoc) (Just body) instance ToDiagnostic NoVendoredDeps where - renderDiagnostic (NoVendoredDeps srcLoc) = do - let header = "The 'vendored-dependencies' section of the fossa deps file is empty or missing." - block = createBlock srcLoc Nothing Nothing - errataSimple (Just header) block Nothing + renderDiagnostic :: NoVendoredDeps -> Errata + renderDiagnostic (NoVendoredDeps srcLoc) = + errataSimple (Just "The 'vendored-dependencies' section of the fossa deps file is empty or missing") (createEmptyBlock srcLoc) Nothing newtype UploadUnits = UploadUnits (NonEmpty LicenseSourceUnit) diff --git a/src/App/Fossa/LicenseScanner.hs b/src/App/Fossa/LicenseScanner.hs index 1ff621bbaa..81d0aa797d 100644 --- a/src/App/Fossa/LicenseScanner.hs +++ b/src/App/Fossa/LicenseScanner.hs @@ -43,7 +43,7 @@ import Control.Effect.Lift (Lift, sendIO) import Control.Effect.Path (withSystemTempDir) import Control.Effect.StickyLogger (StickyLogger, logSticky) import Data.Either.Combinators (rightToMaybe) -import Data.Error (SourceLocation, createBlock, getSourceLocation) +import Data.Error (SourceLocation, createEmptyBlock, getSourceLocation) import Data.HashMap.Strict qualified as HM import Data.List.NonEmpty (NonEmpty) import Data.List.NonEmpty qualified as NE @@ -62,7 +62,7 @@ import Effect.ReadFS ( ReadFS, resolvePath', ) -import Errata (errataSimple) +import Errata (Errata, errataSimple) import Fossa.API.Types ( Archive (Archive, archiveName), ArchiveComponents (..), @@ -88,31 +88,18 @@ data LicenseScanErr | UnsupportedArchive SourceLocation (Path Abs File) instance ToDiagnostic LicenseScanErr where - renderDiagnostic (NoSuccessfulScans srcLoc) = do - let header = "No native license scans were successful" - block = createBlock srcLoc Nothing Nothing - errataSimple (Just header) block Nothing - renderDiagnostic (NoLicenseResults srcLoc path) = do - let header = "No license results found after scanning directory: " <> toText path - block = createBlock srcLoc Nothing Nothing - errataSimple (Just header) block Nothing - renderDiagnostic (EmptyDirectory srcLoc path) = do - let header = "vendored-dependencies path has no files and cannot be scanned: " <> toText path - block = createBlock srcLoc Nothing Nothing - errataSimple (Just header) block Nothing - renderDiagnostic (EmptyOrCorruptedArchive srcLoc path) = do - let header = "vendored-dependencies archive is malformed or contains no files: " <> toText path - block = createBlock srcLoc Nothing Nothing - errataSimple (Just header) block Nothing + renderDiagnostic :: LicenseScanErr -> Errata + renderDiagnostic (NoSuccessfulScans srcLoc) = + errataSimple (Just "No native license scans were successful") (createEmptyBlock srcLoc) Nothing + renderDiagnostic (NoLicenseResults srcLoc path) = + errataSimple (Just $ "No license results found after scanning directory: " <> toText path) (createEmptyBlock srcLoc) Nothing + renderDiagnostic (EmptyDirectory srcLoc path) = + errataSimple (Just $ "vendored-dependencies path has no files and cannot be scanned: " <> toText path) (createEmptyBlock srcLoc) Nothing + renderDiagnostic (EmptyOrCorruptedArchive srcLoc path) = + errataSimple (Just $ "vendored-dependencies archive is malformed or contains no files: " <> toText path) (createEmptyBlock srcLoc) Nothing renderDiagnostic (UnsupportedArchive srcLoc path) = case fileExtension path of - Just ext -> do - let header = "fossa-cli does not support archives of type " <> "`" <> toText ext <> "`" <> ": " <> toText path - block = createBlock srcLoc Nothing Nothing - errataSimple (Just header) block Nothing - Nothing -> do - let header = "fossa-cli does not support archives without file extensions: " <> toText path - block = createBlock srcLoc Nothing Nothing - errataSimple (Just header) block Nothing + Just ext -> errataSimple (Just $ "FOSSA CLI does not support archives of type " <> "`" <> toText ext <> "`" <> ": " <> toText path) (createEmptyBlock srcLoc) Nothing + Nothing -> errataSimple (Just $ "FOSSA CLI does not support archives without file extensions: " <> toText path) (createEmptyBlock srcLoc) Nothing newtype ScannableArchive = ScannableArchive {scanFile :: Path Abs File} deriving (Eq, Ord, Show) diff --git a/src/App/Fossa/ManualDeps.hs b/src/App/Fossa/ManualDeps.hs index ff7786a67d..d5bc6c7389 100644 --- a/src/App/Fossa/ManualDeps.hs +++ b/src/App/Fossa/ManualDeps.hs @@ -49,7 +49,7 @@ import Data.Aeson ( ) import Data.Aeson.Extra (TextLike (unTextLike), forbidMembers, neText) import Data.Aeson.Types (Object, Parser, prependFailure) -import Data.Error (SourceLocation, createBlock, getSourceLocation) +import Data.Error (SourceLocation, createEmptyBlock, createErrataWithHeaderOnly, getSourceLocation) import Data.Functor.Extra ((<$$>)) import Data.List.NonEmpty (NonEmpty) import Data.List.NonEmpty qualified as NE @@ -431,24 +431,24 @@ instance FromJSON ReferencedDependency where <$> (obj `neText` "name") <*> pure depType <*> (unTextLike <$$> obj .:? "version") - <* forbidNonRefDepFields obj - <* forbidLinuxFields depType obj - <* forbidEpoch depType obj + <* forbidNonRefDepFields obj + <* forbidLinuxFields depType obj + <* forbidEpoch depType obj ) parseApkOrDebDependency :: Object -> DepType -> Parser ReferencedDependency parseApkOrDebDependency obj depType = LinuxApkDebDep <$> parseLinuxDependency obj depType - <* forbidNonRefDepFields obj - <* forbidEpoch depType obj + <* forbidNonRefDepFields obj + <* forbidEpoch depType obj parseRpmDependency :: Object -> DepType -> Parser ReferencedDependency parseRpmDependency obj depType = LinuxRpmDep <$> parseLinuxDependency obj depType <*> (unTextLike <$$> obj .:? "epoch") - <* forbidNonRefDepFields obj + <* forbidNonRefDepFields obj parseLinuxDependency :: Object -> DepType -> Parser LinuxReferenceDependency parseLinuxDependency obj depType = @@ -515,7 +515,7 @@ instance FromJSON CustomDependency where <*> (obj `neText` "license") <*> obj .:? "metadata" - <* forbidMembers "custom dependencies" ["type", "path", "url"] obj + <* forbidMembers "custom dependencies" ["type", "path", "url"] obj instance FromJSON RemoteDependency where parseJSON = withObject "RemoteDependency" $ \obj -> do @@ -525,7 +525,7 @@ instance FromJSON RemoteDependency where <*> (obj `neText` "url") <*> obj .:? "metadata" - <* forbidMembers "remote dependencies" ["license", "path", "type"] obj + <* forbidMembers "remote dependencies" ["license", "path", "type"] obj validateRemoteDep :: (Has Diagnostics sig m) => RemoteDependency -> Organization -> m RemoteDependency validateRemoteDep r org = @@ -557,10 +557,9 @@ data RemoteDepLengthIsGtThanAllowed | RemoteDepLengthIsGtThanAllowedHelp Int instance ToDiagnostic RemoteDepLengthIsGtThanAllowed where - renderDiagnostic (RemoteDepLengthIsGtThanAllowedMessage srcLoc) = do - let header = "remote-dependency length is exceeds limit" - block = createBlock srcLoc Nothing Nothing - errataSimple (Just header) block Nothing + renderDiagnostic :: RemoteDepLengthIsGtThanAllowed -> Errata + renderDiagnostic (RemoteDepLengthIsGtThanAllowedMessage srcLoc) = + errataSimple (Just "Remote-dependency length is exceeds limit") (createEmptyBlock srcLoc) Nothing renderDiagnostic (RemoteDepLengthIsGtThanAllowedCtx r) = do let header = renderIt $ @@ -572,13 +571,12 @@ instance ToDiagnostic RemoteDepLengthIsGtThanAllowed where , indent 4 . pretty $ "Url: " <> remoteUrl r , indent 4 . pretty $ "Version: " <> remoteVersion r ] - Errata (Just header) [] Nothing + createErrataWithHeaderOnly header where urlRevLength :: Int urlRevLength = Text.length $ Text.intercalate "" [remoteUrl r, remoteVersion r] - renderDiagnostic (RemoteDepLengthIsGtThanAllowedHelp maxLen) = do - let header = "Ensure that the combined length is below: " <> toText maxLen - Errata (Just header) [] Nothing + renderDiagnostic (RemoteDepLengthIsGtThanAllowedHelp maxLen) = + createErrataWithHeaderOnly $ "Ensure that the combined length is below: " <> toText maxLen -- Dependency "metadata" section for both Remote and Custom Dependencies instance FromJSON DependencyMetadata where @@ -588,7 +586,7 @@ instance FromJSON DependencyMetadata where .:? "description" <*> obj .:? "homepage" - <* forbidMembers "metadata" ["url"] obj + <* forbidMembers "metadata" ["url"] obj -- Parse supported dependency types into their respective type or return Nothing. depTypeFromText :: Text -> Maybe DepType diff --git a/src/App/Fossa/PreflightChecks.hs b/src/App/Fossa/PreflightChecks.hs index 0b7a90725e..6e9bbee17e 100644 --- a/src/App/Fossa/PreflightChecks.hs +++ b/src/App/Fossa/PreflightChecks.hs @@ -7,16 +7,17 @@ module App.Fossa.PreflightChecks ( import App.Docs (apiKeyUrl) import Control.Carrier.Debug (ignoreDebug) -import Control.Carrier.Diagnostics (Diagnostics, errCtx) +import Control.Carrier.Diagnostics (Diagnostics, errDoc, errHelp) import Control.Carrier.FossaApiClient (runFossaApiClient) import Control.Carrier.Stack (context) import Control.Effect.Diagnostics (ToDiagnostic, fatalOnIOException) import Control.Effect.FossaApiClient (FossaApiClient, getOrganization) import Control.Effect.Lift (Has, Lift, sendIO) import Control.Monad (void) +import Data.Error (createErrataWithHeaderOnly) import Data.Text.IO qualified as TIO import Diag.Diagnostic (ToDiagnostic (..)) -import Effect.Logger (pretty, vsep) +import Errata (Errata) import Fossa.API.Types (ApiOpts) import Path ( File, @@ -49,15 +50,13 @@ preflightChecks = context "preflight-checks" $ do sendIO $ removeFile (tmpDir preflightCheckFileName) -- Check for valid API Key and if user can connect to fossa app - void $ errCtx InvalidApiKeyErr getOrganization + void $ errHelp InvalidApiKeyErr $ errDoc apiKeyUrl getOrganization preflightCheckFileName :: Path Rel File preflightCheckFileName = $(mkRelFile "preflight-check.txt") data InvalidApiKeyErr = InvalidApiKeyErr instance ToDiagnostic InvalidApiKeyErr where + renderDiagnostic :: InvalidApiKeyErr -> Errata renderDiagnostic InvalidApiKeyErr = - vsep - [ "Ensure that you are using a valid FOSSA_API_KEY." - , "Refer to " <> pretty apiKeyUrl <> " for guidance on how to generate and retrieve your API key." - ] + createErrataWithHeaderOnly "Ensure that you are using a valid FOSSA_API_KEY. Refer to the provided documentation for guidance on how to generate and retrieve your API key." diff --git a/src/App/Support.hs b/src/App/Support.hs index a5c24a91f8..3d845e2b8f 100644 --- a/src/App/Support.hs +++ b/src/App/Support.hs @@ -64,7 +64,7 @@ requestDebugBundle :: Doc ann requestDebugBundle = vsep [ "In your bug report, please include FOSSA's debug bundle file: fossa.debug.json.gz." - , "You can generate debug bundle by using `--debug` flag, for example: fossa analyze --debug" + , "You can generate debug bundle by using `--debug` flag, for example: `fossa analyze --debug`" ] -- | For networking errors, explain that networking errors are often transient or caused by local configuration. diff --git a/src/Container/Docker/OciManifest.hs b/src/Container/Docker/OciManifest.hs index 7033484420..7e0471d312 100644 --- a/src/Container/Docker/OciManifest.hs +++ b/src/Container/Docker/OciManifest.hs @@ -25,7 +25,7 @@ import Container.Docker.SourceParser ( ) import Control.Effect.Diagnostics (ToDiagnostic, renderDiagnostic) import Data.Aeson (FromJSON (parseJSON), withObject, withText, (.:)) -import Data.Error (SourceLocation, createBlock) +import Data.Error (SourceLocation, createEmptyBlock) import Data.List.NonEmpty ((<|)) import Data.List.NonEmpty qualified as NonEmpty import Data.String.Conversion (toString) @@ -33,6 +33,7 @@ import Data.Text (Text) import Data.Text qualified as Text import Effect.Logger (renderIt, vsep) import Errata (errataSimple) +import Errata.Types (Errata) import Prettyprinter (indent, line) supportedManifestKinds :: [Text] @@ -182,9 +183,9 @@ data NotSupportedManifestFmt = NotSupportedManifestFmt SourceLocation Text RegistryImageSource instance ToDiagnostic NotSupportedManifestFmt where + renderDiagnostic :: NotSupportedManifestFmt -> Errata renderDiagnostic (NotSupportedManifestFmt srcLoc fmt imgSrc) = do - let header = "Manifest format is not supported: " <> fmt - body = + let body = renderIt $ vsep [ "Workaround:" <> line @@ -195,5 +196,4 @@ instance ToDiagnostic NotSupportedManifestFmt where , suggestDockerExport imgSrc ] ] - block = createBlock srcLoc Nothing Nothing - errataSimple (Just header) block (Just body) + errataSimple (Just $ "Manifest format is not supported: " <> fmt) (createEmptyBlock srcLoc) (Just body) diff --git a/src/Container/Errors.hs b/src/Container/Errors.hs index 50c0c42f94..b45ffca31a 100644 --- a/src/Container/Errors.hs +++ b/src/Container/Errors.hs @@ -6,7 +6,7 @@ module Container.Errors ( import App.Support (supportUrl) import Codec.Archive.Tar qualified as Tar import Control.Exception (Exception) -import Data.Error (SourceLocation, createBlock) +import Data.Error (SourceLocation, createEmptyBlock, createErrataWithHeaderOnly) import Data.List.NonEmpty (NonEmpty) import Data.String.Conversion (toText) import Diag.Diagnostic (ToDiagnostic (renderDiagnostic)) @@ -39,16 +39,18 @@ instance Show ContainerImgParsingError where instance Exception ContainerImgParsingError instance ToDiagnostic ContainerImgParsingError where - renderDiagnostic e = Errata (Just (toText $ show e)) [] Nothing + renderDiagnostic :: ContainerImgParsingError -> Errata + renderDiagnostic e = createErrataWithHeaderOnly . toText $ show e instance ToDiagnostic (NonEmpty ContainerImgParsingError) where - renderDiagnostic e = Errata (Just (toText $ show e)) [] Nothing + renderDiagnostic :: NonEmpty ContainerImgParsingError -> Errata + renderDiagnostic e = createErrataWithHeaderOnly . toText $ show e newtype EndpointDoesNotSupportNativeContainerScan = EndpointDoesNotSupportNativeContainerScan SourceLocation instance ToDiagnostic EndpointDoesNotSupportNativeContainerScan where + renderDiagnostic :: EndpointDoesNotSupportNativeContainerScan -> Errata renderDiagnostic (EndpointDoesNotSupportNativeContainerScan srcLoc) = do - let header = "Provided endpoint does not support native container scans" - body = + let body = renderIt $ vsep [ "Container scanning with new scanner is not supported for your FOSSA endpoint." @@ -57,5 +59,4 @@ instance ToDiagnostic EndpointDoesNotSupportNativeContainerScan where , "" , "Please contact FOSSA support at " <> pretty supportUrl <> " for more assistance." ] - block = createBlock srcLoc Nothing Nothing - errataSimple (Just header) block (Just body) + errataSimple (Just "Provided endpoint does not support native container scans") (createEmptyBlock srcLoc) (Just body) diff --git a/src/Control/Carrier/FossaApiClient/Internal/FossaAPIV1.hs b/src/Control/Carrier/FossaApiClient/Internal/FossaAPIV1.hs index 39493d36f7..c15e72cc5a 100644 --- a/src/Control/Carrier/FossaApiClient/Internal/FossaAPIV1.hs +++ b/src/Control/Carrier/FossaApiClient/Internal/FossaAPIV1.hs @@ -97,7 +97,7 @@ import Data.ByteString qualified as BS import Data.ByteString.Char8 qualified as C import Data.ByteString.Lazy (ByteString) import Data.Data (Proxy (Proxy)) -import Data.Error (SourceLocation, createBlock, createBody, getSourceLocation) +import Data.Error (SourceLocation, createBody, createEmptyBlock, getSourceLocation) import Data.List.NonEmpty (NonEmpty) import Data.List.NonEmpty qualified as NE import Data.Map (Map) @@ -316,6 +316,7 @@ data FossaError deriving (Show) instance ToDiagnostic FossaError where + renderDiagnostic :: FossaError -> Errata renderDiagnostic = \case InternalException exception -> do let header = "A socket-level error occurred when accessing the FOSSA API" @@ -334,9 +335,9 @@ instance ToDiagnostic FossaError where let header = "An error occurred when deserializing a response from the FOSSA API:" <> toText err Errata (Just header) [] Nothing BackendPublicFacingError pfe -> do - let header = "The FOSSA endpoint reported an error: " <> fpeMessage pfe + let header = fpeMessage pfe content = "Error UUID from API: " <> fpeUuid pfe - support = (renderIt reportDefectMsg) <> "Please include the error UUID in your request." + support = (renderIt reportDefectMsg) <> ". Please include the error UUID in your request." body = createBody (Just content) Nothing (Just support) Nothing Nothing Errata (Just header) [] (Just body) InvalidUrlError url reason -> do @@ -594,12 +595,12 @@ uploadNativeContainerScan apiOpts ProjectRevision{..} metadata scan = fossaReq $ "locator" =: locator <> "cliVersion" - =: cliVersion + =: cliVersion <> "managedBuild" - =: True + =: True <> maybe mempty ("branch" =:) projectBranch <> "scanType" - =: ("native" :: Text) + =: ("native" :: Text) <> mkMetadataOpts metadata projectName resp <- req POST (containerUploadUrl baseUrl) (ReqBodyJson scan) jsonResponse (baseOpts <> opts) pure $ responseBody resp @@ -640,9 +641,9 @@ uploadAnalysis apiOpts ProjectRevision{..} metadata sourceUnits = fossaReq $ do "locator" =: renderLocator (Locator "custom" projectName (Just projectRevision)) <> "cliVersion" - =: cliVersion + =: cliVersion <> "managedBuild" - =: True + =: True <> mkMetadataOpts metadata projectName -- Don't include branch if it doesn't exist, core may not handle empty string properly. <> maybe mempty ("branch" =:) projectBranch @@ -663,11 +664,11 @@ uploadAnalysisWithFirstPartyLicenses apiOpts ProjectRevision{..} metadata fullFi "locator" =: renderLocator (Locator "custom" projectName (Just projectRevision)) <> "cliVersion" - =: cliVersion + =: cliVersion <> "managedBuild" - =: True + =: True <> "cliLicenseScanType" - =: (fullFileUploadsToCliLicenseScanType fullFileUploads) + =: (fullFileUploadsToCliLicenseScanType fullFileUploads) <> mkMetadataOpts metadata projectName -- Don't include branch if it doesn't exist, core may not handle empty string properly. <> maybe mempty ("branch" =:) projectBranch @@ -1084,11 +1085,9 @@ getIssues apiOpts ProjectRevision{..} diffRevision = fossaReq $ do newtype EndpointDoesNotSupportIssueDiffing = EndpointDoesNotSupportIssueDiffing SourceLocation instance ToDiagnostic EndpointDoesNotSupportIssueDiffing where - renderDiagnostic (EndpointDoesNotSupportIssueDiffing srcLoc) = do - let header = "Provided endpoint does not support issue diffing" - block = createBlock srcLoc Nothing Nothing - body = "If this instance of FOSSA is on-premise, it likely needs to be updated" - errataSimple (Just header) block (Just body) + renderDiagnostic :: EndpointDoesNotSupportIssueDiffing -> Errata + renderDiagnostic (EndpointDoesNotSupportIssueDiffing srcLoc) = + errataSimple (Just "Provided endpoint does not support issue diffing") (createEmptyBlock srcLoc) (Just "If this instance of FOSSA is on-premise, it likely needs to be updated") --------------- @@ -1120,11 +1119,11 @@ getAttributionJson apiOpts ProjectRevision{..} = fossaReq $ do opts = baseOpts <> "includeDeepDependencies" - =: True + =: True <> "includeHashAndVersionData" - =: True + =: True <> "dependencyInfoOptions[]" - =: packageDownloadUrl + =: packageDownloadUrl orgId <- organizationId <$> getOrganization apiOpts response <- req GET (attributionEndpoint baseUrl orgId (Locator "custom" projectName (Just projectRevision)) ReportJson) NoReqBody jsonResponse opts pure (responseBody response) diff --git a/src/Data/Error.hs b/src/Data/Error.hs index cb7a2582b9..009a264cfe 100644 --- a/src/Data/Error.hs +++ b/src/Data/Error.hs @@ -5,9 +5,9 @@ module Data.Error ( SourceLocation (..), DiagnosticStyle (..), getSourceLocation, - createBlock, + createEmptyBlock, createBody, - createError, + createErrataWithHeaderOnly, renderErrataStack, applyDiagnosticStyle, combineErrataHeaders, @@ -31,7 +31,7 @@ import Prettyprinter.Render.Terminal ( ) -- SourceLocation captures the file path, line, and col at a given call site --- SourceLocation will be used in conjuction with our errors +-- SourceLocation will be used in conjunction with our errors data SourceLocation = SourceLocation { filePath :: FilePath , line :: Int @@ -45,21 +45,22 @@ getSourceLocation = case getCallStack ?callStack of (_, loc) : _ -> SourceLocation (srcLocFile loc) (srcLocStartLine loc) (srcLocStartCol loc) _ -> SourceLocation "Unknown" 0 0 -createError :: Maybe Text -> [Block] -> Maybe Text -> Errata -createError = Errata +createErrataWithHeaderOnly :: Text -> Errata +createErrataWithHeaderOnly header = Errata (Just header) [] Nothing -- wrapper to create an Errata block -createBlock :: SourceLocation -> Maybe Text -> Maybe Text -> Block -createBlock SourceLocation{..} maybeHeader = +createEmptyBlock :: SourceLocation -> Block +createEmptyBlock SourceLocation{..} = Block fancyStyle (filePath, line, col) - maybeHeader + Nothing [] + Nothing createBody :: Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Text createBody maybeContent maybeDocumentation maybeSupport maybeHelp maybeContext = do - let content = fromMaybe "" maybeContent <> "\n" + let content = fromMaybe "" maybeContent documentation = maybe "" (buildMessageWithDiagnosticStyle DocumentationStyle) maybeDocumentation support = maybe "" (buildMessageWithDiagnosticStyle SupportStyle) maybeSupport help = maybe "" (buildMessageWithDiagnosticStyle HelpStyle) maybeHelp @@ -90,7 +91,7 @@ applyDiagnosticStyle style Errata{..} = case errataHeader of _ -> Errata errataHeader errataBlocks errataBody buildMessageWithDiagnosticStyle :: DiagnosticStyle -> Text -> Text -buildMessageWithDiagnosticStyle style msg = toText style <> msg <> "\n" +buildMessageWithDiagnosticStyle style msg = "\n" <> toText style <> msg renderErrataStack :: [Errata] -> Doc AnsiStyle renderErrataStack = @@ -104,7 +105,7 @@ The listed Err types are used to provide contextual details about a given error. In order to attach these err details to an error, we need extract their contents, which is currently stored in the Header field of the Errata object. This function takes a list of Errata objects, extracts the contents from the header of each Errata, -and joins them together with a new line sperator. +and joins them together with a new line seperator. We are choosing not to use the `renderErrataStack` function because it will display the errors with an extra new line seperator between each Errata object. diff --git a/src/Diag/Result.hs b/src/Diag/Result.hs index 3e98d59beb..013325086f 100644 --- a/src/Diag/Result.hs +++ b/src/Diag/Result.hs @@ -298,7 +298,7 @@ renderErrs es errDetails tracebackStyle diagStyle = do applyToTopOfStack f (x : xs) = f x : xs addErrDetails :: (Doc AnsiStyle, Doc AnsiStyle) -> (Doc AnsiStyle, Doc AnsiStyle) - addErrDetails (err, traceback) = (err <> newlinePreceding errDetails, traceback) + addErrDetails (err, traceback) = (err <> (newlinePreceding . newlineTrailing $ errDetails), traceback) ---------- Rendering individual Result components: ErrCtx, EmittedWarn, SomeWarn, ErrWithStack diff --git a/src/Effect/Exec.hs b/src/Effect/Exec.hs index 87fd1f45b1..da72d2d732 100644 --- a/src/Effect/Exec.hs +++ b/src/Effect/Exec.hs @@ -192,7 +192,7 @@ renderCmdFailure :: CmdFailure -> Errata renderCmdFailure CmdFailure{..} = if isCmdNotAvailable then do - let header = "Could not find executable: `" <> cmdName cmdFailureCmd + let header = "Could not find executable: `" <> cmdName cmdFailureCmd <> "`" help = "Please ensure `" <> cmdName cmdFailureCmd <> "` exists in PATH prior to running fossa" body = createBody Nothing Nothing (Just $ renderIt reportDefectMsg) (Just help) Nothing Errata (Just header) [] (Just body) @@ -279,6 +279,7 @@ renderCmdFailure CmdFailure{..} = ] instance ToDiagnostic ExecErr where + renderDiagnostic :: ExecErr -> Errata renderDiagnostic = \case ExecEnvNotSupported env -> do let header = "Exec is not supported in: " <> env @@ -437,9 +438,10 @@ selectBestCmd workdir CandidateAnalysisCommands{..} = selectBestCmd' (NE.toList data CandidateCommandFailed = CandidateCommandFailed {failedCommand :: Text, failedArgs :: [Text]} instance ToDiagnostic CandidateCommandFailed where + renderDiagnostic :: CandidateCommandFailed -> Errata renderDiagnostic CandidateCommandFailed{..} = do - let header = "Command: " <> failedCommand <> " not suitable" - body = "Running with args: " <> mconcat failedArgs <> " resulted in a non-zero exit code" + let header = "Command: " <> "`" <> failedCommand <> "` not suitable" + body = "Running with args: " <> "`" <> mconcat failedArgs <> "` resulted in a non-zero exit code" Errata (Just header) [] (Just body) argFromPath :: Path a b -> Text diff --git a/src/Strategy/Conan/Enrich.hs b/src/Strategy/Conan/Enrich.hs index dfee31232c..c4f201700c 100644 --- a/src/Strategy/Conan/Enrich.hs +++ b/src/Strategy/Conan/Enrich.hs @@ -16,7 +16,7 @@ import Control.Effect.FossaApiClient (FossaApiClient) import Control.Effect.StickyLogger (StickyLogger) import Control.Monad (unless) import Data.Either (partitionEithers) -import Data.Error (SourceLocation, createBlock, getSourceLocation) +import Data.Error (SourceLocation, createEmptyBlock, getSourceLocation) import Data.List (find) import Data.List.NonEmpty (NonEmpty, nonEmpty, toList) import Data.List.NonEmpty qualified as NE @@ -31,7 +31,7 @@ import Diag.Diagnostic (ToDiagnostic (renderDiagnostic)) import Effect.Exec (Exec) import Effect.Logger (Logger, indent, pretty, renderIt, vsep) import Effect.ReadFS (ReadFS) -import Errata (errataSimple) +import Errata (Errata, errataSimple) import Graphing (Graphing, gmap, vertexList) import Path (Abs, Dir, Path) import Srclib.Converter (fetcherToDepType, toLocator, verConstraintToRevision) @@ -206,14 +206,13 @@ enrichSupportMessage = "This is likely a defect, please contact FOSSA support at data FailedToTransformConanDependency = FailedToTransformConanDependency SourceLocation [Dependency] instance ToDiagnostic FailedToTransformConanDependency where + renderDiagnostic :: FailedToTransformConanDependency -> Errata renderDiagnostic (FailedToTransformConanDependency srcLoc deps) = do - let header = "Could not transform analyzed conan dependency to vendored dependency" - body = + let body = renderIt $ vsep [indent 2 $ vsep $ map (pretty . renderDep) deps] - block = createBlock srcLoc Nothing Nothing - errataSimple (Just header) block (Just body) + errataSimple (Just "Could not transform analyzed conan dependency to vendored dependency") (createEmptyBlock srcLoc) (Just body) where renderDep :: Dependency -> Text renderDep d = @@ -223,24 +222,22 @@ instance ToDiagnostic FailedToTransformConanDependency where data FailedToTransformLocators = FailedToTransformLocators SourceLocation [Locator] instance ToDiagnostic FailedToTransformLocators where + renderDiagnostic :: FailedToTransformLocators -> Errata renderDiagnostic (FailedToTransformLocators srcLoc locs) = do - let header = "Could not transform vendored dependency to archive dependency" - body = + let body = renderIt $ vsep [vsep $ map (pretty . toText) locs] - block = createBlock srcLoc Nothing Nothing - errataSimple (Just header) block (Just body) + errataSimple (Just "Could not transform vendored dependency to archive dependency") (createEmptyBlock srcLoc) (Just body) data UnableToFindTwinOfArchiveDep = UnableToFindTwinOfArchiveDep SourceLocation LonelyDeps instance ToDiagnostic UnableToFindTwinOfArchiveDep where + renderDiagnostic :: UnableToFindTwinOfArchiveDep -> Errata renderDiagnostic (UnableToFindTwinOfArchiveDep srcLoc (LonelyDeps deps)) = do - let header = "Could not identify conan dependency" - body = + let body = renderIt $ vsep [ "We could not identify conan dependency for following dependencies:" , indent 2 $ vsep $ map (pretty . toText . toLocator) deps ] - block = createBlock srcLoc Nothing Nothing - errataSimple (Just header) block (Just body) + errataSimple (Just "Could not identify conan dependency") (createEmptyBlock srcLoc) (Just body) diff --git a/src/Strategy/Go/GoListPackages.hs b/src/Strategy/Go/GoListPackages.hs index 65c80d7508..964d4c9906 100644 --- a/src/Strategy/Go/GoListPackages.hs +++ b/src/Strategy/Go/GoListPackages.hs @@ -23,7 +23,7 @@ import Control.Monad (unless, void, when, (>=>)) import Data.Aeson (FromJSON (parseJSON), Value, withObject, (.!=), (.:), (.:?)) import Data.Aeson.Encode.Pretty (encodePretty) import Data.Aeson.Types (formatError) -import Data.Error (SourceLocation, createBlock, getSourceLocation) +import Data.Error (SourceLocation, createEmptyBlock, getSourceLocation) import Data.Foldable (traverse_) import Data.HashMap.Strict qualified as HashMap import Data.HashSet qualified as HashSet @@ -265,19 +265,17 @@ data MissingModuleErr = MissingModuleErr SourceLocation ImportPath deriving (Eq, Show) instance ToDiagnostic MissingModuleErr where - renderDiagnostic (MissingModuleErr srcLoc (ImportPath i)) = do - let header = "Could not find module for: " <> i - block = createBlock srcLoc Nothing Nothing - errataSimple (Just header) block Nothing + renderDiagnostic :: MissingModuleErr -> Errata + renderDiagnostic (MissingModuleErr srcLoc (ImportPath i)) = + errataSimple (Just $ "Could not find module for: " <> i) (createEmptyBlock srcLoc) Nothing data MissingMainModuleErr = MissingMainModuleErr SourceLocation (Path Abs Dir) deriving (Eq, Show) instance ToDiagnostic MissingMainModuleErr where - renderDiagnostic (MissingMainModuleErr srcLoc path) = do - let header = "No main module for project: " <> toText path - block = createBlock srcLoc Nothing Nothing - errataSimple (Just header) block Nothing + renderDiagnostic :: MissingMainModuleErr -> Errata + renderDiagnostic (MissingMainModuleErr srcLoc path) = + errataSimple (Just $ "No main module for project: " <> toText path) (createEmptyBlock srcLoc) Nothing -- | A module is a path dep if its import path starts with './' or '../'. -- Checking for ./ or ../ is the documented way of detecting path deps. diff --git a/src/Strategy/Scala/Errors.hs b/src/Strategy/Scala/Errors.hs index bc2fcf7c78..f5899e67a5 100644 --- a/src/Strategy/Scala/Errors.hs +++ b/src/Strategy/Scala/Errors.hs @@ -42,7 +42,7 @@ instance ToDiagnostic MissingFullDependencyPlugin where let header = "Could not perform dynamic sbt analysis via `sbt dependencyBrowseTreeHTML`" Errata (Just header) [] Nothing renderDiagnostic MissingFullDependencyPluginHelp = do - let header = "Ensure you can run `sbt dependencyBrowseTreeHTML`. Install the sbt plugin if you are not able to run the aforementationed command." + let header = "Ensure you can run `sbt dependencyBrowseTreeHTML`. Install the sbt plugin if you are not able to run the command." Errata (Just header) [] Nothing newtype FailedToListProjects = FailedToListProjects (Path Abs Dir) From 67057fffad266f301bd35e0667a958d3537be42d Mon Sep 17 00:00:00 2001 From: Jeffrey Huynh Date: Fri, 9 Feb 2024 15:44:55 -0800 Subject: [PATCH 15/17] spelling --- src/Data/Error.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Data/Error.hs b/src/Data/Error.hs index de4b0246aa..8c0a1925f8 100644 --- a/src/Data/Error.hs +++ b/src/Data/Error.hs @@ -106,9 +106,9 @@ The listed Err types are used to provide contextual details about a given error. In order to attach these err details to an error, we need extract their contents, which is currently stored in the Header field of the Errata object. This function takes a list of Errata objects, extracts the contents from the header of each Errata, -and joins them together with a new line seperator. +and joins them together with a new line separator. -We are choosing not to use the `renderErrataStack` function because it will display the errors with an extra new line seperator +We are choosing not to use the `renderErrataStack` function because it will display the errors with an extra new line separator between each Errata object. e.g. Help: Message 1 From 263fc02f615f6d33013a42361f9fca65056fde45 Mon Sep 17 00:00:00 2001 From: Jeffrey Huynh Date: Fri, 9 Feb 2024 16:39:11 -0800 Subject: [PATCH 16/17] remove ansi color codes from scan summary file --- spectrometer.cabal | 1 + src/App/Fossa/Analyze/ScanSummary.hs | 4 +++- 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/spectrometer.cabal b/spectrometer.cabal index ff956c0a41..cfb2e79b98 100644 --- a/spectrometer.cabal +++ b/spectrometer.cabal @@ -139,6 +139,7 @@ common deps , semver ^>=0.4.0.1 , stm ^>=2.5.0 , stm-chans ^>=3.0.0 + , strip-ansi-escape ^>=0.1 , tar ^>=0.7.0.0 , template-haskell , text ^>=2.0.0 diff --git a/src/App/Fossa/Analyze/ScanSummary.hs b/src/App/Fossa/Analyze/ScanSummary.hs index 3b5d16a9bb..8dc7dfb109 100644 --- a/src/App/Fossa/Analyze/ScanSummary.hs +++ b/src/App/Fossa/Analyze/ScanSummary.hs @@ -28,6 +28,7 @@ import Data.Functor.Extra ((<$$>)) import Data.List (sort) import Data.Maybe (catMaybes, fromMaybe, mapMaybe, maybeToList) import Data.Monoid.Extra (isMempty) +import Data.String.AnsiEscapeCodes.Strip.Text (stripAnsiEscapeCodes) import Data.String.Conversion (showText, toText) import Data.Text (Text) import Data.Text.IO qualified as TIO @@ -371,7 +372,8 @@ countWarnings ws = dumpResultLogsToTempFile :: (Has (Lift IO) sig m) => Config.AnalyzeConfig -> Data.Text.Text -> AnalysisScanResult -> m (Path Abs File) dumpResultLogsToTempFile cfg endpointVersion (AnalysisScanResult projects vsi binary manualDeps dynamicLinkingDeps lernieResults) = do let doc = - renderStrict + stripAnsiEscapeCodes + . renderStrict . layoutPretty defaultLayoutOptions . unAnnotate . mconcat From 6f8095196c40f6ea6a408701c171b2c21fbdcb32 Mon Sep 17 00:00:00 2001 From: Jeffrey Huynh Date: Mon, 12 Feb 2024 14:05:05 -0800 Subject: [PATCH 17/17] lint --- src/App/Fossa/Reachability/Jar.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/App/Fossa/Reachability/Jar.hs b/src/App/Fossa/Reachability/Jar.hs index cec16aad4c..723171cd39 100644 --- a/src/App/Fossa/Reachability/Jar.hs +++ b/src/App/Fossa/Reachability/Jar.hs @@ -71,7 +71,7 @@ newtype FailedToParseJar = FailedToParseJar (Path Abs File) instance ToDiagnostic FailedToParseJar where renderDiagnostic :: FailedToParseJar -> Errata - renderDiagnostic (FailedToParseJar jar) = + renderDiagnostic (FailedToParseJar jar) = createErrataWithHeaderOnly $ "Could not read from jar, so skipping: " <> toText (show jar) -- True if jar exist, and is not likely test jar, otherwise False