diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 58fe11d63..b4d198ad4 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -86,6 +86,7 @@ jobs: run: | mkdir vendor touch vendor/wiggins + touch vendor/syft - name: Build run: | diff --git a/spectrometer.cabal b/spectrometer.cabal index e75aee4b1..7ea22d886 100644 --- a/spectrometer.cabal +++ b/spectrometer.cabal @@ -85,6 +85,10 @@ library App.Fossa.Analyze.GraphBuilder App.Fossa.Analyze.GraphMangler App.Fossa.Analyze.Project + App.Fossa.Container + App.Fossa.Container.Analyze + App.Fossa.Container.Test + App.Fossa.EmbeddedBinary App.Fossa.FossaAPIV1 App.Fossa.ListTargets App.Fossa.Main @@ -92,7 +96,6 @@ library App.Fossa.Report App.Fossa.Report.Attribution App.Fossa.Test - App.Fossa.VPS.EmbeddedBinary App.Fossa.VPS.NinjaGraph App.Fossa.VPS.Report App.Fossa.VPS.Scan @@ -218,7 +221,6 @@ test-suite unit-tests -- cabal-fmt: expand test other-modules: - App.Fossa.FossaAPIV1Spec App.Fossa.Report.AttributionSpec App.Fossa.VPS.NinjaGraphSpec Cargo.MetadataSpec @@ -232,6 +234,7 @@ test-suite unit-tests Erlang.ConfigParserSpec Erlang.Rebar3TreeSpec Extra.TextSpec + Fossa.API.TypesSpec Go.GlideLockSpec Go.GoListSpec Go.GomodSpec diff --git a/src/App/Fossa/API/BuildWait.hs b/src/App/Fossa/API/BuildWait.hs index d14406baa..9709afbab 100644 --- a/src/App/Fossa/API/BuildWait.hs +++ b/src/App/Fossa/API/BuildWait.hs @@ -19,7 +19,7 @@ import Control.Effect.Lift (Lift, sendIO) import Data.Functor (($>)) import Data.Text (Text) import Effect.Logger -import Fossa.API.Types (ApiOpts) +import Fossa.API.Types (ApiOpts, Issues (..)) pollDelaySeconds :: Int pollDelaySeconds = 8 @@ -53,10 +53,10 @@ waitForIssues :: (Has Diagnostics sig m, Has (Lift IO) sig m, Has Logger sig m) => ApiOpts -> ProjectRevision -> - m Fossa.Issues + m Issues waitForIssues apiOpts revision = do issues <- Fossa.getIssues apiOpts revision - case Fossa.issuesStatus issues of + case issuesStatus issues of "WAITING" -> do sendIO $ threadDelay (pollDelaySeconds * 1_000_000) waitForIssues apiOpts revision diff --git a/src/App/Fossa/Analyze.hs b/src/App/Fossa/Analyze.hs index b419e59b2..0397cc439 100644 --- a/src/App/Fossa/Analyze.hs +++ b/src/App/Fossa/Analyze.hs @@ -8,6 +8,7 @@ module App.Fossa.Analyze , ScanDestination(..) , UnpackArchives(..) , discoverFuncs + , fossaProjectUrl ) where import App.Fossa.Analyze.GraphMangler (graphingToGraph) diff --git a/src/App/Fossa/Container.hs b/src/App/Fossa/Container.hs new file mode 100644 index 000000000..247b37639 --- /dev/null +++ b/src/App/Fossa/Container.hs @@ -0,0 +1,208 @@ +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeApplications #-} + +module App.Fossa.Container + ( ImageText (..), + imageTextArg, + Locator (..), + SyftResponse (..), + ResponseArtifact (..), + ResponseSource (..), + ResponseDistro (..), + SourceTarget (..), + ContainerScan (..), + ContainerImage (..), + ContainerArtifact (..), + runSyft, + toContainerScan, + extractRevision, + ) +where + +import App.Fossa.EmbeddedBinary (BinaryPaths, toExecutablePath, withSyftBinary) +import App.Types (ProjectRevision (..), OverrideProject (..)) +import Control.Effect.Diagnostics hiding (fromMaybe) +import Control.Effect.Lift (Lift) +import Control.Monad.IO.Class +import Data.Aeson +import qualified Data.Map.Lazy as LMap +import Data.Map.Strict (Map) +import Data.Maybe (listToMaybe, fromMaybe) +import Data.Text (Text, pack) +import Data.Text.Extra (breakOnAndRemove) +import Effect.Exec (AllowErr (Never), Command (..), execJson, runExecIO) +import Options.Applicative (Parser, argument, help, metavar, str) +import Path + +newtype ImageText = ImageText {unImageText :: Text} deriving (Show, Eq, Ord) + +imageTextArg :: Parser ImageText +imageTextArg = ImageText . pack <$> argument str (metavar "IMAGE" <> help "The image to scan") + +newtype Locator = Locator {unLocator :: Text} deriving (Eq, Ord, Show) + +-- | The output of the syft binary +data SyftResponse + = SyftResponse + { responseArtifacts :: [ResponseArtifact], + responseSource :: ResponseSource, + responseDistro :: ResponseDistro + } + +instance FromJSON SyftResponse where + parseJSON = withObject "SyftResponse" $ \obj -> + SyftResponse <$> obj .: "artifacts" + <*> obj .: "source" + <*> obj .: "distro" + +data ResponseArtifact + = ResponseArtifact + { artifactName :: Text, + artifactVersion :: Text, + artifactType :: Text, + artifactPkgUrl :: Text, + artifactMetadataType :: Text, + artifactMetadata :: Map Text Value + } + +instance FromJSON ResponseArtifact where + parseJSON = withObject "ResponseArtifact" $ \obj -> + ResponseArtifact <$> obj .: "name" + <*> obj .: "version" + <*> obj .: "type" + <*> obj .: "purl" + <*> obj .: "metadataType" + -- We delete "files" as early as possible, which reduces + -- the size by over 95% in many cases. + -- We use Lazy delete to avoid evaluating the innards of + -- the field, since Aeson will try to avoid evaluating it + -- as well. + <*> (LMap.delete "files" <$> obj .: "metadata") + +newtype ResponseSource + = ResponseSource + {sourceTarget :: SourceTarget} + +instance FromJSON ResponseSource where + parseJSON = withObject "ResponseSource" $ \obj -> + ResponseSource <$> obj .: "target" + +data ResponseDistro + = ResponseDistro + { distroName :: Text, + distroVersion :: Text + } + +instance FromJSON ResponseDistro where + parseJSON = withObject "ResponseDistro" $ \obj -> + ResponseDistro <$> obj .: "name" + <*> obj .: "version" + +data SourceTarget + = SourceTarget + { targetDigest :: Text, + targetTags :: [Text] + } + +instance FromJSON SourceTarget where + parseJSON = withObject "SourceTarget" $ \obj -> + SourceTarget <$> obj .: "digest" + <*> obj .: "tags" + +-- | The reorganized output of syft into a slightly different format +data ContainerScan + = ContainerScan + { imageData :: ContainerImage, + imageTag :: Text, + imageDigest :: Text + } + +instance ToJSON ContainerScan where + toJSON scan = object ["image" .= imageData scan] + +data ContainerImage + = ContainerImage + { imageArtifacts :: [ContainerArtifact], + imageOs :: Text, + imageOsRelease :: Text + } + +instance ToJSON ContainerImage where + toJSON ContainerImage {..} = + object + [ "os" .= imageOs, + "osRelease" .= imageOsRelease, + "artifacts" .= imageArtifacts + ] + +data ContainerArtifact + = ContainerArtifact + { conArtifactName :: Text, + conArtifactVersion :: Text, + conArtifactType :: Text, + conArtifactPkgUrl :: Text, + conArtifactMetadataType :: Text, + conArtifactMetadata :: Map Text Value + } + +instance ToJSON ContainerArtifact where + toJSON ContainerArtifact {..} = + object + [ "name" .= conArtifactName, + "fullVersion" .= conArtifactVersion, + "type" .= conArtifactType, + "purl" .= conArtifactPkgUrl, + "metadataType" .= conArtifactMetadataType, + "metadata" .= LMap.delete "files" conArtifactMetadata + ] + +extractRevision :: OverrideProject -> ContainerScan -> ProjectRevision +extractRevision OverrideProject {..} ContainerScan {..} = ProjectRevision name revision Nothing + where + name = fromMaybe imageTag overrideName + revision = fromMaybe imageDigest overrideRevision + + +toContainerScan :: Has Diagnostics sig m => SyftResponse -> m ContainerScan +toContainerScan SyftResponse {..} = do + let newArts = map convertArtifact responseArtifacts + image = ContainerImage newArts (distroName responseDistro) (distroVersion responseDistro) + target = sourceTarget responseSource + tag <- extractTag $ targetTags target + pure . ContainerScan image tag $ targetDigest target + +convertArtifact :: ResponseArtifact -> ContainerArtifact +convertArtifact ResponseArtifact {..} = + ContainerArtifact + { conArtifactName = artifactName, + conArtifactVersion = artifactVersion, + conArtifactType = artifactType, + conArtifactPkgUrl = artifactPkgUrl, + conArtifactMetadataType = artifactMetadataType, + conArtifactMetadata = artifactMetadata + } + +extractTag :: Has Diagnostics sig m => [Text] -> m Text +extractTag tags = do + firstTag <- fromMaybeText "No image tags found" $ listToMaybe tags + tagTuple <- fromMaybeText "Image was not in the format name:tag" $ breakOnAndRemove ":" firstTag + pure $ fst tagTuple + +runSyft :: + ( Has Diagnostics sig m, + Has (Lift IO) sig m, + MonadIO m + ) => + ImageText -> + m SyftResponse +runSyft image = runExecIO . withSyftBinary $ \syftBin -> do + execJson @SyftResponse [reldir|.|] $ syftCommand syftBin image + +syftCommand :: BinaryPaths -> ImageText -> Command +syftCommand bin (ImageText image) = + Command + { cmdName = pack . toFilePath $ toExecutablePath bin, + cmdArgs = ["-o", "json", image], + cmdAllowErr = Never + } diff --git a/src/App/Fossa/Container/Analyze.hs b/src/App/Fossa/Container/Analyze.hs new file mode 100644 index 000000000..fb9d2575c --- /dev/null +++ b/src/App/Fossa/Container/Analyze.hs @@ -0,0 +1,50 @@ + +module App.Fossa.Container.Analyze + ( analyzeMain, + ) +where + +import App.Fossa.Analyze (ScanDestination (..), fossaProjectUrl) +import App.Fossa.Container (ImageText (..), runSyft, toContainerScan, extractRevision) +import App.Fossa.FossaAPIV1 (uploadContainerScan) +import App.Types (OverrideProject (..), ProjectRevision (..)) +import Control.Carrier.Diagnostics +import Control.Effect.Lift (Lift) +import Control.Monad.IO.Class (MonadIO) +import Data.Aeson +import Data.Text.Lazy.Encoding (decodeUtf8) +import Effect.Logger +import Fossa.API.Types (ApiOpts (..)) + +analyzeMain :: ScanDestination -> Severity -> OverrideProject -> ImageText -> IO () +analyzeMain scanDestination logSeverity override image = withLogger logSeverity $ do + result <- runDiagnostics $ analyze scanDestination override image + case result of + Left err -> logError (renderFailureBundle err) + Right _ -> pure () + +analyze :: + ( Has Diagnostics sig m, + Has (Lift IO) sig m, + Has Logger sig m, + MonadIO m + ) => + ScanDestination -> + OverrideProject -> + ImageText -> + m () +analyze scanDestination override image = do + logDebug "Running embedded syft binary" + containerScan <- runSyft image >>= toContainerScan + case scanDestination of + OutputStdout -> logStdout . pretty . decodeUtf8 $ encode containerScan + UploadScan apiOpts projectMeta -> do + let revision = extractRevision override containerScan + logInfo ("Using project name: `" <> pretty (projectName revision) <> "`") + logInfo ("Using project revision: `" <> pretty (projectRevision revision) <> "`") + locator <- uploadContainerScan apiOpts projectMeta containerScan + logInfo "Container Analysis successfully uploaded!" + logInfo "View FOSSA Report:" + logInfo (" " <> pretty (fossaProjectUrl (apiOptsUri apiOpts) locator revision)) + pure () + diff --git a/src/App/Fossa/Container/Test.hs b/src/App/Fossa/Container/Test.hs new file mode 100644 index 000000000..212d9ce6b --- /dev/null +++ b/src/App/Fossa/Container/Test.hs @@ -0,0 +1,84 @@ +{-# LANGUAGE BlockArguments #-} + +module App.Fossa.Container.Test + ( TestOutputType (..), + testMain, + ) +where + +import App.Fossa.API.BuildWait +import App.Fossa.Container +import App.Types (OverrideProject (..), ProjectRevision (..)) +import Control.Carrier.Diagnostics +import Control.Effect.Lift +import Control.Monad.IO.Class (MonadIO) +import qualified Data.Aeson as Aeson +import Data.Functor (void) +import Data.Text.Lazy.Encoding (decodeUtf8) +import Data.Text.IO (hPutStrLn) +import Effect.Logger +import Fossa.API.Types (ApiOpts (..), Issues (..)) +import System.Exit (exitFailure, exitSuccess) +import System.IO (stderr) + +data TestOutputType + = -- | pretty output format for issues + TestOutputPretty + | -- | json format issues + TestOutputJson + +testMain :: + ApiOpts -> + Severity -> + -- | Timeout, in seconds + Int -> + TestOutputType -> + OverrideProject -> + ImageText -> + IO () +testMain apiOpts logSeverity timeoutSeconds outputType override image = do + void $ timeout timeoutSeconds $ withLogger logSeverity $ do + result <- runDiagnostics $ testInner apiOpts outputType override image + case result of + Left err -> do + logError $ renderFailureBundle err + sendIO exitFailure + Right (ResultBundle _ _) -> sendIO exitSuccess + + hPutStrLn stderr "Timed out while wait for issues" + exitFailure + +testInner :: + (Has Diagnostics sig m, Has (Lift IO) sig m, Has Logger sig m, MonadIO m) => + ApiOpts -> + TestOutputType -> + OverrideProject -> + ImageText -> + m () +testInner apiOpts outputType override image = do + logDebug "Running embedded syft binary" + + containerScan <- runSyft image >>= toContainerScan + let revision = extractRevision override containerScan + + logInfo ("Using project name: `" <> pretty (projectName revision) <> "`") + logInfo ("Using project revision: `" <> pretty (projectRevision revision) <> "`") + + logSticky "[ Waiting for build completion ]" + waitForBuild apiOpts revision + + logSticky "[ Waiting for issue scan completion ]" + issues <- waitForIssues apiOpts revision + logSticky "" + + case issuesCount issues of + 0 -> logInfo "Test passed! 0 issues found" + n -> do + logError $ "Test failed. Number of issues found: " <> pretty n + if null (issuesIssues issues) + then logError "Check webapp for more details, or use a full-access API key (currently using a push-only API key)" + else do + case outputType of + TestOutputPretty -> logError $ pretty issues + TestOutputJson -> logStdout . pretty . decodeUtf8 . Aeson.encode $ issues + sendIO exitFailure diff --git a/src/App/Fossa/EmbeddedBinary.hs b/src/App/Fossa/EmbeddedBinary.hs new file mode 100644 index 000000000..5a9e72605 --- /dev/null +++ b/src/App/Fossa/EmbeddedBinary.hs @@ -0,0 +1,120 @@ +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} + +module App.Fossa.EmbeddedBinary + ( extractEmbeddedBinary, + cleanupExtractedBinaries, + withEmbeddedBinary, + dumpEmbeddedBinary, + toExecutablePath, + BinaryPaths, + withWigginsBinary, + withSyftBinary, + allBins, + PackagedBinary (..) + ) +where + +import Control.Effect.Exception (bracket) +import Control.Effect.Lift (Has, Lift, sendIO) +import Control.Monad.IO.Class +import Data.ByteString (ByteString, writeFile) +import Data.FileEmbed.Extra +import Path +import Path.IO +import Prelude hiding (writeFile) + +data PackagedBinary + = Syft + | Wiggins + deriving (Show, Eq, Enum, Bounded) + +allBins :: [PackagedBinary] +allBins = enumFromTo minBound maxBound + +data BinaryPaths + = BinaryPaths + { binaryPathContainer :: Path Abs Dir, + binaryFilePath :: Path Rel File + } + +toExecutablePath :: BinaryPaths -> Path Abs File +toExecutablePath BinaryPaths {..} = binaryPathContainer binaryFilePath + +withSyftBinary :: + ( Has (Lift IO) sig m, + MonadIO m + ) => + (BinaryPaths -> m c) -> + m c +withSyftBinary = withEmbeddedBinary Syft + +withWigginsBinary :: + ( Has (Lift IO) sig m, + MonadIO m + ) => + (BinaryPaths -> m c) -> + m c +withWigginsBinary = withEmbeddedBinary Wiggins + +withEmbeddedBinary :: + ( Has (Lift IO) sig m, + MonadIO m + ) => + PackagedBinary -> + (BinaryPaths -> m c) -> + m c +withEmbeddedBinary bin = bracket (extractEmbeddedBinary bin) cleanupExtractedBinaries + +cleanupExtractedBinaries :: (MonadIO m) => BinaryPaths -> m () +cleanupExtractedBinaries (BinaryPaths binPath _) = removeDirRecur binPath + +extractEmbeddedBinary :: (MonadIO m) => PackagedBinary -> m BinaryPaths +extractEmbeddedBinary bin = do + container <- extractDir + -- Determine paths to which we should write the binaries + let binPath = extractedPath bin + -- Write the binary + liftIO $ writeBinary (container binPath) bin + -- Return the paths + pure (BinaryPaths container binPath) + +dumpEmbeddedBinary :: Has (Lift IO) sig m => Path Abs Dir -> PackagedBinary -> m () +dumpEmbeddedBinary dir bin = writeBinary path bin + where path = dir extractedPath bin + +writeBinary :: (Has (Lift IO) sig m) => Path Abs File -> PackagedBinary -> m () +writeBinary dest bin = sendIO . writeExecutable dest $ case bin of + Syft -> embeddedBinarySyft + Wiggins -> embeddedBinaryWiggins + +writeExecutable :: Path Abs File -> ByteString -> IO () +writeExecutable path content = do + ensureDir $ parent path + writeFile (fromAbsFile path) content + makeExecutable path + +extractedPath :: PackagedBinary -> Path Rel File +extractedPath bin = case bin of + Syft -> $(mkRelFile "syft") + Wiggins -> $(mkRelFile "wiggins") + +extractDir :: MonadIO m => m (Path Abs Dir) +extractDir = do + wd <- liftIO getTempDir + pure (wd $(mkRelDir "fossa-vendor")) + +makeExecutable :: Path Abs File -> IO () +makeExecutable path = do + p <- getPermissions path + setPermissions path (p {executable = True}) + +-- The intent with these embedded binaries is that the build system will replace the files with +-- built binaries of the appropriate architecture. +-- The below functions are expected to warn since the vendor directory is typically populated in CI. +-- If you wish to run these on your local system, populate these binaries via `vendor_download.sh`. +embeddedBinaryWiggins :: ByteString +embeddedBinaryWiggins = $(embedFileIfExists "vendor/wiggins") + +embeddedBinarySyft :: ByteString +embeddedBinarySyft = $(embedFileIfExists "vendor/syft") diff --git a/src/App/Fossa/FossaAPIV1.hs b/src/App/Fossa/FossaAPIV1.hs index 9d7b3a584..1e23909cc 100644 --- a/src/App/Fossa/FossaAPIV1.hs +++ b/src/App/Fossa/FossaAPIV1.hs @@ -7,6 +7,7 @@ module App.Fossa.FossaAPIV1 ( uploadAnalysis , uploadContributors + , uploadContainerScan , UploadResponse(..) , mkMetadataOpts , FossaError(..) @@ -19,11 +20,6 @@ module App.Fossa.FossaAPIV1 , BuildTask(..) , BuildStatus(..) , getIssues - , Issues(..) - , Issue(..) - , IssueType(..) - , renderIssueType - , IssueRule(..) , Organization(..) , getOrganization @@ -33,6 +29,7 @@ module App.Fossa.FossaAPIV1 ) where import App.Fossa.Analyze.Project +import App.Fossa.Container (ContainerScan (..)) import qualified App.Fossa.Report.Attribution as Attr import App.Types import Control.Effect.Diagnostics hiding (fromMaybe) @@ -52,7 +49,7 @@ import Srclib.Converter (toSourceUnit) import Srclib.Types import Text.URI (URI) import qualified Text.URI as URI -import Fossa.API.Types (ApiOpts, useApiOpts) +import Fossa.API.Types (ApiOpts, useApiOpts, Issues) import App.Version (versionNumber) newtype FossaReq m a = FossaReq { unFossaReq :: m a } @@ -120,6 +117,25 @@ instance ToDiagnostic FossaError where OtherError err -> "An unknown error occurred when accessing the FOSSA API: " <> viaShow err BadURI uri -> "Invalid FOSSA URL: " <> pretty (URI.render uri) +containerUploadUrl :: Url scheme -> Url scheme +containerUploadUrl baseurl = baseurl /: "api" /: "container" /: "upload" + +uploadContainerScan + :: (Has (Lift IO) sig m, Has Diagnostics sig m) + => ApiOpts + -> ProjectMetadata + -> ContainerScan + -> m Text -- ^ Locator as text +uploadContainerScan apiOpts metadata ContainerScan {..} = fossaReq $ do + (baseUrl, baseOpts) <- useApiOpts apiOpts + let locator = renderLocator (Locator "custom" imageTag $ Just imageDigest) + opts = "locator" =: locator + <> "cliVersion" =: cliVersion + <> mkMetadataOpts metadata imageTag + _ <- req POST (containerUploadUrl baseUrl) (ReqBodyJson imageData) ignoreResponse (baseOpts <> opts) + pure locator + + uploadAnalysis :: (Has (Lift IO) sig m, Has Diagnostics sig m) => ApiOpts @@ -236,101 +252,6 @@ getIssues apiOpts ProjectRevision{..} = fossaReq $ do response <- req GET (issuesEndpoint baseUrl orgId (Locator "custom" projectName (Just projectRevision))) NoReqBody jsonResponse baseOpts pure (responseBody response) -data Issues = Issues - { issuesCount :: Int - , issuesIssues :: [Issue] - , issuesStatus :: Text - } deriving (Eq, Ord, Show) - -data IssueType - = IssuePolicyConflict - | IssuePolicyFlag - | IssueVulnerability - | IssueUnlicensedDependency - | IssueOutdatedDependency - | IssueOther Text - deriving (Eq, Ord, Show) - -renderIssueType :: IssueType -> Text -renderIssueType = \case - IssuePolicyConflict -> "Denied by Policy" - IssuePolicyFlag -> "Flagged by Policy" - IssueVulnerability -> "Vulnerability" - IssueUnlicensedDependency -> "Unlicensed Dependency" - IssueOutdatedDependency -> "Outdated Dependency" - IssueOther other -> other - -data Issue = Issue - { issueId :: Int - , issuePriorityString :: Maybe Text -- we only use this field for `fossa test --json` - , issueResolved :: Bool - , issueRevisionId :: Text - , issueType :: IssueType - , issueRule :: Maybe IssueRule - } deriving (Eq, Ord, Show) - -newtype IssueRule = IssueRule - { ruleLicenseId :: Maybe Text - } deriving (Eq, Ord, Show) - -instance FromJSON Issues where - parseJSON = withObject "Issues" $ \obj -> - Issues <$> obj .: "count" - <*> obj .:? "issues" .!= [] - <*> obj .: "status" - -instance ToJSON Issues where - toJSON Issues{..} = object - [ "count" .= issuesCount - , "issues" .= issuesIssues - , "status" .= issuesStatus - ] - -instance FromJSON Issue where - parseJSON = withObject "Issue" $ \obj -> - Issue <$> obj .: "id" - <*> obj .:? "priorityString" - <*> obj .: "resolved" - -- VPS issues don't have a revisionId - <*> obj .:? "revisionId" .!= "unknown project" - <*> obj .: "type" - <*> obj .:? "rule" - -instance ToJSON Issue where - toJSON Issue{..} = object - [ "id" .= issueId - , "priorityString" .= issuePriorityString - , "resolved" .= issueResolved - , "revisionId" .= issueRevisionId - , "type" .= issueType - , "rule" .= issueRule - ] - -instance FromJSON IssueType where - parseJSON = withText "IssueType" $ \case - "policy_conflict" -> pure IssuePolicyConflict - "policy_flag" -> pure IssuePolicyFlag - "vulnerability" -> pure IssueVulnerability - "unlicensed_dependency" -> pure IssueUnlicensedDependency - "outdated_dependency" -> pure IssueOutdatedDependency - other -> pure (IssueOther other) - -instance ToJSON IssueType where - toJSON = String . \case - IssuePolicyConflict -> "policy_conflict" - IssuePolicyFlag -> "policy_flag" - IssueVulnerability -> "vulnerability" - IssueUnlicensedDependency -> "unlicensed_dependency" - IssueOutdatedDependency -> "outdated_dependency" - IssueOther text -> text - -instance FromJSON IssueRule where - parseJSON = withObject "IssueRule" $ \obj -> - IssueRule <$> obj .:? "licenseId" - -instance ToJSON IssueRule where - toJSON IssueRule{..} = object ["licenseId" .= ruleLicenseId] - --------------- attributionEndpoint :: Url 'Https -> Int -> Locator -> Url 'Https diff --git a/src/App/Fossa/Main.hs b/src/App/Fossa/Main.hs index b4bc72919..e09d38c0e 100644 --- a/src/App/Fossa/Main.hs +++ b/src/App/Fossa/Main.hs @@ -7,6 +7,10 @@ module App.Fossa.Main where import App.Fossa.Analyze (ScanDestination (..), UnpackArchives (..), analyzeMain) +import App.Fossa.Container (imageTextArg, ImageText (..)) +import qualified App.Fossa.Container.Analyze as ContainerAnalyze +import qualified App.Fossa.Container.Test as ContainerTest +import qualified App.Fossa.EmbeddedBinary as Embed import App.Fossa.ListTargets (listTargetsMain) import qualified App.Fossa.Report as Report import qualified App.Fossa.Test as Test @@ -23,6 +27,7 @@ import Control.Monad (unless, when) import Data.Bifunctor (first) import Data.Bool (bool) import Data.Flag (Flag, flagOpt) +import Data.Foldable (for_) import Data.Text (Text) import qualified Data.Text as T import Discovery.Filters (BuildTargetFilter (..), filterParser) @@ -84,7 +89,7 @@ appMain = do listTargetsMain baseDir -- VPSCommand VPSOptions {..} -> do - when (SysInfo.os == windowsOsName) $ die "VPS functionality is not supported on Windows" + dieOnWindows "Vendored Package Scanning (VPS)" apikey <- requireKey maybeApiKey let apiOpts = ApiOpts optBaseUrl apikey case vpsCommand of @@ -100,6 +105,30 @@ appMain = do unless vpsReportJsonOutput $ die "report command currently only supports JSON output. Please try `fossa report --json REPORT_NAME`" baseDir <- validateDir vpsReportBaseDir VPSReport.reportMain baseDir apiOpts logSeverity vpsReportTimeout vpsReportType override + -- + ContainerCommand ContainerOptions {..} -> do + die "Fatal: Container scanning is not available yet" >> pure () + dieOnWindows "container scanning" + case containerCommand of + ContainerAnalyze ContainerAnalyzeOptions {..} -> + if containerAnalyzeOutput + then ContainerAnalyze.analyzeMain OutputStdout logSeverity override containerAnalyzeImage + else do + apikey <- requireKey maybeApiKey + let apiOpts = ApiOpts optBaseUrl apikey + ContainerAnalyze.analyzeMain (UploadScan apiOpts containerMetadata) logSeverity override containerAnalyzeImage + ContainerTest ContainerTestOptions {..} -> do + apikey <- requireKey maybeApiKey + let apiOpts = ApiOpts optBaseUrl apikey + ContainerTest.testMain apiOpts logSeverity containerTestTimeout containerTestOutputType override containerTestImage + -- + DumpBinsCommand dir -> do + basedir <- validateDir dir + for_ Embed.allBins $ Embed.dumpEmbeddedBinary $ unBaseDir basedir + + +dieOnWindows :: String -> IO () +dieOnWindows op = when (SysInfo.os == windowsOsName) $ die $ "Operation is not supported on Windows: " <> op requireKey :: Maybe ApiKey -> IO ApiKey requireKey (Just key) = pure key @@ -164,7 +193,7 @@ commands = (VPSCommand <$> vpsOpts) (progDesc "Run in Vendored Package Scan mode") ) - ) + ) hiddenCommands :: Parser Command hiddenCommands = @@ -176,6 +205,18 @@ hiddenCommands = (pure InitCommand) (progDesc "Deprecated, has no effect.") ) + <> command + "dump-binaries" + ( info + (DumpBinsCommand <$> baseDirArg) + (progDesc "Output all embedded binaries to specified path") + ) + <> command + "container" + ( info + (ContainerCommand <$> containerOpts) + (progDesc "Run in Container Scan mode") + ) ) analyzeOpts :: Parser AnalyzeOptions @@ -290,6 +331,38 @@ vpsCommands = ) ) +containerOpts :: Parser ContainerOptions +containerOpts = ContainerOptions <$> containerCommands + +containerCommands :: Parser ContainerCommand +containerCommands = + hsubparser + ( command + "analyze" + ( info (ContainerAnalyze <$> containerAnalyzeOpts) $ + progDesc "Scan an image for vulnerabilities" + ) + <> command + "test" + ( info (ContainerTest <$> containerTestOpts) $ + progDesc "Check for issues from FOSSA and exit non-zero when issues are found" + ) + ) + +containerAnalyzeOpts :: Parser ContainerAnalyzeOptions +containerAnalyzeOpts = + ContainerAnalyzeOptions + <$> switch (long "output" <> short 'o' <> help "Output results to stdout instead of uploading to fossa") + <*> metadataOpts + <*> imageTextArg + +containerTestOpts :: Parser ContainerTestOptions +containerTestOpts = + ContainerTestOptions + <$> option auto (long "timeout" <> help "Duration to wait for build completion (in seconds)" <> value 600) + <*> flag ContainerTest.TestOutputPretty ContainerTest.TestOutputJson (long "json" <> help "Output issues as json") + <*> imageTextArg + data CmdOptions = CmdOptions { optDebug :: Bool, optBaseUrl :: URI, @@ -304,8 +377,10 @@ data Command | TestCommand TestOptions | ReportCommand ReportOptions | VPSCommand VPSOptions - | InitCommand + | ContainerCommand ContainerOptions | ListTargetsCommand FilePath + | InitCommand + | DumpBinsCommand FilePath data VPSCommand = VPSAnalyzeCommand VPSAnalyzeOptions @@ -359,3 +434,22 @@ data VPSTestOptions = VPSTestOptions vpsTestOutputType :: VPSTest.TestOutputType, vpsTestBaseDir :: FilePath } + +newtype ContainerOptions = ContainerOptions + { containerCommand :: ContainerCommand } + +data ContainerCommand + = ContainerAnalyze ContainerAnalyzeOptions + | ContainerTest ContainerTestOptions + +data ContainerAnalyzeOptions = ContainerAnalyzeOptions + { containerAnalyzeOutput :: Bool, + containerMetadata :: ProjectMetadata, + containerAnalyzeImage :: ImageText + } + +data ContainerTestOptions = ContainerTestOptions + { containerTestTimeout :: Int, + containerTestOutputType:: ContainerTest.TestOutputType, + containerTestImage :: ImageText + } diff --git a/src/App/Fossa/Test.hs b/src/App/Fossa/Test.hs index eb5133e74..316b5135c 100644 --- a/src/App/Fossa/Test.hs +++ b/src/App/Fossa/Test.hs @@ -1,27 +1,19 @@ -{-# LANGUAGE NumericUnderscores #-} - module App.Fossa.Test ( testMain , TestOutputType(..) ) where import App.Fossa.API.BuildWait -import qualified App.Fossa.FossaAPIV1 as Fossa import App.Fossa.ProjectInference import App.Types import Control.Carrier.Diagnostics hiding (fromMaybe) import Control.Effect.Lift (sendIO) import qualified Data.Aeson as Aeson import Data.Functor (void) -import Data.Map.Strict (Map) -import qualified Data.Map.Strict as M -import Data.Maybe (fromMaybe) -import Data.Text (Text) -import qualified Data.Text as T import Data.Text.IO (hPutStrLn) import Data.Text.Lazy.Encoding (decodeUtf8) import Effect.Logger -import Fossa.API.Types (ApiOpts) +import Fossa.API.Types (ApiOpts, Issues(..)) import System.Exit (exitFailure, exitSuccess) import System.IO (stderr) @@ -55,15 +47,15 @@ testMain basedir apiOpts logSeverity timeoutSeconds outputType override = do logSticky "" logInfo "" - case Fossa.issuesCount issues of + case issuesCount issues of 0 -> logInfo "Test passed! 0 issues found" n -> do logError $ "Test failed. Number of issues found: " <> pretty n - if null (Fossa.issuesIssues issues) + if null (issuesIssues issues) then logError "Check the webapp for more details, or use a full-access API key (currently using a push-only API key)" else case outputType of - TestOutputPretty -> logError (renderedIssues issues) + TestOutputPretty -> logError $ pretty issues TestOutputJson -> logStdout . pretty . decodeUtf8 . Aeson.encode $ issues sendIO exitFailure @@ -79,54 +71,3 @@ testMain basedir apiOpts logSeverity timeoutSeconds outputType override = do hPutStrLn stderr "Timed out while waiting for issues scan" exitFailure -renderedIssues :: Fossa.Issues -> Doc ann -renderedIssues issues = rendered - where - padding :: Int - padding = 20 - - issuesList :: [Fossa.Issue] - issuesList = Fossa.issuesIssues issues - - categorize :: Ord k => (v -> k) -> [v] -> Map k [v] - categorize f = M.fromListWith (++) . map (\v -> (f v, [v])) - - issuesByType :: Map Fossa.IssueType [Fossa.Issue] - issuesByType = categorize Fossa.issueType issuesList - - renderSection :: Fossa.IssueType -> [Fossa.Issue] -> Doc ann - renderSection issueType rawIssues = - renderHeader issueType <> line <> vsep (map renderIssue rawIssues) <> line - - rendered :: Doc ann - rendered = vsep - [renderSection issueType rawIssues | (issueType,rawIssues) <- M.toList issuesByType] - - renderHeader :: Fossa.IssueType -> Doc ann - renderHeader ty = vsep - [ "========================================================================" - , pretty $ Fossa.renderIssueType ty - , "========================================================================" - , hsep $ map (fill padding) $ case ty of - Fossa.IssuePolicyConflict -> ["Dependency", "Revision", "License"] - Fossa.IssuePolicyFlag -> ["Dependency", "Revision", "License"] - _ -> ["Dependency", "Revision"] - , "" - ] - - renderIssue :: Fossa.Issue -> Doc ann - renderIssue issue = hsep (map format [name, revision, license]) - where - format :: Text -> Doc ann - format = fill padding . pretty - - locatorSplit = T.split (\c -> c == '$' || c == '+') (Fossa.issueRevisionId issue) - - name = fromMaybe (Fossa.issueRevisionId issue) (locatorSplit !? 1) - revision = fromMaybe "" (locatorSplit !? 2) - license = fromMaybe "" (Fossa.ruleLicenseId =<< Fossa.issueRule issue) - - (!?) :: [a] -> Int -> Maybe a - xs !? ix - | length xs <= ix = Nothing - | otherwise = Just (xs !! ix) diff --git a/src/App/Fossa/VPS/EmbeddedBinary.hs b/src/App/Fossa/VPS/EmbeddedBinary.hs deleted file mode 100644 index 71e3888d4..000000000 --- a/src/App/Fossa/VPS/EmbeddedBinary.hs +++ /dev/null @@ -1,72 +0,0 @@ -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TemplateHaskell #-} - -module App.Fossa.VPS.EmbeddedBinary - ( BinaryPaths(..) - , extractEmbeddedBinaries - , cleanupExtractedBinaries - , withEmbeddedBinaries - ) where - -import Prelude hiding (writeFile) -import Control.Effect.Exception (bracket) -import Control.Effect.Lift ( Has, Lift ) -import Control.Monad.IO.Class -import Data.ByteString (writeFile, ByteString) -import Path -import Path.IO -import Data.FileEmbed.Extra - -data BinaryPaths = BinaryPaths - { binaryPathContainer :: Path Abs Dir - , wigginsBinaryPath :: Path Abs File - } - -withEmbeddedBinaries :: (Has (Lift IO) sig m, MonadIO m) => (BinaryPaths -> m c) -> m c -withEmbeddedBinaries = bracket extractEmbeddedBinaries cleanupExtractedBinaries - -cleanupExtractedBinaries :: (MonadIO m) => BinaryPaths -> m () -cleanupExtractedBinaries BinaryPaths{..} = do - removeDirRecur binaryPathContainer - pure () - -extractEmbeddedBinaries :: (MonadIO m) => m BinaryPaths -extractEmbeddedBinaries = do - container <- extractDir - - -- Determine paths to which we should write the binaries - wigginsBinaryPath <- extractedPath $(mkRelFile "wiggins") - - -- Write the binaries - liftIO $ writeExecutable wigginsBinaryPath embeddedBinaryWiggins - - -- Return the paths - pure (BinaryPaths container wigginsBinaryPath) - -writeExecutable :: Path Abs File -> ByteString -> IO () -writeExecutable path content = do - ensureDir $ parent path - writeFile (fromAbsFile path) content - makeExecutable path - -extractedPath :: MonadIO m => Path Rel File -> m (Path Abs File) -extractedPath name = do - dir <- extractDir - pure (dir name) - -extractDir :: MonadIO m => m (Path Abs Dir) -extractDir = do - wd <- liftIO getTempDir - pure (wd $(mkRelDir "vpscli-vendor")) - -makeExecutable :: Path Abs File -> IO () -makeExecutable path = do - p <- getPermissions path - setPermissions path (p {executable = True}) - --- The intent with these embedded binaries is that the build system will replace the files with built binaries of the appropriate architecture. --- The versions vendored into the repository are suitable for running on MacOS. --- The below functions are expectd to warn since the vendor directory is typically populated in CI. --- If you wish to build `vpscli` for your local system, populate these binaries via `vendor_download.sh`. -embeddedBinaryWiggins :: ByteString -embeddedBinaryWiggins = $(embedFileIfExists "vendor/wiggins") diff --git a/src/App/Fossa/VPS/Scan.hs b/src/App/Fossa/VPS/Scan.hs index 45d8e1e04..9eae29993 100644 --- a/src/App/Fossa/VPS/Scan.hs +++ b/src/App/Fossa/VPS/Scan.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE RecordWildCards #-} - module App.Fossa.VPS.Scan ( scanMain, SkipIPRScan (..), @@ -11,7 +9,7 @@ import Control.Carrier.Diagnostics import Effect.Exec import System.Exit (exitFailure) -import App.Fossa.VPS.EmbeddedBinary +import App.Fossa.EmbeddedBinary import App.Fossa.VPS.Scan.RunWiggins import App.Fossa.VPS.Types import App.Types (BaseDir (..), OverrideProject (..), ProjectMetadata (..)) @@ -27,8 +25,8 @@ data SkipIPRScan = SkipIPRScan data LicenseOnlyScan = LicenseOnlyScan scanMain :: BaseDir -> ApiOpts -> ProjectMetadata -> Severity -> OverrideProject -> FilterExpressions -> Flag SkipIPRScan -> Flag LicenseOnlyScan -> IO () -scanMain basedir apiOpts metadata logSeverity overrideProject fileFilters skipIprScan licenseOnlyScan = do - result <- runDiagnostics $ withEmbeddedBinaries $ vpsScan basedir logSeverity overrideProject skipIprScan licenseOnlyScan fileFilters apiOpts metadata +scanMain basedir apiOpts metadata logSeverity overrideProject fileFilters skipIprFlag licenseOnlyScan = do + result <- runDiagnostics $ withWigginsBinary $ vpsScan basedir logSeverity overrideProject skipIprFlag licenseOnlyScan fileFilters apiOpts metadata case result of Left failure -> do print $ renderFailureBundle failure diff --git a/src/App/Fossa/VPS/Scan/RunWiggins.hs b/src/App/Fossa/VPS/Scan/RunWiggins.hs index 2e316b8b3..1b5b464b3 100644 --- a/src/App/Fossa/VPS/Scan/RunWiggins.hs +++ b/src/App/Fossa/VPS/Scan/RunWiggins.hs @@ -9,7 +9,7 @@ module App.Fossa.VPS.Scan.RunWiggins where import App.Fossa.VPS.Types -import App.Fossa.VPS.EmbeddedBinary +import App.Fossa.EmbeddedBinary import Control.Carrier.Error.Either import Control.Effect.Diagnostics import Data.Functor (void) @@ -69,9 +69,9 @@ execWiggins :: (Has Exec sig m, Has Diagnostics sig m) => BinaryPaths -> Wiggins execWiggins binaryPaths opts = void $ execThrow (scanDir opts) (wigginsCommand binaryPaths opts) wigginsCommand :: BinaryPaths -> WigginsOpts -> Command -wigginsCommand BinaryPaths{..} WigginsOpts{..} = do +wigginsCommand bin WigginsOpts{..} = do Command - { cmdName = T.pack $ fromAbsFile wigginsBinaryPath, + { cmdName = T.pack $ fromAbsFile $ toExecutablePath bin, cmdArgs = spectrometerArgs, cmdAllowErr = Never } diff --git a/src/App/Fossa/VPS/Test.hs b/src/App/Fossa/VPS/Test.hs index d9b535f37..9a8550406 100644 --- a/src/App/Fossa/VPS/Test.hs +++ b/src/App/Fossa/VPS/Test.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE NumericUnderscores #-} - module App.Fossa.VPS.Test ( testMain, TestOutputType (..), @@ -19,7 +17,7 @@ import Data.Text.IO (hPutStrLn) import Data.Text.Lazy.Encoding (decodeUtf8) import Effect.Exec import Effect.Logger -import Fossa.API.Types (ApiOpts) +import Fossa.API.Types (ApiOpts, Issues (..)) import System.Exit (exitFailure, exitSuccess) import System.IO (stderr) @@ -62,11 +60,11 @@ testMain basedir apiOpts logSeverity timeoutSeconds outputType override = do issues <- waitForIssues apiOpts revision logSticky "" - case Fossa.issuesCount issues of + case issuesCount issues of 0 -> logInfo "Test passed! 0 issues found" n -> do logError $ "Test failed. Number of issues found: " <> pretty n - if null (Fossa.issuesIssues issues) + if null (issuesIssues issues) then logError "Check the webapp for more details, or use a full-access API key (currently using a push-only API key)" else case outputType of diff --git a/src/Fossa/API/Types.hs b/src/Fossa/API/Types.hs index d42477893..38e557658 100644 --- a/src/Fossa/API/Types.hs +++ b/src/Fossa/API/Types.hs @@ -1,15 +1,27 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RecordWildCards #-} module Fossa.API.Types ( ApiKey (..), ApiOpts (..), useApiOpts, + Issues (..), + IssueRule (..), + IssueType (..), + Issue (..), ) where -import Control.Effect.Diagnostics +import Control.Effect.Diagnostics hiding (fromMaybe) +import Data.Aeson import Data.Coerce (coerce) +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as M +import Data.Maybe (fromMaybe) import Data.Text (Text) +import qualified Data.Text as T +import Data.Text.Prettyprint.Doc import Data.Text.Encoding (encodeUtf8) import Network.HTTP.Req import Text.URI (URI, render) @@ -24,6 +36,159 @@ data ApiOpts = ApiOpts } deriving (Eq, Ord, Show) +data Issues = Issues + { issuesCount :: Int + , issuesIssues :: [Issue] + , issuesStatus :: Text + } deriving (Eq, Ord, Show) + +data IssueType + = IssuePolicyConflict + | IssuePolicyFlag + | IssueVulnerability + | IssueUnlicensedDependency + | IssueOutdatedDependency + | IssueOther Text + deriving (Eq, Ord, Show) + +renderIssueType :: IssueType -> Text +renderIssueType = \case + IssuePolicyConflict -> "Denied by Policy" + IssuePolicyFlag -> "Flagged by Policy" + IssueVulnerability -> "Vulnerability" + IssueUnlicensedDependency -> "Unlicensed Dependency" + IssueOutdatedDependency -> "Outdated Dependency" + IssueOther other -> other + +data Issue = Issue + { issueId :: Int + , issuePriorityString :: Maybe Text -- we only use this field for `fossa test --json` + , issueResolved :: Bool + , issueRevisionId :: Text + , issueType :: IssueType + , issueRule :: Maybe IssueRule + } deriving (Eq, Ord, Show) + +newtype IssueRule = IssueRule + { ruleLicenseId :: Maybe Text + } deriving (Eq, Ord, Show) + +instance FromJSON Issues where + parseJSON = withObject "Issues" $ \obj -> + Issues <$> obj .: "count" + <*> obj .:? "issues" .!= [] + <*> obj .: "status" + +instance ToJSON Issues where + toJSON Issues{..} = object + [ "count" .= issuesCount + , "issues" .= issuesIssues + , "status" .= issuesStatus + ] + +instance FromJSON Issue where + parseJSON = withObject "Issue" $ \obj -> + Issue <$> obj .: "id" + <*> obj .:? "priorityString" + <*> obj .: "resolved" + -- VPS issues don't have a revisionId + <*> obj .:? "revisionId" .!= "unknown project" + <*> obj .: "type" + <*> obj .:? "rule" + +instance ToJSON Issue where + toJSON Issue{..} = object + [ "id" .= issueId + , "priorityString" .= issuePriorityString + , "resolved" .= issueResolved + , "revisionId" .= issueRevisionId + , "type" .= issueType + , "rule" .= issueRule + ] + +instance FromJSON IssueType where + parseJSON = withText "IssueType" $ \case + "policy_conflict" -> pure IssuePolicyConflict + "policy_flag" -> pure IssuePolicyFlag + "vulnerability" -> pure IssueVulnerability + "unlicensed_dependency" -> pure IssueUnlicensedDependency + "outdated_dependency" -> pure IssueOutdatedDependency + other -> pure (IssueOther other) + +instance ToJSON IssueType where + toJSON = String . \case + IssuePolicyConflict -> "policy_conflict" + IssuePolicyFlag -> "policy_flag" + IssueVulnerability -> "vulnerability" + IssueUnlicensedDependency -> "unlicensed_dependency" + IssueOutdatedDependency -> "outdated_dependency" + IssueOther text -> text + +instance FromJSON IssueRule where + parseJSON = withObject "IssueRule" $ \obj -> + IssueRule <$> obj .:? "licenseId" + +instance ToJSON IssueRule where + toJSON IssueRule{..} = object ["licenseId" .= ruleLicenseId] + +instance Pretty Issues where + pretty = renderedIssues + +--------------- + +renderedIssues :: Issues -> Doc ann +renderedIssues issues = rendered + where + padding :: Int + padding = 20 + + issuesList :: [Issue] + issuesList = issuesIssues issues + + categorize :: Ord k => (v -> k) -> [v] -> Map k [v] + categorize f = M.fromListWith (++) . map (\v -> (f v, [v])) + + issuesByType :: Map IssueType [Issue] + issuesByType = categorize issueType issuesList + + renderSection :: IssueType -> [Issue] -> Doc ann + renderSection issueType rawIssues = + renderHeader issueType <> line <> vsep (map renderIssue rawIssues) <> line + + rendered :: Doc ann + rendered = vsep + [renderSection issueType rawIssues | (issueType,rawIssues) <- M.toList issuesByType] + + renderHeader :: IssueType -> Doc ann + renderHeader ty = vsep + [ "========================================================================" + , pretty $ renderIssueType ty + , "========================================================================" + , hsep $ map (fill padding) $ case ty of + IssuePolicyConflict -> ["Dependency", "Revision", "License"] + IssuePolicyFlag -> ["Dependency", "Revision", "License"] + _ -> ["Dependency", "Revision"] + , "" + ] + + renderIssue :: Issue -> Doc ann + renderIssue issue = hsep (map format [name, revision, license]) + where + format :: Text -> Doc ann + format = fill padding . pretty + + locatorSplit = T.split (\c -> c == '$' || c == '+') (issueRevisionId issue) + + name = fromMaybe (issueRevisionId issue) (locatorSplit !? 1) + revision = fromMaybe "" (locatorSplit !? 2) + license = fromMaybe "" (ruleLicenseId =<< issueRule issue) + + (!?) :: [a] -> Int -> Maybe a + xs !? ix + | length xs <= ix = Nothing + | otherwise = Just (xs !! ix) + + -- | parse a URI for use as a base Url, along with some default options (auth, port, ...) useApiOpts :: Has Diagnostics sig m => ApiOpts -> m (Url 'Https, Option 'Https) useApiOpts opts = case useURI (apiOptsUri opts) of diff --git a/test/App/Fossa/FossaAPIV1Spec.hs b/test/Fossa/API/TypesSpec.hs similarity index 90% rename from test/App/Fossa/FossaAPIV1Spec.hs rename to test/Fossa/API/TypesSpec.hs index f5aa22fe8..59d0ff7c5 100644 --- a/test/App/Fossa/FossaAPIV1Spec.hs +++ b/test/Fossa/API/TypesSpec.hs @@ -1,6 +1,6 @@ -module App.Fossa.FossaAPIV1Spec (spec) where +module Fossa.API.TypesSpec (spec) where -import App.Fossa.FossaAPIV1 (Issue (..), IssueRule (..), IssueType (..), Issues (..)) +import Fossa.API.Types (Issue (..), IssueRule (..), IssueType (..), Issues (..)) import Data.Aeson (FromJSON, ToJSON, fromJSON, toJSON) import Data.Text (Text) import qualified Hedgehog.Gen as Gen diff --git a/vendor_download.sh b/vendor_download.sh index 294053711..8bf0547df 100755 --- a/vendor_download.sh +++ b/vendor_download.sh @@ -6,6 +6,7 @@ # Requires binary dependencies in $PATH: # jq Parse and manipulate json structures. # curl Download data over HTTP(s) +# sed Modify syft tag # upx Compress binaries (optional) # @@ -39,15 +40,56 @@ esac TAG="latest" echo "Downloading asset information from latest tag for architecture '$ASSET_POSTFIX'" + +echo "Downloading wiggins binary" +WIGGINS_RELEASE_JSON=vendor/wiggins-release.json +curl -sSL \ + -H "Authorization: token $GITHUB_TOKEN" \ + -H "Accept: application/vnd.github.v3.raw" \ + api.github.com/repos/fossas/basis/releases/latest > $WIGGINS_RELEASE_JSON + +WIGGINS_TAG=$(jq -cr ".name" $WIGGINS_RELEASE_JSON) FILTER=".name == \"wiggins-$ASSET_POSTFIX\"" -curl -sL -H "Authorization: token $GITHUB_TOKEN" -H "Accept: application/vnd.github.v3.raw" -s api.github.com/repos/fossas/basis/releases/latest | jq -c ".assets | map({url: .url, name: .name}) | map(select($FILTER)) | .[]" | while read ASSET; do +echo "Using wiggins release: $WIGGINS_TAG" +jq -c ".assets | map({url: .url, name: .name}) | map(select($FILTER)) | .[]" $WIGGINS_RELEASE_JSON | while read ASSET; do + URL="$(echo $ASSET | jq -c -r '.url')" + NAME="$(echo $ASSET | jq -c -r '.name')" + OUTPUT=vendor/${NAME%"-$ASSET_POSTFIX"} + + echo "Downloading '$NAME' to '$OUTPUT'" + curl -sL -H "Authorization: token $GITHUB_TOKEN" -H "Accept: application/octet-stream" -s $URL > $OUTPUT +done +rm $WIGGINS_RELEASE_JSON +echo "Wiggins download successful" +echo + +echo "Downloading forked syft binary" +SYFT_RELEASE_JSON=vendor/syft-release.json +curl -sSL \ + -H "Authorization: token $GITHUB_TOKEN" \ + -H "Accept: application/vnd.github.v3.raw" \ + api.github.com/repos/fossas/syft/releases/latest > $SYFT_RELEASE_JSON + +# Remove leading 'v' from version tag +# 'v123' -> '123' +SYFT_TAG=$(jq -cr '.name' $SYFT_RELEASE_JSON | sed 's/^v//') +echo "Using fossas/syft release: $SYFT_TAG" +FILTER=".name == \"container-scanning_${SYFT_TAG}_${ASSET_POSTFIX}_amd64.tar.gz\"" +jq -c ".assets | map({url: .url, name: .name}) | map(select($FILTER)) | .[]" $SYFT_RELEASE_JSON | while read ASSET; do URL="$(echo $ASSET | jq -c -r '.url')" NAME="$(echo $ASSET | jq -c -r '.name')" OUTPUT=vendor/${NAME%"-$ASSET_POSTFIX"} echo "Downloading '$NAME' to '$OUTPUT'" curl -sL -H "Authorization: token $GITHUB_TOKEN" -H "Accept: application/octet-stream" -s $URL > $OUTPUT + echo "Extracting syft binary from tarball" + tar xzf $OUTPUT fossa-container-scanning + mv fossa-container-scanning vendor/syft + rm $OUTPUT + done +rm $SYFT_RELEASE_JSON +echo "Forked Syft download successful" echo "Marking binaries executable" chmod +x vendor/*