From 192e7b238b763a927814ce9bd9675d8650d8955a Mon Sep 17 00:00:00 2001 From: Christopher Sasarak Date: Fri, 12 Jul 2024 12:03:41 -0500 Subject: [PATCH 01/21] Bump cabal index state. --- cabal.project.common | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cabal.project.common b/cabal.project.common index adadcabdef..683efe8a78 100644 --- a/cabal.project.common +++ b/cabal.project.common @@ -62,4 +62,4 @@ source-repository-package location: https://github.com/fossas/codec-rpm tag: 0f7431423d47fdf36945e4ff31fbee76005b7e68 -index-state: hackage.haskell.org 2024-04-12T15:16:26Z +index-state: hackage.haskell.org 2024-07-02T15:24:00Z From aa84509bcbdcb8ae4d0e521776ac581c1419a301 Mon Sep 17 00:00:00 2001 From: Christopher Sasarak Date: Mon, 15 Jul 2024 11:22:44 -0500 Subject: [PATCH 02/21] Make tls/crypton work. --- spectrometer.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/spectrometer.cabal b/spectrometer.cabal index 417c058a8c..9cc3b3ea20 100644 --- a/spectrometer.cabal +++ b/spectrometer.cabal @@ -101,7 +101,7 @@ common deps , conduit-zstd ^>=0.0.2.0 , containers ^>=0.6.8 , cpio-conduit ^>=0.7.0 - , crypton ^>=0.34 + , crypton ^>=1.0.0 , deepseq ^>=1.4.8 , direct-sqlite ^>=2.3.27 , directory ^>=1.3.6.1 @@ -148,7 +148,7 @@ common deps , text ^>=2.0.0 , th-lift-instances ^>=0.1.17 , time >=1.9 && <1.13 - , tls >=1.9 && <2.0 + , tls ^>=2.0 , tomland ^>=1.3.3.0 , transformers , typed-process ^>=0.2.6 From 6d85b77cee1475e2c1a65583556ad66a247e7ae8 Mon Sep 17 00:00:00 2001 From: Christopher Sasarak Date: Mon, 15 Jul 2024 16:07:22 -0500 Subject: [PATCH 03/21] Thread a connection manager which allows EMS around. --- spectrometer.cabal | 3 + src/Control/Carrier/FossaApiClient.hs | 146 +++++++------ .../Carrier/FossaApiClient/Internal/Core.hs | 141 ++++--------- .../FossaApiClient/Internal/FossaAPIV1.hs | 191 +++++++----------- .../Internal/LicenseScanning.hs | 35 +--- .../Carrier/FossaApiClient/Internal/VSI.hs | 39 +--- 6 files changed, 212 insertions(+), 343 deletions(-) diff --git a/spectrometer.cabal b/spectrometer.cabal index 9cc3b3ea20..9516c26ed0 100644 --- a/spectrometer.cabal +++ b/spectrometer.cabal @@ -102,6 +102,8 @@ common deps , containers ^>=0.6.8 , cpio-conduit ^>=0.7.0 , crypton ^>=1.0.0 + , crypton-connection ^>=0.4.1 + , data-default-class ^>=0.1.2.0 , deepseq ^>=1.4.8 , direct-sqlite ^>=2.3.27 , directory ^>=1.3.6.1 @@ -117,6 +119,7 @@ common deps , hashable >=1.0.0.1 , hedn ^>=0.3.0.1 , http-client ^>=0.7.1 + , http-client-tls ^>=0.3.6 , http-conduit ^>=2.3.0 , http-types ^>=0.12.3 , lzma ^>=0.0.1.0 diff --git a/src/Control/Carrier/FossaApiClient.hs b/src/Control/Carrier/FossaApiClient.hs index 8ae739460c..38794e917f 100644 --- a/src/Control/Carrier/FossaApiClient.hs +++ b/src/Control/Carrier/FossaApiClient.hs @@ -11,11 +11,22 @@ import Control.Carrier.Simple (SimpleC, interpret) import Control.Effect.Debug (Debug) import Control.Effect.Diagnostics (Diagnostics) import Control.Effect.FossaApiClient (FossaApiClientF (..)) -import Control.Effect.Lift (Lift) +import Control.Effect.Lift (Lift, sendIO) +import Data.Default.Class (def) import Fossa.API.Types (ApiOpts) +import Network.Connection (TLSSettings (TLSSettingsSimple, settingClientSupported)) +import Network.HTTP.Client (Manager, ManagerSettings, newManager) +import Network.HTTP.Client.TLS (mkManagerSettings) +import Network.TLS (EMSMode (AllowEMS), Supported (supportedExtendedMainSecret)) -- | A carrier to run FOSSA API functions in the IO monad -type FossaApiClientC m = SimpleC FossaApiClientF (ReaderC ApiOpts m) +type FossaApiClientC m = SimpleC FossaApiClientF (ReaderC Manager (ReaderC ApiOpts m)) + +emsTLSSettings :: TLSSettings +emsTLSSettings = + case def of + simple@TLSSettingsSimple{} -> simple{settingClientSupported = def{supportedExtendedMainSecret = AllowEMS}} + otherSettings -> otherSettings -- | Runs FossaAPI effects as IO operations runFossaApiClient :: @@ -26,65 +37,74 @@ runFossaApiClient :: ApiOpts -> FossaApiClientC m a -> m a -runFossaApiClient apiOpts = +runFossaApiClient apiOpts action = do + mgr <- sendIO $ newManager allowEMSManager runReader apiOpts - . interpret - ( \case - AddFilesToVsiScan scanId files -> VSI.addFilesToVsiScan scanId files - AssertRevisionBinaries locator fingerprints -> VSI.assertRevisionBinaries locator fingerprints - AssertUserDefinedBinaries meta fingerprints -> VSI.assertUserDefinedBinaries meta fingerprints - CompleteVsiScan scanId -> VSI.completeVsiScan scanId - CreateVsiScan rev -> VSI.createVsiScan rev - FinalizeLicenseScan components -> LicenseScanning.finalizeLicenseScan components - FinalizeLicenseScanForPathDependency locators forceRebuild -> LicenseScanning.finalizePathDependencyScan locators forceRebuild - GetApiOpts -> pure apiOpts - GetAttribution rev format -> Core.getAttribution rev format - GetIssues rev diffRev locatorType -> Core.getIssues rev diffRev locatorType - GetEndpointVersion -> Core.getEndpointVersion - GetLatestBuild rev locatorType -> Core.getLatestBuild rev locatorType - GetRevisionDependencyCacheStatus rev -> Core.getRevisionDependencyCacheStatus rev - GetOrganization -> Core.getOrganization - GetPolicies -> Core.getPolicies - GetProject rev locatorType -> Core.getProject rev locatorType - GetTeams -> Core.getTeams - AddTeamProjects teamId req -> Core.addTeamProjects teamId req - GetAnalyzedRevisions vdeps -> Core.getAnalyzedRevisions vdeps - GetSignedFirstPartyScanUrl rev -> LicenseScanning.getSignedFirstPartyScanUrl rev - GetSignedLicenseScanUrl rev -> LicenseScanning.getSignedLicenseScanUrl rev - GetSignedUploadUrl fileType rev -> Core.getSignedUploadUrl fileType rev - GetPathDependencyScanUrl rev projectRevision uploadKind -> LicenseScanning.uploadPathDependencyScanResult rev projectRevision uploadKind - GetVsiInferences scanId -> VSI.getVsiInferences scanId - GetVsiScanAnalysisStatus scanId -> VSI.getVsiScanAnalysisStatus scanId - QueueArchiveBuild archives rebuild -> Core.queueArchiveBuild archives rebuild - QueueSBOMBuild archive team rebuild -> Core.queueSBOMBuild archive team rebuild - ResolveProjectDependencies locator -> VSI.resolveProjectDependencies locator - ResolveUserDefinedBinary deps -> VSI.resolveUserDefinedBinary deps - UploadAnalysis rev metadata units -> Core.uploadAnalysis rev metadata units - UploadAnalysisWithFirstPartyLicenses rev metadata uploadKind -> Core.uploadAnalysisWithFirstPartyLicenses rev metadata uploadKind - UploadArchive url path -> Core.uploadArchive url path - UploadNativeContainerScan revision metadata scan -> Core.uploadNativeContainerScan revision metadata scan - UploadContributors locator contributors -> Core.uploadContributors locator contributors - UploadLicenseScanResult signedUrl licenseSourceUnit -> LicenseScanning.uploadLicenseScanResult signedUrl licenseSourceUnit - UploadFirstPartyScanResult signedUrl fullSourceUnits -> LicenseScanning.uploadFirstPartyScanResult signedUrl fullSourceUnits - GetAnalyzedPathRevisions projectRevision -> LicenseScanning.alreadyAnalyzedPathRevision projectRevision - -- Reachability - UploadContentForReachability content -> Core.uploadReachabilityContent content - UploadBuildForReachability rev metadata content -> Core.uploadReachabilityBuild rev metadata content - GetTokenType -> Core.getTokenType - GetCustomBuildPermissons rev metadata -> Core.getCustomBuildPermissions rev metadata - -- Release Group - DeleteReleaseGroup releaseGroupId -> Core.deleteReleaseGroup releaseGroupId - DeleteReleaseGroupRelease releaseGroupId releaseId -> Core.deleteReleaseGroupRelease releaseGroupId releaseId - UpdateReleaseGroupRelease releaseGroupId releaseId updateReq -> Core.updateReleaseGroupRelease releaseGroupId releaseId updateReq - GetReleaseGroups -> Core.getReleaseGroups - GetReleaseGroupReleases releaseGroupId -> Core.getReleaseGroupReleases releaseGroupId - CreateReleaseGroup req -> Core.createReleaseGroup req - -- Project - GetProjectV2 locator -> Core.getProjectV2 locator - UpdateProject locator req -> Core.updateProject locator req - -- Revision - UpdateRevision revisionLocator req -> Core.updateRevision revisionLocator req - -- Labels - GetOrgLabels -> Core.getOrgLabels - CreateReleaseGroupRelease releaseGroupId req -> Core.createReleaseGroupRelease releaseGroupId req - ) + . runReader mgr + . interpreter + $ action + where + allowEMSManager :: ManagerSettings + allowEMSManager = mkManagerSettings emsTLSSettings Nothing + + interpreter = + interpret + ( \case + AddFilesToVsiScan scanId files -> VSI.addFilesToVsiScan scanId files + AssertRevisionBinaries locator fingerprints -> VSI.assertRevisionBinaries locator fingerprints + AssertUserDefinedBinaries meta fingerprints -> VSI.assertUserDefinedBinaries meta fingerprints + CompleteVsiScan scanId -> VSI.completeVsiScan scanId + CreateVsiScan rev -> VSI.createVsiScan rev + FinalizeLicenseScan components -> LicenseScanning.finalizeLicenseScan components + FinalizeLicenseScanForPathDependency locators forceRebuild -> LicenseScanning.finalizePathDependencyScan locators forceRebuild + GetApiOpts -> pure apiOpts + GetAttribution rev format -> Core.getAttribution rev format + GetIssues rev diffRev locatorType -> Core.getIssues rev diffRev locatorType + GetEndpointVersion -> Core.getEndpointVersion + GetLatestBuild rev locatorType -> Core.getLatestBuild rev locatorType + GetRevisionDependencyCacheStatus rev -> Core.getRevisionDependencyCacheStatus rev + GetOrganization -> Core.getOrganization + GetPolicies -> Core.getPolicies + GetProject rev locatorType -> Core.getProject rev locatorType + GetTeams -> Core.getTeams + AddTeamProjects teamId req -> Core.addTeamProjects teamId req + GetAnalyzedRevisions vdeps -> Core.getAnalyzedRevisions vdeps + GetSignedFirstPartyScanUrl rev -> LicenseScanning.getSignedFirstPartyScanUrl rev + GetSignedLicenseScanUrl rev -> LicenseScanning.getSignedLicenseScanUrl rev + GetSignedUploadUrl fileType rev -> Core.getSignedUploadUrl fileType rev + GetPathDependencyScanUrl rev projectRevision uploadKind -> LicenseScanning.uploadPathDependencyScanResult rev projectRevision uploadKind + GetVsiInferences scanId -> VSI.getVsiInferences scanId + GetVsiScanAnalysisStatus scanId -> VSI.getVsiScanAnalysisStatus scanId + QueueArchiveBuild archives rebuild -> Core.queueArchiveBuild archives rebuild + QueueSBOMBuild archive team rebuild -> Core.queueSBOMBuild archive team rebuild + ResolveProjectDependencies locator -> VSI.resolveProjectDependencies locator + ResolveUserDefinedBinary deps -> VSI.resolveUserDefinedBinary deps + UploadAnalysis rev metadata units -> Core.uploadAnalysis rev metadata units + UploadAnalysisWithFirstPartyLicenses rev metadata uploadKind -> Core.uploadAnalysisWithFirstPartyLicenses rev metadata uploadKind + UploadArchive url path -> Core.uploadArchive url path + UploadNativeContainerScan revision metadata scan -> Core.uploadNativeContainerScan revision metadata scan + UploadContributors locator contributors -> Core.uploadContributors locator contributors + UploadLicenseScanResult signedUrl licenseSourceUnit -> LicenseScanning.uploadLicenseScanResult signedUrl licenseSourceUnit + UploadFirstPartyScanResult signedUrl fullSourceUnits -> LicenseScanning.uploadFirstPartyScanResult signedUrl fullSourceUnits + GetAnalyzedPathRevisions projectRevision -> LicenseScanning.alreadyAnalyzedPathRevision projectRevision + -- Reachability + UploadContentForReachability content -> Core.uploadReachabilityContent content + UploadBuildForReachability rev metadata content -> Core.uploadReachabilityBuild rev metadata content + GetTokenType -> Core.getTokenType + GetCustomBuildPermissons rev metadata -> Core.getCustomBuildPermissions rev metadata + -- Release Group + DeleteReleaseGroup releaseGroupId -> Core.deleteReleaseGroup releaseGroupId + DeleteReleaseGroupRelease releaseGroupId releaseId -> Core.deleteReleaseGroupRelease releaseGroupId releaseId + UpdateReleaseGroupRelease releaseGroupId releaseId updateReq -> Core.updateReleaseGroupRelease releaseGroupId releaseId updateReq + GetReleaseGroups -> Core.getReleaseGroups + GetReleaseGroupReleases releaseGroupId -> Core.getReleaseGroupReleases releaseGroupId + CreateReleaseGroup req -> Core.createReleaseGroup req + -- Project + GetProjectV2 locator -> Core.getProjectV2 locator + UpdateProject locator req -> Core.updateProject locator req + -- Revision + UpdateRevision revisionLocator req -> Core.updateRevision revisionLocator req + -- Labels + GetOrgLabels -> Core.getOrgLabels + CreateReleaseGroupRelease releaseGroupId req -> Core.createReleaseGroupRelease releaseGroupId req + ) diff --git a/src/Control/Carrier/FossaApiClient/Internal/Core.hs b/src/Control/Carrier/FossaApiClient/Internal/Core.hs index 9120cbeb1c..38e9755e14 100644 --- a/src/Control/Carrier/FossaApiClient/Internal/Core.hs +++ b/src/Control/Carrier/FossaApiClient/Internal/Core.hs @@ -44,10 +44,7 @@ import App.Types (ComponentUploadFileType (..), DependencyRebuild, FileUpload, L import Container.Types qualified as NativeContainer import Control.Algebra (Has) import Control.Carrier.FossaApiClient.Internal.FossaAPIV1 qualified as API -import Control.Effect.Debug (Debug) -import Control.Effect.Diagnostics (Diagnostics) import Control.Effect.FossaApiClient (PackageRevision (..)) -import Control.Effect.Lift (Lift) import Control.Effect.Reader (Reader, ask) import Control.Monad (void) import Data.Aeson (ToJSON) @@ -75,9 +72,7 @@ import Srclib.Types (Locator, SourceUnit, renderLocator) -- Fetches an organization from the API getOrganization :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m + ( API.APIClientEffs sig m , Has (Reader ApiOpts) sig m ) => m Organization @@ -88,9 +83,7 @@ getOrganization = do API.getOrganization apiOpts getTokenType :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m + ( API.APIClientEffs sig m , Has (Reader ApiOpts) sig m ) => m TokenTypeResponse @@ -99,10 +92,8 @@ getTokenType = do API.getTokenType apiOpts getCustomBuildPermissions :: - ( Has (Lift IO) sig m + ( API.APIClientEffs sig m , Has (Reader ApiOpts) sig m - , Has Debug sig m - , Has Diagnostics sig m ) => ProjectRevision -> ProjectMetadata -> @@ -112,9 +103,7 @@ getCustomBuildPermissions revision metadata = do API.getCustomBuildUploadPermissions apiOpts revision metadata getProject :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m + ( API.APIClientEffs sig m , Has (Reader ApiOpts) sig m ) => ProjectRevision -> @@ -125,9 +114,7 @@ getProject revision locatorType = do API.getProject apiOpts revision locatorType getAnalyzedRevisions :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m + ( API.APIClientEffs sig m , Has (Reader ApiOpts) sig m ) => NE.NonEmpty VendoredDependency -> @@ -137,10 +124,8 @@ getAnalyzedRevisions vdeps = do API.getAnalyzedRevisions apiOpts vdeps uploadAnalysis :: - ( Has (Lift IO) sig m - , Has (Reader ApiOpts) sig m - , Has Debug sig m - , Has Diagnostics sig m + ( Has (Reader ApiOpts) sig m + , API.APIClientEffs sig m ) => ProjectRevision -> ProjectMetadata -> @@ -151,10 +136,8 @@ uploadAnalysis revision metadata units = do API.uploadAnalysis apiOpts revision metadata units uploadAnalysisWithFirstPartyLicenses :: - ( Has (Lift IO) sig m + ( API.APIClientEffs sig m , Has (Reader ApiOpts) sig m - , Has Debug sig m - , Has Diagnostics sig m ) => ProjectRevision -> ProjectMetadata -> @@ -165,9 +148,7 @@ uploadAnalysisWithFirstPartyLicenses revision metadata uploadKind = do API.uploadAnalysisWithFirstPartyLicenses apiOpts revision metadata uploadKind uploadNativeContainerScan :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m + ( API.APIClientEffs sig m , Has (Reader ApiOpts) sig m ) => ProjectRevision -> @@ -179,9 +160,7 @@ uploadNativeContainerScan revision metadata scan = do API.uploadNativeContainerScan apiOpts revision metadata scan uploadContributors :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m + ( API.APIClientEffs sig m , Has (Reader ApiOpts) sig m ) => Locator -> @@ -192,9 +171,7 @@ uploadContributors locator contributors = do API.uploadContributors apiOpts (renderLocator locator) contributors getLatestBuild :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m + ( API.APIClientEffs sig m , Has (Reader ApiOpts) sig m ) => ProjectRevision -> @@ -205,9 +182,7 @@ getLatestBuild rev locatorType = do API.getLatestBuild apiOpts rev locatorType getIssues :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m + ( API.APIClientEffs sig m , Has (Reader ApiOpts) sig m ) => ProjectRevision -> @@ -219,9 +194,7 @@ getIssues rev diffRevision locatorType = do API.getIssues apiOpts rev diffRevision locatorType getAttribution :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m + ( API.APIClientEffs sig m , Has (Reader ApiOpts) sig m ) => ProjectRevision -> @@ -232,9 +205,7 @@ getAttribution revision format = do API.getAttribution apiOpts revision format getRevisionDependencyCacheStatus :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m + ( API.APIClientEffs sig m , Has (Reader ApiOpts) sig m ) => ProjectRevision -> @@ -244,9 +215,7 @@ getRevisionDependencyCacheStatus rev = do API.getRevisionDependencyCacheStatus apiOpts rev getSignedUploadUrl :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m + ( API.APIClientEffs sig m , Has (Reader ApiOpts) sig m ) => ComponentUploadFileType -> @@ -257,9 +226,7 @@ getSignedUploadUrl fileType PackageRevision{..} = do API.getSignedURL apiOpts fileType packageVersion packageName queueArchiveBuild :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m + ( API.APIClientEffs sig m , Has (Reader ApiOpts) sig m ) => [Archive] -> @@ -270,9 +237,7 @@ queueArchiveBuild archives rebuild = do API.archiveBuildUpload apiOpts archives rebuild queueSBOMBuild :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m + ( API.APIClientEffs sig m , Has (Reader ApiOpts) sig m ) => Archive -> @@ -284,9 +249,7 @@ queueSBOMBuild archive team rebuild = do API.sbomBuildUpload apiOpts archive team rebuild uploadArchive :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - ) => + (API.APIClientEffs sig m) => SignedURL -> FilePath -> m ByteString @@ -294,9 +257,7 @@ uploadArchive = API.archiveUpload getEndpointVersion :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m + ( API.APIClientEffs sig m , Has (Reader ApiOpts) sig m ) => m Text @@ -305,9 +266,7 @@ getEndpointVersion = do API.getEndpointVersion apiOpts uploadReachabilityContent :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m + ( API.APIClientEffs sig m , Has (Reader ApiOpts) sig m ) => ByteString -> @@ -318,9 +277,7 @@ uploadReachabilityContent content = do API.uploadReachabilityContent signedUrl content uploadReachabilityBuild :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m + ( API.APIClientEffs sig m , Has (Reader ApiOpts) sig m , ToJSON a ) => @@ -334,9 +291,7 @@ uploadReachabilityBuild pr metadata content = do void $ API.uploadReachabilityBuild signedUrl content createReleaseGroup :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m + ( API.APIClientEffs sig m , Has (Reader ApiOpts) sig m ) => CoreTypes.CreateReleaseGroupRequest -> @@ -346,9 +301,7 @@ createReleaseGroup req = do API.createReleaseGroup apiOpts req createReleaseGroupRelease :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m + ( API.APIClientEffs sig m , Has (Reader ApiOpts) sig m ) => Int -> @@ -359,9 +312,7 @@ createReleaseGroupRelease releaseGroupId req = do API.createReleaseGroupRelease apiOpts releaseGroupId req getPolicies :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m + ( API.APIClientEffs sig m , Has (Reader ApiOpts) sig m ) => m [CoreTypes.Policy] @@ -370,9 +321,7 @@ getPolicies = do API.getPolicies apiOpts getTeams :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m + ( API.APIClientEffs sig m , Has (Reader ApiOpts) sig m ) => m [CoreTypes.Team] @@ -381,9 +330,7 @@ getTeams = do API.getTeams apiOpts addTeamProjects :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m + ( API.APIClientEffs sig m , Has (Reader ApiOpts) sig m ) => Int -> @@ -394,9 +341,7 @@ addTeamProjects teamId req = do API.addTeamProjects apiOpts teamId req deleteReleaseGroup :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m + ( API.APIClientEffs sig m , Has (Reader ApiOpts) sig m ) => Int -> @@ -406,9 +351,7 @@ deleteReleaseGroup releaseGroupId = do API.deleteReleaseGroup apiOpts releaseGroupId deleteReleaseGroupRelease :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m + ( API.APIClientEffs sig m , Has (Reader ApiOpts) sig m ) => Int -> @@ -419,9 +362,7 @@ deleteReleaseGroupRelease releaseGroupId releaseId = do API.deleteReleaseGroupRelease apiOpts releaseGroupId releaseId updateReleaseGroupRelease :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m + ( API.APIClientEffs sig m , Has (Reader ApiOpts) sig m ) => Int -> @@ -433,9 +374,7 @@ updateReleaseGroupRelease releaseGroupId releaseId updateReq = do API.updateReleaseGroupRelease apiOpts releaseGroupId releaseId updateReq getReleaseGroups :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m + ( API.APIClientEffs sig m , Has (Reader ApiOpts) sig m ) => m [CoreTypes.ReleaseGroup] @@ -444,9 +383,7 @@ getReleaseGroups = do API.getReleaseGroups apiOpts getReleaseGroupReleases :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m + ( API.APIClientEffs sig m , Has (Reader ApiOpts) sig m ) => Int -> @@ -456,9 +393,7 @@ getReleaseGroupReleases releaseGroupId = do API.getReleaseGroupReleases apiOpts releaseGroupId getProjectV2 :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m + ( API.APIClientEffs sig m , Has (Reader ApiOpts) sig m ) => Text -> @@ -468,9 +403,7 @@ getProjectV2 locator = do API.getProjectV2 apiOpts locator updateProject :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m + ( API.APIClientEffs sig m , Has (Reader ApiOpts) sig m ) => Text -> @@ -481,9 +414,7 @@ updateProject locator req = do API.updateProject apiOpts locator req updateRevision :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m + ( API.APIClientEffs sig m , Has (Reader ApiOpts) sig m ) => Text -> @@ -494,9 +425,7 @@ updateRevision revisionLocator req = do API.updateRevision apiOpts revisionLocator req getOrgLabels :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m + ( API.APIClientEffs sig m , Has (Reader ApiOpts) sig m ) => m CoreTypes.Labels diff --git a/src/Control/Carrier/FossaApiClient/Internal/FossaAPIV1.hs b/src/Control/Carrier/FossaApiClient/Internal/FossaAPIV1.hs index d80c276c26..1495207033 100644 --- a/src/Control/Carrier/FossaApiClient/Internal/FossaAPIV1.hs +++ b/src/Control/Carrier/FossaApiClient/Internal/FossaAPIV1.hs @@ -44,6 +44,7 @@ module Control.Carrier.FossaApiClient.Internal.FossaAPIV1 ( getTokenType, getCustomBuildUploadPermissions, AnalysisService (..), + APIClientEffs, -- * Reachability getReachabilityContentSignedUrl, @@ -113,7 +114,7 @@ import App.Types ( import App.Version (versionNumber) import Codec.Compression.GZip qualified as GZIP import Container.Types qualified as NativeContainer -import Control.Algebra (Algebra, Has, type (:+:)) +import Control.Algebra (type (:+:)) import Control.Carrier.Empty.Maybe (Empty, EmptyC, runEmpty) import Control.Effect.Debug (Debug, debugLog) import Control.Effect.Diagnostics (Diagnostics, ToDiagnostic (..), context, errCtx, fatal, fatalText, fromMaybeText, warnOnErr, (<||>)) @@ -181,6 +182,7 @@ import Fossa.API.Types ( useApiOpts, ) +import Control.Effect.Reader import Data.Foldable (traverse_) import Fossa.API.CoreTypes qualified as CoreTypes import Network.HTTP.Client (responseStatus) @@ -190,6 +192,7 @@ import Network.HTTP.Req ( DELETE (DELETE), GET (GET), HttpBody (..), + HttpConfig (httpConfigAltManager), HttpException (..), LbsResponse, MonadHttp (..), @@ -253,8 +256,15 @@ newtype FossaReq m a = FossaReq {unFossaReq :: m a} instance Has (Lift IO) sig m => MonadIO (FossaReq m) where liftIO = sendIO -instance (Has (Lift IO) sig m, Has Diagnostics sig m) => MonadHttp (FossaReq m) where - getHttpConfig = pure httpConfigRetryTimeouts +setMgrFromReader :: Has (Reader HTTP.Manager) sig m => m HttpConfig +setMgrFromReader = do + mgr <- ask + pure httpConfigRetryTimeouts{httpConfigAltManager = Just mgr} + +type APIClientEffs sig m = (Has (Lift IO) sig m, Has Debug sig m, Has Diagnostics sig m, Has (Reader HTTP.Manager) sig m) + +instance APIClientEffs sig m => MonadHttp (FossaReq m) where + getHttpConfig = setMgrFromReader handleHttpException = FossaReq . fatal . mangleError newtype FossaReqAllow401 m a = FossaReqAllow401 {unFossaReqAllow401 :: EmptyC m a} @@ -263,8 +273,11 @@ newtype FossaReqAllow401 m a = FossaReqAllow401 {unFossaReqAllow401 :: EmptyC m instance Has (Lift IO) sig m => MonadIO (FossaReqAllow401 m) where liftIO = sendIO -instance (Has (Lift IO) sig m, Has Diagnostics sig m) => MonadHttp (FossaReqAllow401 m) where - getHttpConfig = pure httpConfigRetryTimeouts +instance + APIClientEffs sig m => + MonadHttp (FossaReqAllow401 m) + where + getHttpConfig = setMgrFromReader handleHttpException = FossaReqAllow401 . allow401 where allow401 :: HttpException -> EmptyC m a @@ -628,7 +641,7 @@ containerUploadUrl service baseurl = Sparkle -> baseurl /: "api" /: "proxy" /: "analysis" /: "api" /: "container" /: "upload" uploadNativeContainerScan :: - (Has (Lift IO) sig m, Has Debug sig m, Has Diagnostics sig m) => + (Has (Lift IO) sig m, Has Debug sig m, Has Diagnostics sig m, Has (Reader HTTP.Manager) sig m) => ApiOpts -> ProjectRevision -> ProjectMetadata -> @@ -681,7 +694,7 @@ req method url body resp scheme = context "Calling FOSSA API" $ Req.req method url body resp scheme uploadAnalysis :: - (Has (Lift IO) sig m, Has Diagnostics sig m, Has Debug sig m) => + APIClientEffs sig m => ApiOpts -> ProjectRevision -> ProjectMetadata -> @@ -707,7 +720,7 @@ customUploadPermissionUrl :: Url scheme -> Url scheme customUploadPermissionUrl baseurl = baseurl /: "api" /: "cli" /: "custom_build_permissions" getCustomBuildUploadPermissions :: - (Has (Lift IO) sig m, Has Diagnostics sig m, Has Debug sig m) => + APIClientEffs sig m => ApiOpts -> ProjectRevision -> ProjectMetadata -> @@ -729,7 +742,7 @@ getCustomBuildUploadPermissions apiOpts ProjectRevision{..} metadata = fossaReq pure (responseBody resp) uploadAnalysisWithFirstPartyLicenses :: - (Has (Lift IO) sig m, Has Debug sig m, Has Diagnostics sig m) => + APIClientEffs sig m => -- (Has (Lift IO) sig m, Has Debug sig m, Has Diagnostics sig m) => ApiOpts -> ProjectRevision -> ProjectMetadata -> @@ -865,10 +878,7 @@ projectEndpoint :: Url scheme -> OrgId -> Locator -> Url scheme projectEndpoint baseurl orgid locator = baseurl /: "api" /: "cli" /: renderLocatorUrl orgid locator /: "project" getProject :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m - ) => + APIClientEffs sig m => ApiOpts -> ProjectRevision -> LocatorType -> @@ -890,7 +900,7 @@ getAnalyzedRevisionsEndpoint baseurl = baseurl /: "api" /: "cli" /: "analyzedRev -- | getAnalyzedRevisions makes a request to Core with a list of locators that we are considering scanning -- Core will respond with a list of locators that have already been analyzed getAnalyzedRevisions :: - (Has (Lift IO) sig m, Has Debug sig m, Has Diagnostics sig m) => + APIClientEffs sig m => ApiOpts -> NonEmpty VendoredDependency -> m [Text] @@ -906,7 +916,7 @@ buildsEndpoint :: Url 'Https -> OrgId -> Locator -> Url 'Https buildsEndpoint baseurl orgId locator = baseurl /: "api" /: "cli" /: renderLocatorUrl orgId locator /: "latest_build" getLatestBuild :: - (Has (Lift IO) sig m, Has Debug sig m, Has Diagnostics sig m) => + APIClientEffs sig m => ApiOpts -> ProjectRevision -> LocatorType -> @@ -925,7 +935,7 @@ dependencyCacheReadyEndpoint :: Url 'Https -> OrgId -> Locator -> Url 'Https dependencyCacheReadyEndpoint baseurl orgId locator = baseurl /: "api" /: "cli" /: renderLocatorUrl orgId locator /: "dependencies-cache" /: "status" getRevisionDependencyCacheStatus :: - (Has (Lift IO) sig m, Has Debug sig m, Has Diagnostics sig m) => + APIClientEffs sig m => ApiOpts -> ProjectRevision -> m RevisionDependencyCache @@ -950,7 +960,7 @@ data BuildOptions = BuildOptions } archiveBuildUpload :: - (Has (Lift IO) sig m, Has Debug sig m, Has Diagnostics sig m) => + APIClientEffs sig m => ApiOpts -> [Archive] -> DependencyRebuild -> @@ -962,7 +972,7 @@ archiveBuildUpload apiOpts archives rebuild = context "request build for archive traverse_ (archiveBuildUpload' apiOpts options) archives sbomBuildUpload :: - (Has (Lift IO) sig m, Has Debug sig m, Has Diagnostics sig m) => + APIClientEffs sig m => ApiOpts -> Archive -> Maybe Text -> @@ -975,7 +985,7 @@ sbomBuildUpload apiOpts archive team rebuild = context "request build for sbom" void $ archiveBuildUpload' apiOpts options archive archiveBuildUpload' :: - (Has (Lift IO) sig m, Has Debug sig m, Has Diagnostics sig m) => + APIClientEffs sig m => ApiOpts -> BuildOptions -> Archive -> @@ -1000,7 +1010,7 @@ licenseScanFinalizeUrl :: Url 'Https -> Url 'Https licenseScanFinalizeUrl baseUrl = baseUrl /: "api" /: "license_scan" /: "finalize" licenseScanFinalize :: - (Has (Lift IO) sig m, Has Debug sig m, Has Diagnostics sig m) => + APIClientEffs sig m => ApiOpts -> ArchiveComponents -> m () @@ -1009,7 +1019,7 @@ licenseScanFinalize apiOpts archiveProjects = do pure () licenseScanFinalize' :: - (Has (Lift IO) sig m, Has Debug sig m, Has Diagnostics sig m) => + APIClientEffs sig m => ApiOpts -> ArchiveComponents -> m (Maybe ()) @@ -1030,7 +1040,7 @@ signedURLEndpoint :: Url 'Https -> Url 'Https signedURLEndpoint baseUrl = baseUrl /: "api" /: "components" /: "signed_url" getSignedURL :: - (Has (Lift IO) sig m, Has Debug sig m, Has Diagnostics sig m) => + APIClientEffs sig m => ApiOpts -> ComponentUploadFileType -> Text -> @@ -1052,7 +1062,7 @@ signedFirstPartyScanURLEndpoint :: Url 'Https -> Url 'Https signedFirstPartyScanURLEndpoint baseUrl = baseUrl /: "api" /: "first_party_scan" /: "signed_url" getSignedFirstPartyScanURL :: - (Has (Lift IO) sig m, Has Debug sig m, Has Diagnostics sig m) => + APIClientEffs sig m => ApiOpts -> Text -> Text -> @@ -1073,7 +1083,7 @@ signedLicenseScanURLEndpoint :: Url 'Https -> Url 'Https signedLicenseScanURLEndpoint baseUrl = baseUrl /: "api" /: "license_scan" /: "signed_url" getSignedLicenseScanURL :: - (Has (Lift IO) sig m, Has Debug sig m, Has Diagnostics sig m) => + APIClientEffs sig m => ApiOpts -> Text -> Text -> @@ -1091,7 +1101,7 @@ getSignedLicenseScanURL apiOpts revision packageName = fossaReq $ do ---------- The archive upload function uploads the file it is given directly to the signed URL it is provided. archiveUpload :: - (Has (Lift IO) sig m, Has Diagnostics sig m) => + APIClientEffs sig m => SignedURL -> FilePath -> m ByteString @@ -1111,7 +1121,7 @@ archiveUpload signedArcURI arcFile = fossaReq $ do ---------- The license scan result upload function uploads the JSON license result directly to the signed URL it is provided. licenseScanResultUpload :: - (Has (Lift IO) sig m, Has Diagnostics sig m) => + APIClientEffs sig m => SignedURL -> LicenseSourceUnit -> m LbsResponse @@ -1134,7 +1144,7 @@ licenseScanResultUpload signedUploadURI licenseScanResult = fossaReq $ do ---------- The first-party scan result upload function uploads the JSON license result directly to the signed URL it is provided. firstPartyScanResultUpload :: - (Has (Lift IO) sig m, Has Diagnostics sig m) => + APIClientEffs sig m => SignedURL -> NE.NonEmpty FullSourceUnit -> m LbsResponse @@ -1181,7 +1191,7 @@ issuesEndpoint :: Url 'Https -> OrgId -> Locator -> Url 'Https issuesEndpoint baseUrl orgId locator = baseUrl /: "api" /: "cli" /: renderLocatorUrl orgId locator /: "issues" getIssues :: - (Has (Lift IO) sig m, Has Debug sig m, Has Diagnostics sig m) => + APIClientEffs sig m => ApiOpts -> ProjectRevision -> Maybe DiffRevision -> @@ -1232,7 +1242,7 @@ attributionEndpoint baseurl orgId locator format = appendSegment format $ baseur ReportCSV -> input /: "full" /: "CSV" getAttributionJson :: - (Has (Lift IO) sig m, Has Debug sig m, Has Diagnostics sig m) => + APIClientEffs sig m => ApiOpts -> ProjectRevision -> m Attr.Attribution @@ -1255,7 +1265,7 @@ getAttributionJson apiOpts ProjectRevision{..} = fossaReq $ do pure (responseBody response) getAttribution :: - (Has (Lift IO) sig m, Has Debug sig m, Has Diagnostics sig m) => + APIClientEffs sig m => ApiOpts -> ProjectRevision -> ReportOutputFormat -> @@ -1277,7 +1287,7 @@ getAttribution apiOpts ProjectRevision{..} format = fossaReq $ do organizationEndpoint :: Url scheme -> Url scheme organizationEndpoint baseurl = baseurl /: "api" /: "cli" /: "organization" -getOrganization :: (Has (Lift IO) sig m, Has Debug sig m, Has Diagnostics sig m) => ApiOpts -> m Organization +getOrganization :: APIClientEffs sig m => ApiOpts -> m Organization getOrganization apiOpts = fossaReq $ do (baseUrl, baseOpts) <- useApiOpts apiOpts responseBody <$> req GET (organizationEndpoint baseUrl) NoReqBody jsonResponse baseOpts @@ -1287,7 +1297,7 @@ getOrganization apiOpts = fossaReq $ do tokenTypeEndpoint :: Url scheme -> Url scheme tokenTypeEndpoint baseurl = baseurl /: "api" /: "cli" /: "token_type" -getTokenType :: (Has (Lift IO) sig m, Has Debug sig m, Has Diagnostics sig m) => ApiOpts -> m TokenTypeResponse +getTokenType :: APIClientEffs sig m => ApiOpts -> m TokenTypeResponse getTokenType apiOpts = fossaReq $ do (baseUrl, baseOpts) <- useApiOpts apiOpts responseBody <$> req GET (tokenTypeEndpoint baseUrl) NoReqBody jsonResponse baseOpts @@ -1295,7 +1305,7 @@ getTokenType apiOpts = fossaReq $ do contributorsEndpoint :: Url scheme -> Url scheme contributorsEndpoint baseurl = baseurl /: "api" /: "contributors" -uploadContributors :: (Has (Lift IO) sig m, Has Debug sig m, Has Diagnostics sig m) => ApiOpts -> Text -> Contributors -> m () +uploadContributors :: APIClientEffs sig m => ApiOpts -> Text -> Contributors -> m () uploadContributors apiOpts locator contributors = fossaReq $ do (baseUrl, baseOpts) <- useApiOpts apiOpts @@ -1342,7 +1352,7 @@ instance ToJSON UserDefinedAssertionBody where assertUserDefinedBinariesEndpoint :: Url scheme -> Url scheme assertUserDefinedBinariesEndpoint baseurl = baseurl /: "api" /: "iat" /: "binary" -assertUserDefinedBinaries :: (Has (Lift IO) sig m, Has Debug sig m, Has Diagnostics sig m) => ApiOpts -> IAT.UserDefinedAssertionMeta -> [Fingerprint Raw] -> m () +assertUserDefinedBinaries :: APIClientEffs sig m => ApiOpts -> IAT.UserDefinedAssertionMeta -> [Fingerprint Raw] -> m () assertUserDefinedBinaries apiOpts IAT.UserDefinedAssertionMeta{..} fingerprints = fossaReq $ do (baseUrl, baseOpts) <- useApiOpts apiOpts let body = UserDefinedAssertionBody assertedName assertedVersion assertedLicense assertedDescription assertedUrl (FingerprintAssertion <$> fingerprints) @@ -1352,7 +1362,7 @@ assertUserDefinedBinaries apiOpts IAT.UserDefinedAssertionMeta{..} fingerprints assertRevisionBinariesEndpoint :: Url scheme -> Locator -> Url scheme assertRevisionBinariesEndpoint baseurl locator = baseurl /: "api" /: "iat" /: "binary" /: renderLocator locator -assertRevisionBinaries :: (Has (Lift IO) sig m, Has Debug sig m, Has Diagnostics sig m) => ApiOpts -> Locator -> [Fingerprint Raw] -> m () +assertRevisionBinaries :: APIClientEffs sig m => ApiOpts -> Locator -> [Fingerprint Raw] -> m () assertRevisionBinaries apiOpts locator fingerprints = fossaReq $ do (baseUrl, baseOpts) <- useApiOpts apiOpts let body = FingerprintAssertion <$> fingerprints @@ -1362,7 +1372,7 @@ assertRevisionBinaries apiOpts locator fingerprints = fossaReq $ do resolveUserDefinedBinaryEndpoint :: Url scheme -> IAT.UserDep -> Url scheme resolveUserDefinedBinaryEndpoint baseurl dep = baseurl /: "api" /: "iat" /: "resolve" /: "user-defined" /: IAT.renderUserDep dep -resolveUserDefinedBinary :: (Has (Lift IO) sig m, Has Debug sig m, Has Diagnostics sig m) => ApiOpts -> IAT.UserDep -> m IAT.UserDefinedAssertionMeta +resolveUserDefinedBinary :: APIClientEffs sig m => ApiOpts -> IAT.UserDep -> m IAT.UserDefinedAssertionMeta resolveUserDefinedBinary apiOpts dep = fossaReq $ do (baseUrl, baseOpts) <- useApiOpts apiOpts responseBody <$> req GET (resolveUserDefinedBinaryEndpoint baseUrl dep) NoReqBody jsonResponse baseOpts @@ -1377,7 +1387,7 @@ instance FromJSON ResolvedDependency where resolveProjectDependenciesEndpoint :: Url scheme -> VSI.Locator -> Url scheme resolveProjectDependenciesEndpoint baseurl locator = baseurl /: "api" /: "revisions" /: VSI.renderLocator locator /: "dependencies" -resolveProjectDependencies :: (Has (Lift IO) sig m, Has Debug sig m, Has Diagnostics sig m) => ApiOpts -> VSI.Locator -> m [VSI.Locator] +resolveProjectDependencies :: APIClientEffs sig m => ApiOpts -> VSI.Locator -> m [VSI.Locator] resolveProjectDependencies apiOpts locator = fossaReq $ do (baseUrl, baseOpts) <- useApiOpts apiOpts @@ -1428,7 +1438,7 @@ instance FromJSON VSICreateScanResponseBody where vsiCreateScanEndpoint :: Url scheme -> Url scheme vsiCreateScanEndpoint baseurl = baseVsiUrl baseurl /: "scans" -vsiCreateScan :: (Has (Lift IO) sig m, Has Debug sig m, Has Diagnostics sig m) => ApiOpts -> ProjectRevision -> m VSI.ScanID +vsiCreateScan :: APIClientEffs sig m => ApiOpts -> ProjectRevision -> m VSI.ScanID vsiCreateScan apiOpts ProjectRevision{..} = fossaReq $ do (baseUrl, baseOpts) <- useApiOpts apiOpts @@ -1447,7 +1457,7 @@ instance ToJSON VSIAddFilesToScanRequestBody where vsiAddFilesToScanEndpoint :: Url scheme -> VSI.ScanID -> Url scheme vsiAddFilesToScanEndpoint baseurl (VSI.ScanID scanID) = baseVsiUrl baseurl /: "scans" /: scanID /: "files" -vsiAddFilesToScan :: (Has (Lift IO) sig m, Has Debug sig m, Has Diagnostics sig m) => ApiOpts -> VSI.ScanID -> Map (Path Rel File) Fingerprint.Combined -> m () +vsiAddFilesToScan :: APIClientEffs sig m => ApiOpts -> VSI.ScanID -> Map (Path Rel File) Fingerprint.Combined -> m () vsiAddFilesToScan apiOpts scanID files = fossaReq $ do (baseUrl, baseOpts) <- useApiOpts apiOpts @@ -1481,7 +1491,7 @@ instance ToJSON VSICompleteScanRequestBody where vsiCompleteScanEndpoint :: Url scheme -> VSI.ScanID -> Url scheme vsiCompleteScanEndpoint baseurl (VSI.ScanID scanID) = baseVsiUrl baseurl /: "scans" /: scanID /: "complete" -vsiCompleteScan :: (Has (Lift IO) sig m, Has Debug sig m, Has Diagnostics sig m) => ApiOpts -> VSI.ScanID -> m () +vsiCompleteScan :: APIClientEffs sig m => ApiOpts -> VSI.ScanID -> m () vsiCompleteScan apiOpts scanID = fossaReq $ do (baseUrl, baseOpts) <- useApiOpts apiOpts @@ -1505,7 +1515,7 @@ instance FromJSON VSIScanAnalysisStatusBody where vsiScanAnalysisStatusEndpoint :: Url scheme -> VSI.ScanID -> Url scheme vsiScanAnalysisStatusEndpoint baseurl (VSI.ScanID scanID) = baseVsiUrl baseurl /: "scans" /: scanID /: "status" /: "analysis" -vsiScanAnalysisStatus :: (Has (Lift IO) sig m, Has Debug sig m, Has Diagnostics sig m) => ApiOpts -> VSI.ScanID -> m VSI.AnalysisStatus +vsiScanAnalysisStatus :: APIClientEffs sig m => ApiOpts -> VSI.ScanID -> m VSI.AnalysisStatus vsiScanAnalysisStatus apiOpts scanID = fossaReq $ do (baseUrl, baseOpts) <- useApiOpts apiOpts body <- responseBody <$> req GET (vsiScanAnalysisStatusEndpoint baseUrl scanID) NoReqBody jsonResponse baseOpts @@ -1514,7 +1524,7 @@ vsiScanAnalysisStatus apiOpts scanID = fossaReq $ do vsiDownloadInferencesEndpoint :: Url scheme -> VSI.ScanID -> Url scheme vsiDownloadInferencesEndpoint baseurl (VSI.ScanID scanID) = baseVsiUrl baseurl /: "scans" /: scanID /: "inferences" -vsiDownloadInferences :: (Has (Lift IO) sig m, Has Debug sig m, Has Diagnostics sig m) => ApiOpts -> VSI.ScanID -> m VSI.VsiExportedInferencesBody +vsiDownloadInferences :: APIClientEffs sig m => ApiOpts -> VSI.ScanID -> m VSI.VsiExportedInferencesBody vsiDownloadInferences apiOpts scanID = fossaReq $ do (baseUrl, baseOpts) <- useApiOpts apiOpts responseBody <$> req GET (vsiDownloadInferencesEndpoint baseUrl scanID) NoReqBody jsonResponse baseOpts @@ -1527,7 +1537,7 @@ newtype AppManifest = AppManifest {endpointAppVersion :: Text} deriving (Show, E instance FromXML AppManifest where parseElement el = AppManifest <$> child "version" el -getEndpointVersion :: (Has (Lift IO) sig m, Has Debug sig m, Has Diagnostics sig m) => ApiOpts -> m Text +getEndpointVersion :: APIClientEffs sig m => ApiOpts -> m Text getEndpointVersion apiOpts = fossaReq $ do (baseUrl, baseOpts) <- useApiOpts apiOpts body <- responseBody <$> req GET (endpointAppManifest baseUrl) NoReqBody bsResponse baseOpts @@ -1541,7 +1551,7 @@ signedLicenseScanPathDependencyURLEndpoint :: Url 'Https -> Url 'Https signedLicenseScanPathDependencyURLEndpoint baseUrl = baseUrl /: "api" /: "cli" /: "path_dependency_scan" /: "upload" getUploadURLForPathDependency :: - (Has (Lift IO) sig m, Has Debug sig m, Has Diagnostics sig m) => + APIClientEffs sig m => ApiOpts -> Text -> Text -> @@ -1561,7 +1571,7 @@ pathDependencyFinalizeUrl :: Url 'Https -> Url 'Https pathDependencyFinalizeUrl baseUrl = baseUrl /: "api" /: "cli" /: "path_dependency_scan" /: "finalize" finalizePathDependencyScan :: - (Has (Lift IO) sig m, Has Debug sig m, Has Diagnostics sig m) => + APIClientEffs sig m => ApiOpts -> [Locator] -> Bool -> @@ -1579,7 +1589,7 @@ alreadyAnalyzedPathRevisionURLEndpoint :: Url 'Https -> Locator -> Url 'Https alreadyAnalyzedPathRevisionURLEndpoint baseUrl locator = baseUrl /: "api" /: "cli" /: "path_dependency_scan" /: renderLocator locator /: "analyzed" alreadyAnalyzedPathRevision :: - (Has (Lift IO) sig m, Has Debug sig m, Has Diagnostics sig m) => + APIClientEffs sig m => ApiOpts -> ProjectRevision -> m (AnalyzedPathDependenciesResp) @@ -1601,10 +1611,7 @@ signedReachabilityBuildURLEndpoint :: Url 'Https -> Url 'Https signedReachabilityBuildURLEndpoint baseUrl = baseUrl /: "api" /: "cli" /: "reachability" /: "build" /: "upload" getReachabilityContentSignedUrl :: - ( Has (Lift IO) sig m - , Has Debug sig m - , Has Diagnostics sig m - ) => + APIClientEffs sig m => ApiOpts -> Map Text Text -> m SignedURLWithKey @@ -1616,10 +1623,7 @@ getReachabilityContentSignedUrl apiOpts metadata = fossaReq $ do pure (responseBody response) getReachabilityBuildSignedUrl :: - ( Has (Lift IO) sig m - , Has Debug sig m - , Has Diagnostics sig m - ) => + APIClientEffs sig m => ApiOpts -> ProjectRevision -> ProjectMetadata -> @@ -1636,10 +1640,7 @@ getReachabilityBuildSignedUrl apiOpts ProjectRevision{..} metadata = fossaReq $ pure (responseBody response) uploadReachabilityBuild :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , ToJSON a - ) => + (APIClientEffs sig m, ToJSON a) => SignedURL -> a -> m LbsResponse @@ -1660,9 +1661,7 @@ uploadReachabilityBuild signedUrl content = fossaReq $ do uploadReq url options = reqCb PUT url (ReqBodyBs encoded) lbsResponse options (pure . requestEncoder) uploadReachabilityContent :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - ) => + APIClientEffs sig m => SignedURLWithKey -> ByteString -> m (Text) @@ -1692,10 +1691,7 @@ policiesURLEndpoint :: Url 'Https -> Url 'Https policiesURLEndpoint baseUrl = baseUrl /: "api" /: "policies" getPolicies :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m - ) => + APIClientEffs sig m => ApiOpts -> m [CoreTypes.Policy] getPolicies apiOpts = fossaReq $ do @@ -1709,10 +1705,7 @@ teamsURLEndpoint :: Url 'Https -> Url 'Https teamsURLEndpoint baseUrl = baseUrl /: "api" /: "teams" getTeams :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m - ) => + APIClientEffs sig m => ApiOpts -> m [CoreTypes.Team] getTeams apiOpts = fossaReq $ do @@ -1726,10 +1719,7 @@ addTeamProjectsURLEndpoint :: Url 'Https -> Text -> Url 'Https addTeamProjectsURLEndpoint baseUrl teamId = baseUrl /: "api" /: "teams" /: teamId /: "projects" addTeamProjects :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m - ) => + APIClientEffs sig m => ApiOpts -> Int -> CoreTypes.AddTeamProjectsRequest -> @@ -1745,10 +1735,7 @@ deleteReleaseGroupURLEndpoint :: Url 'Https -> Text -> Url 'Https deleteReleaseGroupURLEndpoint baseUrl releaseGroupId = baseUrl /: "api" /: "project_group" /: releaseGroupId deleteReleaseGroup :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m - ) => + APIClientEffs sig m => ApiOpts -> Int -> m () @@ -1762,10 +1749,7 @@ specifiedReleaseGroupReleaseURLEndpoint :: Url 'Https -> Text -> Text -> Url 'Ht specifiedReleaseGroupReleaseURLEndpoint baseUrl releaseGroupId releaseId = baseUrl /: "api" /: "project_group" /: releaseGroupId /: "release" /: releaseId deleteReleaseGroupRelease :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m - ) => + APIClientEffs sig m => ApiOpts -> Int -> Int -> @@ -1777,10 +1761,7 @@ deleteReleaseGroupRelease apiOpts releaseGroupId releaseId = fossaReq $ do req DELETE (specifiedReleaseGroupReleaseURLEndpoint baseUrl (toText releaseGroupId) $ toText releaseId) NoReqBody ignoreResponse baseOpts updateReleaseGroupRelease :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m - ) => + APIClientEffs sig m => ApiOpts -> Int -> Int -> @@ -1797,10 +1778,7 @@ releaseGroupURLEndpoint :: Url 'Https -> Url 'Https releaseGroupURLEndpoint baseUrl = baseUrl /: "api" /: "project_group" createReleaseGroup :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m - ) => + APIClientEffs sig m => ApiOpts -> CoreTypes.CreateReleaseGroupRequest -> m CoreTypes.CreateReleaseGroupResponse @@ -1812,10 +1790,7 @@ createReleaseGroup apiOpts createReleaseGroupReq = fossaReq $ do pure (responseBody resp) getReleaseGroups :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m - ) => + APIClientEffs sig m => ApiOpts -> m [CoreTypes.ReleaseGroup] getReleaseGroups apiOpts = fossaReq $ do @@ -1829,10 +1804,7 @@ releaseGroupReleaseURLEndpoint :: Url 'Https -> Text -> Url 'Https releaseGroupReleaseURLEndpoint baseUrl releaseGroupId = baseUrl /: "api" /: "project_group" /: releaseGroupId /: "release" getReleaseGroupReleases :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m - ) => + APIClientEffs sig m => ApiOpts -> Int -> m [CoreTypes.ReleaseGroupRelease] @@ -1844,10 +1816,7 @@ getReleaseGroupReleases apiOpts releaseGroupId = fossaReq $ do pure (responseBody resp) createReleaseGroupRelease :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m - ) => + APIClientEffs sig m => ApiOpts -> Int -> ReleaseGroupReleaseRevision -> @@ -1863,10 +1832,7 @@ updateProjectURLEndpoint :: Url 'Https -> Text -> Url 'Https updateProjectURLEndpoint baseUrl locator = baseUrl /: "api" /: "projects" /: locator updateProject :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m - ) => + APIClientEffs sig m => ApiOpts -> Text -> CoreTypes.UpdateProjectRequest -> @@ -1882,10 +1848,7 @@ updateRevisionURLEndpoint :: Url 'Https -> Text -> Url 'Https updateRevisionURLEndpoint baseUrl revisionLocator = baseUrl /: "api" /: "revisions" /: revisionLocator updateRevision :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m - ) => + APIClientEffs sig m => ApiOpts -> Text -> CoreTypes.UpdateRevisionRequest -> @@ -1902,10 +1865,7 @@ getProjectV2URLEndpoint :: Url 'Https -> Text -> Url 'Https getProjectV2URLEndpoint baseUrl locator = baseUrl /: "api" /: "projects" /: locator getProjectV2 :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m - ) => + APIClientEffs sig m => ApiOpts -> Text -> m CoreTypes.Project @@ -1920,10 +1880,7 @@ getOrgLabelsURLEndpoint :: Url 'Https -> Url 'Https getOrgLabelsURLEndpoint baseUrl = baseUrl /: "api" /: "organizations" /: "labels" getOrgLabels :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m - ) => + APIClientEffs sig m => ApiOpts -> m CoreTypes.Labels getOrgLabels apiOpts = fossaReq $ do diff --git a/src/Control/Carrier/FossaApiClient/Internal/LicenseScanning.hs b/src/Control/Carrier/FossaApiClient/Internal/LicenseScanning.hs index a996c50449..7cc1a47c0d 100644 --- a/src/Control/Carrier/FossaApiClient/Internal/LicenseScanning.hs +++ b/src/Control/Carrier/FossaApiClient/Internal/LicenseScanning.hs @@ -14,10 +14,7 @@ module Control.Carrier.FossaApiClient.Internal.LicenseScanning ( import App.Types (FileUpload, ProjectRevision) import Control.Algebra (Has) import Control.Carrier.FossaApiClient.Internal.FossaAPIV1 qualified as API -import Control.Effect.Debug (Debug) -import Control.Effect.Diagnostics (Diagnostics) import Control.Effect.FossaApiClient (PackageRevision (..)) -import Control.Effect.Lift (Lift) import Control.Effect.Reader (Reader, ask) import Control.Monad (void) import Data.List.NonEmpty qualified as NE @@ -25,9 +22,7 @@ import Fossa.API.Types (AnalyzedPathDependenciesResp (analyzedPathDeps), Analyze import Srclib.Types (FullSourceUnit, LicenseSourceUnit, Locator) getSignedFirstPartyScanUrl :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m + ( API.APIClientEffs sig m , Has (Reader ApiOpts) sig m ) => PackageRevision -> @@ -37,9 +32,7 @@ getSignedFirstPartyScanUrl PackageRevision{..} = do API.getSignedFirstPartyScanURL apiOpts packageVersion packageName getSignedLicenseScanUrl :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m + ( API.APIClientEffs sig m , Has (Reader ApiOpts) sig m ) => PackageRevision -> @@ -49,9 +42,7 @@ getSignedLicenseScanUrl PackageRevision{..} = do API.getSignedLicenseScanURL apiOpts packageVersion packageName finalizeLicenseScan :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m + ( API.APIClientEffs sig m , Has (Reader ApiOpts) sig m ) => ArchiveComponents -> @@ -61,9 +52,7 @@ finalizeLicenseScan components = do void $ API.licenseScanFinalize apiOpts components uploadLicenseScanResult :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - ) => + (API.APIClientEffs sig m) => SignedURL -> LicenseSourceUnit -> m () @@ -71,9 +60,7 @@ uploadLicenseScanResult signedUrl licenseSourceUnit = do void $ API.licenseScanResultUpload signedUrl licenseSourceUnit uploadFirstPartyScanResult :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - ) => + (API.APIClientEffs sig m) => SignedURL -> NE.NonEmpty FullSourceUnit -> m () @@ -81,9 +68,7 @@ uploadFirstPartyScanResult signedUrl fullSourceUnits = do void $ API.firstPartyScanResultUpload signedUrl fullSourceUnits uploadPathDependencyScanResult :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m + ( API.APIClientEffs sig m , Has (Reader ApiOpts) sig m ) => PackageRevision -> @@ -95,9 +80,7 @@ uploadPathDependencyScanResult PackageRevision{..} projectRevision fullFileUploa API.getUploadURLForPathDependency apiOpts packageName packageVersion projectRevision fullFileUpload finalizePathDependencyScan :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m + ( API.APIClientEffs sig m , Has (Reader ApiOpts) sig m ) => [Locator] -> @@ -108,9 +91,7 @@ finalizePathDependencyScan locators forceRebuild = do void $ API.finalizePathDependencyScan apiOpts locators forceRebuild alreadyAnalyzedPathRevision :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m + ( API.APIClientEffs sig m , Has (Reader ApiOpts) sig m ) => ProjectRevision -> diff --git a/src/Control/Carrier/FossaApiClient/Internal/VSI.hs b/src/Control/Carrier/FossaApiClient/Internal/VSI.hs index a491be45e1..940a3bdbe7 100644 --- a/src/Control/Carrier/FossaApiClient/Internal/VSI.hs +++ b/src/Control/Carrier/FossaApiClient/Internal/VSI.hs @@ -17,9 +17,6 @@ import App.Fossa.VSI.Types qualified as VSI import App.Types (ProjectRevision) import Control.Algebra (Has) import Control.Carrier.FossaApiClient.Internal.FossaAPIV1 qualified as API -import Control.Effect.Debug (Debug) -import Control.Effect.Diagnostics (Diagnostics) -import Control.Effect.Lift (Lift) import Control.Effect.Reader (Reader, ask) import Data.Map (Map) import Fossa.API.Types (ApiOpts) @@ -27,9 +24,7 @@ import Path (File, Path, Rel) import Srclib.Types (Locator) assertRevisionBinaries :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m + ( API.APIClientEffs sig m , Has (Reader ApiOpts) sig m ) => Locator -> @@ -40,9 +35,7 @@ assertRevisionBinaries meta fingerprints = do API.assertRevisionBinaries apiOpts meta fingerprints assertUserDefinedBinaries :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m + ( API.APIClientEffs sig m , Has (Reader ApiOpts) sig m ) => IAT.UserDefinedAssertionMeta -> @@ -53,9 +46,7 @@ assertUserDefinedBinaries meta fingerprints = do API.assertUserDefinedBinaries apiOpts meta fingerprints resolveUserDefinedBinary :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m + ( API.APIClientEffs sig m , Has (Reader ApiOpts) sig m ) => IAT.UserDep -> @@ -65,9 +56,7 @@ resolveUserDefinedBinary dep = do API.resolveUserDefinedBinary apiOpts dep resolveProjectDependencies :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m + ( API.APIClientEffs sig m , Has (Reader ApiOpts) sig m ) => VSI.Locator -> @@ -77,9 +66,7 @@ resolveProjectDependencies locator = do API.resolveProjectDependencies apiOpts locator createVsiScan :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m + ( API.APIClientEffs sig m , Has (Reader ApiOpts) sig m ) => ProjectRevision -> @@ -89,9 +76,7 @@ createVsiScan revision = do API.vsiCreateScan apiOpts revision addFilesToVsiScan :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m + ( API.APIClientEffs sig m , Has (Reader ApiOpts) sig m ) => VSI.ScanID -> @@ -102,9 +87,7 @@ addFilesToVsiScan scanId files = do API.vsiAddFilesToScan apiOpts scanId files completeVsiScan :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m + ( API.APIClientEffs sig m , Has (Reader ApiOpts) sig m ) => VSI.ScanID -> @@ -114,9 +97,7 @@ completeVsiScan scanId = do API.vsiCompleteScan apiOpts scanId getVsiScanAnalysisStatus :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m + ( API.APIClientEffs sig m , Has (Reader ApiOpts) sig m ) => VSI.ScanID -> @@ -126,9 +107,7 @@ getVsiScanAnalysisStatus scanId = do API.vsiScanAnalysisStatus apiOpts scanId getVsiInferences :: - ( Has (Lift IO) sig m - , Has Diagnostics sig m - , Has Debug sig m + ( API.APIClientEffs sig m , Has (Reader ApiOpts) sig m ) => VSI.ScanID -> From 400ea03ddf59ace18c74eb4fac2e83fd2947bead Mon Sep 17 00:00:00 2001 From: Christopher Sasarak Date: Tue, 23 Jul 2024 14:21:10 -0500 Subject: [PATCH 04/21] Bump again. --- cabal.project.common | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cabal.project.common b/cabal.project.common index 1a80fb29bb..b266dfecf9 100644 --- a/cabal.project.common +++ b/cabal.project.common @@ -57,4 +57,4 @@ source-repository-package location: https://github.com/fossas/codec-rpm tag: 0f7431423d47fdf36945e4ff31fbee76005b7e68 -index-state: hackage.haskell.org 2024-07-02T15:24:00Z +index-state: hackage.haskell.org 2024-07-12T14:59:44Z From e76c47ebcf2d2ff5097e4f3e188232c2be77d97a Mon Sep 17 00:00:00 2001 From: Christopher Sasarak Date: Wed, 14 Aug 2024 17:00:27 -0500 Subject: [PATCH 05/21] Another bump. --- cabal.project.common | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cabal.project.common b/cabal.project.common index b266dfecf9..15f6f747b4 100644 --- a/cabal.project.common +++ b/cabal.project.common @@ -57,4 +57,4 @@ source-repository-package location: https://github.com/fossas/codec-rpm tag: 0f7431423d47fdf36945e4ff31fbee76005b7e68 -index-state: hackage.haskell.org 2024-07-12T14:59:44Z +index-state: hackage.haskell.org 2024-08-14T18:49:08Z From 580d7ef803ced9bda3b8e20663d04d689cc871dc Mon Sep 17 00:00:00 2001 From: Christopher Sasarak Date: Thu, 15 Aug 2024 10:27:11 -0500 Subject: [PATCH 06/21] Commentary for reverting the AllowEMS change. --- src/Control/Carrier/FossaApiClient.hs | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/src/Control/Carrier/FossaApiClient.hs b/src/Control/Carrier/FossaApiClient.hs index 38794e917f..1faa089d12 100644 --- a/src/Control/Carrier/FossaApiClient.hs +++ b/src/Control/Carrier/FossaApiClient.hs @@ -19,6 +19,13 @@ import Network.HTTP.Client (Manager, ManagerSettings, newManager) import Network.HTTP.Client.TLS (mkManagerSettings) import Network.TLS (EMSMode (AllowEMS), Supported (supportedExtendedMainSecret)) +-- TODO: Remove the ReaderC Manager layer. +-- This was created so that we can use AllowEMS for a few older servers that still require it. +-- In 10/24 we've said we'll be reverting this change. +-- After fixing the related errors, you should also be able to remove these deps from spectrometer.cabal: +-- 1. crypton-connection +-- 2. http-client-tls +-- 3. data-default-class -- | A carrier to run FOSSA API functions in the IO monad type FossaApiClientC m = SimpleC FossaApiClientF (ReaderC Manager (ReaderC ApiOpts m)) From 452ed8275bb61f721bc78d48ead303fa406ba2c1 Mon Sep 17 00:00:00 2001 From: Christopher Sasarak Date: Thu, 15 Aug 2024 10:36:37 -0500 Subject: [PATCH 07/21] Make fourmolu happy. --- src/Control/Carrier/FossaApiClient.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Control/Carrier/FossaApiClient.hs b/src/Control/Carrier/FossaApiClient.hs index 1faa089d12..2931098630 100644 --- a/src/Control/Carrier/FossaApiClient.hs +++ b/src/Control/Carrier/FossaApiClient.hs @@ -26,6 +26,7 @@ import Network.TLS (EMSMode (AllowEMS), Supported (supportedExtendedMainSecret)) -- 1. crypton-connection -- 2. http-client-tls -- 3. data-default-class + -- | A carrier to run FOSSA API functions in the IO monad type FossaApiClientC m = SimpleC FossaApiClientF (ReaderC Manager (ReaderC ApiOpts m)) From 13147f83e1e86ddbf4b3b7bcf33850dbf7ee3d5b Mon Sep 17 00:00:00 2001 From: Christopher Sasarak Date: Thu, 15 Aug 2024 17:19:31 -0500 Subject: [PATCH 08/21] Bump versions/packages for compatibility with GHC 9.8. --- cabal.project.common | 12 +++++++++++- spectrometer.cabal | 6 +++--- src/App/Fossa/Reachability/Gradle.hs | 2 +- src/App/Fossa/Reachability/Maven.hs | 3 +-- src/Strategy/Cargo.hs | 2 +- test/App/Fossa/Report/AttributionSpec.hs | 2 +- test/Test/Fixtures.hs | 4 ++-- 7 files changed, 20 insertions(+), 11 deletions(-) diff --git a/cabal.project.common b/cabal.project.common index 15f6f747b4..8c7cf41d7a 100644 --- a/cabal.project.common +++ b/cabal.project.common @@ -14,6 +14,16 @@ allow-newer: -- was in 2018, so we may have to fork when breakage occurs , codec-rpm:attoparsec + -- transformers has a few breaking changes from 0.5 -> 0.6. + -- But the removed symbols were already deprecated in 0.5. + -- fused-effects-exceptions has a PR out: https://github.com/fused-effects/fused-effects-exceptions/pull/22 + -- When that merges you should be able to remove it from here. + -- lzma-conduit seems kind of moribund. + -- I've left an issue checking for signs of life: https://github.com/alphaHeavy/lzma-conduit/issues/27 + -- I'll make a PR if someone responds. The lib is small enough we could just vendor it if not. + , lzma-conduit:transformers + , fused-effects-exceptions:transformers + -- the semver package only exposes lens-style accessors for its Version type; -- normal accessors are in an un-exposed Internal module. on master, the -- Internal module is exposed, but a new release hasn't been cut to hackage yet @@ -55,6 +65,6 @@ source-repository-package source-repository-package type: git location: https://github.com/fossas/codec-rpm - tag: 0f7431423d47fdf36945e4ff31fbee76005b7e68 + tag: 55e6cc0c0b7906ca257cb7c6268b2d99592bb30f index-state: hackage.haskell.org 2024-08-14T18:49:08Z diff --git a/spectrometer.cabal b/spectrometer.cabal index edda480615..d849ff76db 100644 --- a/spectrometer.cabal +++ b/spectrometer.cabal @@ -104,7 +104,7 @@ common deps , crypton ^>=1.0.0 , crypton-connection ^>=0.4.1 , data-default-class ^>=0.1.2.0 - , deepseq ^>=1.4.8 + , deepseq ^>= {1.4, 1.5} , direct-sqlite ^>=2.3.27 , directory ^>=1.3.6.1 , either ^>=5.0.2 @@ -124,9 +124,9 @@ common deps , http-types ^>=0.12.3 , lzma ^>=0.0.1.0 , lzma-conduit ^>=1.2.1 - , megaparsec ^>=9.4.0 + , megaparsec ^>={9.4, 9.6} , modern-uri ^>=0.3.6 - , mtl ^>=2.2.2 + , mtl ^>={2.2, 2.3} , network ^>=3.1.2.0 , network-uri ^>=2.6.4.0 , optparse-applicative ^>=0.18.0.0 diff --git a/src/App/Fossa/Reachability/Gradle.hs b/src/App/Fossa/Reachability/Gradle.hs index 8e9d1fb491..0df8f94f6f 100644 --- a/src/App/Fossa/Reachability/Gradle.hs +++ b/src/App/Fossa/Reachability/Gradle.hs @@ -10,7 +10,7 @@ import Control.Carrier.Reader (Reader, runReader) import Control.Effect.Diagnostics (Diagnostics, ToDiagnostic, context, errCtx, errHelp, errSupport, renderDiagnostic) import Control.Effect.Lift (sendIO) import Control.Effect.Path (withSystemTempDir) -import Control.Monad.List (filterM) +import Control.Monad (filterM) import Data.ByteString qualified as BS import Data.ByteString.Lazy qualified as BL import Data.Error (createErrataWithHeaderOnly) diff --git a/src/App/Fossa/Reachability/Maven.hs b/src/App/Fossa/Reachability/Maven.hs index da30cc8637..3dee031702 100644 --- a/src/App/Fossa/Reachability/Maven.hs +++ b/src/App/Fossa/Reachability/Maven.hs @@ -7,8 +7,7 @@ import App.Fossa.Reachability.Jar (callGraphFromJars, isValidJar) import App.Fossa.Reachability.Types (CallGraphAnalysis (..)) import Control.Carrier.Lift (Lift) import Control.Effect.Diagnostics (Diagnostics, context, fromEither, recover) -import Control.Monad (join) -import Control.Monad.List (filterM) +import Control.Monad (filterM, join) import Data.Map qualified as Map import Data.Maybe (catMaybes, fromMaybe) import Data.String.Conversion (ToText (toText)) diff --git a/src/Strategy/Cargo.hs b/src/Strategy/Cargo.hs index 86fca51224..6a78931cf0 100644 --- a/src/Strategy/Cargo.hs +++ b/src/Strategy/Cargo.hs @@ -494,7 +494,7 @@ parsePkgSpec = eatSpaces (try longSpec <|> simplePkgSpec') -- -- Package Spec: https://doc.rust-lang.org/cargo/reference/pkgid-spec.html parsePkgId :: MonadFail m => Text.Text -> m PackageId -parsePkgId t = either fail pure $ oldPkgIdParser' t <|> parseNewSpec +parsePkgId t = either fail pure $ oldPkgIdParser' t <> parseNewSpec where oldPkgIdParser' = first toString . oldPkgIdParser diff --git a/test/App/Fossa/Report/AttributionSpec.hs b/test/App/Fossa/Report/AttributionSpec.hs index 7fbca5b418..750776195a 100644 --- a/test/App/Fossa/Report/AttributionSpec.hs +++ b/test/App/Fossa/Report/AttributionSpec.hs @@ -3,7 +3,7 @@ module App.Fossa.Report.AttributionSpec ( ) where import App.Fossa.Report.Attribution -import Control.Applicative (liftA2) +import Control.Applicative () import Data.Aeson import Data.Map.Strict (Map) import Data.Text (Text) diff --git a/test/Test/Fixtures.hs b/test/Test/Fixtures.hs index 3ab06d5e79..300f9f81c3 100644 --- a/test/Test/Fixtures.hs +++ b/test/Test/Fixtures.hs @@ -70,13 +70,13 @@ import App.Fossa.VendoredDependency (VendoredDependency (..)) import App.Types (OverrideDynamicAnalysisBinary (..)) import App.Types qualified as App import Control.Effect.FossaApiClient qualified as App -import Control.Monad.RWS qualified as Set import Control.Timeout (Duration (MilliSeconds)) import Data.ByteString.Lazy qualified as LB import Data.Flag (toFlag) import Data.List.NonEmpty (NonEmpty) import Data.List.NonEmpty qualified as NE import Data.Map.Strict qualified as Map +import Data.Set qualified as Set import Data.Text (Text) import Data.Text.Encoding qualified as TL import Data.Text.Extra (showT) @@ -511,7 +511,7 @@ vsiOptions :: VSI.VSIModeOptions vsiOptions = VSI.VSIModeOptions { vsiAnalysisEnabled = toFlag VSI.VSIAnalysis False - , vsiSkipSet = VSI.SkipResolution Set.mempty + , vsiSkipSet = VSI.SkipResolution Set.empty , iatAssertion = VSI.IATAssertion Nothing , dynamicLinkingTarget = VSI.DynamicLinkInspect Nothing , binaryDiscoveryEnabled = toFlag VSI.BinaryDiscovery False From 04a2e536e8b14e6190e3053a33228f639753c51a Mon Sep 17 00:00:00 2001 From: Christopher Sasarak Date: Thu, 15 Aug 2024 17:22:54 -0500 Subject: [PATCH 09/21] Fmt fix... --- spectrometer.cabal | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/spectrometer.cabal b/spectrometer.cabal index d849ff76db..54d6a21195 100644 --- a/spectrometer.cabal +++ b/spectrometer.cabal @@ -104,7 +104,7 @@ common deps , crypton ^>=1.0.0 , crypton-connection ^>=0.4.1 , data-default-class ^>=0.1.2.0 - , deepseq ^>= {1.4, 1.5} + , deepseq ^>=1.4 || ^>=1.5 , direct-sqlite ^>=2.3.27 , directory ^>=1.3.6.1 , either ^>=5.0.2 @@ -124,9 +124,9 @@ common deps , http-types ^>=0.12.3 , lzma ^>=0.0.1.0 , lzma-conduit ^>=1.2.1 - , megaparsec ^>={9.4, 9.6} + , megaparsec ^>=9.4 || ^>=9.6 , modern-uri ^>=0.3.6 - , mtl ^>={2.2, 2.3} + , mtl ^>=2.2 || ^>=2.3 , network ^>=3.1.2.0 , network-uri ^>=2.6.4.0 , optparse-applicative ^>=0.18.0.0 From 7aeac99815ebb6e31a77e7411beac678335dd3ff Mon Sep 17 00:00:00 2001 From: Christopher Sasarak Date: Thu, 15 Aug 2024 18:16:25 -0500 Subject: [PATCH 10/21] Compatible liftA2 --- test/App/Fossa/Report/AttributionSpec.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/test/App/Fossa/Report/AttributionSpec.hs b/test/App/Fossa/Report/AttributionSpec.hs index 750776195a..228d2f7b2c 100644 --- a/test/App/Fossa/Report/AttributionSpec.hs +++ b/test/App/Fossa/Report/AttributionSpec.hs @@ -3,7 +3,7 @@ module App.Fossa.Report.AttributionSpec ( ) where import App.Fossa.Report.Attribution -import Control.Applicative () +import qualified Control.Applicative as Ap import Data.Aeson import Data.Map.Strict (Map) import Data.Text (Text) @@ -52,7 +52,7 @@ genAttribution = <*> Gen.maybe genCopyrightMap tuplify :: Monad m => m a -> m b -> m (a, b) -tuplify = liftA2 (,) +tuplify = Ap.liftA2 (,) genLicenseMap :: Gen (Map LicenseName LicenseContents) genLicenseMap = do From d9c3fe683a813c39cdc518062e74b7de6f23ca2a Mon Sep 17 00:00:00 2001 From: Christopher Sasarak Date: Thu, 15 Aug 2024 18:23:38 -0500 Subject: [PATCH 11/21] =?UTF-8?q?Format=20=F0=9F=98=A2?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- test/App/Fossa/Report/AttributionSpec.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/App/Fossa/Report/AttributionSpec.hs b/test/App/Fossa/Report/AttributionSpec.hs index 228d2f7b2c..8971259222 100644 --- a/test/App/Fossa/Report/AttributionSpec.hs +++ b/test/App/Fossa/Report/AttributionSpec.hs @@ -3,7 +3,7 @@ module App.Fossa.Report.AttributionSpec ( ) where import App.Fossa.Report.Attribution -import qualified Control.Applicative as Ap +import Control.Applicative qualified as Ap import Data.Aeson import Data.Map.Strict (Map) import Data.Text (Text) From 665781c2c3e4c784f0f1f500cad10351c712e348 Mon Sep 17 00:00:00 2001 From: Christopher Sasarak Date: Thu, 15 Aug 2024 19:17:46 -0500 Subject: [PATCH 12/21] Attempt a build. Still need to do haskell-dev-tools eventually. --- .github/workflows/build-all.yml | 12 ++++++------ .github/workflows/integrations-test.yml | 4 ++-- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/.github/workflows/build-all.yml b/.github/workflows/build-all.yml index a3e32cd33c..1464be8da8 100644 --- a/.github/workflows/build-all.yml +++ b/.github/workflows/build-all.yml @@ -10,7 +10,7 @@ jobs: runs-on: ${{ matrix.os }} container: ${{ matrix.container }} env: - GHC_VERSION: '9.4.8' + GHC_VERSION: '9.8.2' defaults: @@ -23,25 +23,25 @@ jobs: include: - os: ubuntu-latest os-name: Linux - container: fossa/haskell-static-alpine:ghc-9.4.8 + container: fossa/haskell-static-alpine:ghc-9.8.2 project-file: cabal.project.ci.linux - ghc: '9.4.8' + ghc: '9.8.2' # macos-latest pointed at macos-12 this before it was changed to ARM. - os: macos-12 os-name: macOS-intel project-file: cabal.project.ci.macos - ghc: '9.4.8' + ghc: '9.8.2' - os: windows-latest os-name: Windows project-file: cabal.project.ci.windows - ghc: '9.4.8' + ghc: '9.8.2' - os: macos-latest os-name: macOS-arm64 project-file: cabal.project.ci.macos - ghc: '9.4.8' + ghc: '9.8.2' steps: diff --git a/.github/workflows/integrations-test.yml b/.github/workflows/integrations-test.yml index 4958a623b5..b3ec6ee101 100644 --- a/.github/workflows/integrations-test.yml +++ b/.github/workflows/integrations-test.yml @@ -13,10 +13,10 @@ jobs: name: integration-test runs-on: "fossa-cli-integration-runner" # Be sure to update the env below too - container: fossa/haskell-static-alpine:ghc-9.4.8 + container: fossa/haskell-static-alpine:ghc-9.8.2 env: - GHC_VERSION: '9.4.8' + GHC_VERSION: '9.8.2' steps: - uses: dtolnay/rust-toolchain@stable From 942a5d6ce26f7ae7fd7a3d2cf3d002e7becb82a7 Mon Sep 17 00:00:00 2001 From: Christopher Sasarak Date: Thu, 15 Aug 2024 23:35:20 -0500 Subject: [PATCH 13/21] Turn x-partial into a warning for unit tests. --- spectrometer.cabal | 1 + 1 file changed, 1 insertion(+) diff --git a/spectrometer.cabal b/spectrometer.cabal index 54d6a21195..2472e5a13e 100644 --- a/spectrometer.cabal +++ b/spectrometer.cabal @@ -550,6 +550,7 @@ test-suite unit-tests type: exitcode-stdio-1.0 hs-source-dirs: test main-is: test.hs + ghc-options: -Wwarn=x-partial -- cabal-fmt: expand test other-modules: From 8dab11164f22a4f5d6c6a06f401f4feb2b9b2b60 Mon Sep 17 00:00:00 2001 From: Christopher Sasarak Date: Fri, 16 Aug 2024 00:43:43 -0500 Subject: [PATCH 14/21] Attempt to addressing breaking warnings/errors. --- src/Control/Effect/Record/TH.hs | 4 ++++ src/Control/Effect/Replay/TH.hs | 5 +++++ src/Data/FileEmbed/Extra.hs | 4 +--- src/Data/Rpm/DbHeaderBlob/Internal.hs | 4 ++-- 4 files changed, 12 insertions(+), 5 deletions(-) diff --git a/src/Control/Effect/Record/TH.hs b/src/Control/Effect/Record/TH.hs index 433779546a..f0d13e6b0e 100644 --- a/src/Control/Effect/Record/TH.hs +++ b/src/Control/Effect/Record/TH.hs @@ -1,4 +1,6 @@ {-# LANGUAGE TemplateHaskell #-} +-- Some partial functions are used safely in this module, so don't warn or error. +{-# OPTIONS_GHC -Wno-x-partial #-} module Control.Effect.Record.TH ( deriveRecordable, @@ -51,6 +53,8 @@ conNm (NormalC nm _) = nm conNm (RecC nm _) = nm conNm (InfixC _ nm _) = nm conNm (ForallC _ _ con) = conNm con +-- 'head' is safe here because that field is documented to be non-empty: +-- https://hackage.haskell.org/package/template-haskell-2.22.0.0/docs/Language-Haskell-TH.html#v:GadtC conNm (GadtC nms _ _) = head nms conNm (RecGadtC nms _ _) = head nms diff --git a/src/Control/Effect/Replay/TH.hs b/src/Control/Effect/Replay/TH.hs index 86a9e4eac9..30ff989b59 100644 --- a/src/Control/Effect/Replay/TH.hs +++ b/src/Control/Effect/Replay/TH.hs @@ -1,4 +1,7 @@ {-# LANGUAGE TemplateHaskell #-} +-- Some partial functions are used safely in this module. +-- This turns their use into a warning, not an error. +{-# OPTIONS_GHC -Wno-x-partial #-} module Control.Effect.Replay.TH ( deriveReplayable, @@ -89,6 +92,8 @@ conNm (NormalC nm _) = nm conNm (RecC nm _) = nm conNm (InfixC _ nm _) = nm conNm (ForallC _ _ con) = conNm con +-- 'head' is safe here because that field is documented to be non-empty: +-- https://hackage.haskell.org/package/template-haskell-2.22.0.0/docs/Language-Haskell-TH.html#v:GadtC conNm (GadtC nms _ _) = head nms conNm (RecGadtC nms _ _) = head nms diff --git a/src/Data/FileEmbed/Extra.hs b/src/Data/FileEmbed/Extra.hs index 9c4191bf04..3cca4b04b6 100644 --- a/src/Data/FileEmbed/Extra.hs +++ b/src/Data/FileEmbed/Extra.hs @@ -48,9 +48,7 @@ embedFile' fp = runIO logEmbedFile *> embedFile fp let isRel = isRelative fp putStrLn $ "Relative?: " <> show isRel - -- `tail` is safe here because `iterate` returns an infinite list and - -- therefore must always have at least 1 element. - let dirs = take (length (splitPath fp) - if isRel then 0 else 1) $ tail $ iterate takeDirectory fp + let dirs = take (length (splitPath fp) - if isRel then 0 else 1) $ drop 1 $ iterate takeDirectory fp traverse_ ls dirs ls :: FilePath -> IO () diff --git a/src/Data/Rpm/DbHeaderBlob/Internal.hs b/src/Data/Rpm/DbHeaderBlob/Internal.hs index c44730ab11..63f28aa372 100644 --- a/src/Data/Rpm/DbHeaderBlob/Internal.hs +++ b/src/Data/Rpm/DbHeaderBlob/Internal.hs @@ -29,7 +29,7 @@ module Data.Rpm.DbHeaderBlob.Internal ( regionTagType, ) where -import Control.Applicative (liftA2) +import Control.Applicative qualified as Ap import Control.Monad (foldM, replicateM, unless, when) import Data.Bifunctor (bimap, first) import Data.Binary.Get (ByteOffset, Get, getInt32be, getWord32be, label, runGetOrFail) @@ -436,7 +436,7 @@ bsSubString start end = BLS.take (fromIntegral $ end - start) . BLS.drop (fromIn readEntries :: IndexCount -> Get (NonEmpty EntryMetadata) readEntries indexLength = - liftA2 (:|) readEntry $ replicateM (fromIntegral (indexLength - 1)) readEntry + Ap.liftA2 (:|) readEntry $ replicateM (fromIntegral (indexLength - 1)) readEntry readEntry :: Get EntryMetadata readEntry = From be72e25616de053cabdc13785166d81b6d7a59f3 Mon Sep 17 00:00:00 2001 From: Christopher Sasarak Date: Fri, 16 Aug 2024 11:45:22 -0500 Subject: [PATCH 15/21] Turn off the new x-partial warnings. --- .github/workflows/build-all.yml | 2 +- cabal.project.ci.linux | 2 +- cabal.project.ci.macos | 2 +- cabal.project.ci.windows | 2 +- spectrometer.cabal | 1 + 5 files changed, 5 insertions(+), 4 deletions(-) diff --git a/.github/workflows/build-all.yml b/.github/workflows/build-all.yml index 1464be8da8..84f31a3ede 100644 --- a/.github/workflows/build-all.yml +++ b/.github/workflows/build-all.yml @@ -62,7 +62,7 @@ jobs: if: ${{ !contains(matrix.os, 'ubuntu') }} with: ghc-version: ${{ matrix.ghc }} - cabal-version: '3.10.2.1' + cabal-version: '3.10.3.0' # Set up Rust. # This action installs the 'minimal' profile. diff --git a/cabal.project.ci.linux b/cabal.project.ci.linux index 228f2b3ea9..daf7ea4957 100644 --- a/cabal.project.ci.linux +++ b/cabal.project.ci.linux @@ -9,4 +9,4 @@ packages: . import: ./cabal.project.common package spectrometer - ghc-options: -Werror + ghc-options: -Werror -Wwarn=x-partial diff --git a/cabal.project.ci.macos b/cabal.project.ci.macos index a82bc28729..c2a4cb0bec 100644 --- a/cabal.project.ci.macos +++ b/cabal.project.ci.macos @@ -7,4 +7,4 @@ packages: . import: ./cabal.project.common package spectrometer - ghc-options: -Werror + ghc-options: -Werror -Wwarn=x-partial diff --git a/cabal.project.ci.windows b/cabal.project.ci.windows index 228f2b3ea9..daf7ea4957 100644 --- a/cabal.project.ci.windows +++ b/cabal.project.ci.windows @@ -9,4 +9,4 @@ packages: . import: ./cabal.project.common package spectrometer - ghc-options: -Werror + ghc-options: -Werror -Wwarn=x-partial diff --git a/spectrometer.cabal b/spectrometer.cabal index 2472e5a13e..060ea38fa4 100644 --- a/spectrometer.cabal +++ b/spectrometer.cabal @@ -73,6 +73,7 @@ common lang -Wall -Wincomplete-uni-patterns -Wcompat -Wincomplete-record-updates -Wmissing-home-modules -Wmissing-export-lists -Wredundant-constraints + -Wno-unrecognised-warning-flags -- TODO: Switch `semver` back to `versions` since https://github.com/fosskers/versions/issues/47 is fixed. This package maintainer seems much more responsive. Contrast https://github.com/brendanhay/semver/issues/12. -- codec-rpm is installed via cabal.project, so this number is an expected future version. From c19ea7a2f92f24124258cefff4d1e4937c4f8cf8 Mon Sep 17 00:00:00 2001 From: Christopher Sasarak Date: Fri, 16 Aug 2024 13:00:53 -0500 Subject: [PATCH 16/21] Format cabal file. --- spectrometer.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/spectrometer.cabal b/spectrometer.cabal index 060ea38fa4..f4610bf567 100644 --- a/spectrometer.cabal +++ b/spectrometer.cabal @@ -551,7 +551,7 @@ test-suite unit-tests type: exitcode-stdio-1.0 hs-source-dirs: test main-is: test.hs - ghc-options: -Wwarn=x-partial + ghc-options: -Wwarn=x-partial -- cabal-fmt: expand test other-modules: From 68fed31ae1250818870a5f35af4b14cd8429e71d Mon Sep 17 00:00:00 2001 From: Christopher Sasarak Date: Fri, 16 Aug 2024 16:42:06 -0500 Subject: [PATCH 17/21] Update docs, workflows and makefiles to use ghc-9.8. --- .github/workflows/bench.yml | 2 +- .github/workflows/build-all.yml | 4 ++-- Makefile | 2 +- docs/contributing/HACKING.md | 14 +++++++------- spectrometer.cabal | 1 - 5 files changed, 11 insertions(+), 12 deletions(-) diff --git a/.github/workflows/bench.yml b/.github/workflows/bench.yml index 428bf2cc72..a76bf1018d 100644 --- a/.github/workflows/bench.yml +++ b/.github/workflows/bench.yml @@ -5,7 +5,7 @@ jobs: benchmarks: name: benchmarks runs-on: ubuntu-latest - container: fossa/haskell-static-alpine:ghc-9.4.8 + container: fossa/haskell-static-alpine:ghc-9.8 steps: - uses: dtolnay/rust-toolchain@stable diff --git a/.github/workflows/build-all.yml b/.github/workflows/build-all.yml index 84f31a3ede..2ba2c45f11 100644 --- a/.github/workflows/build-all.yml +++ b/.github/workflows/build-all.yml @@ -315,8 +315,8 @@ jobs: echo ${GITHUB_SHA:0:12} VERSION=$(echo $(Linux-binaries/fossa --version)) - EXPECTED="fossa-cli version ${{ steps.get-version.outputs.VERSION }} (revision ${GITHUB_SHA:0:12} compiled with ghc-9.4)" - echo " VERSION: $VERSION" + EXPECTED="fossa-cli version ${{ steps.get-version.outputs.VERSION }} (revision ${GITHUB_SHA:0:12} compiled with ghc-9.8)" + echo "VERSION: $VERSION" echo "EXPECTED: $EXPECTED" [ "$GITHUB_REF_TYPE" = "tag" ] && echo "Ref type OK" diff --git a/Makefile b/Makefile index b989f97974..8185cc5616 100644 --- a/Makefile +++ b/Makefile @@ -3,7 +3,7 @@ current_dir := $(dir $(abspath $(lastword $(MAKEFILE_LIST)))) FMT_OPTS := -co -XTypeApplications -o -XImportQualifiedPost FIND_OPTS := src test integration-test -type f -name '*.hs' -GHC_VERSION := 9.4.8 +GHC_VERSION := 9.8.2 DEV_TOOLS := ghcr.io/fossas/haskell-dev-tools:${GHC_VERSION} MOUNTED_DEV_TOOLS_OPTS := --rm MOUNTED_DEV_TOOLS_OPTS += --mount "type=bind,source=${current_dir},target=/fossa-cli" diff --git a/docs/contributing/HACKING.md b/docs/contributing/HACKING.md index 83d6752689..8c66b35e9f 100644 --- a/docs/contributing/HACKING.md +++ b/docs/contributing/HACKING.md @@ -14,9 +14,9 @@ On Macs you need to have installed the developer tooling using `xcode-select --i Use [ghcup][ghcup] to install the `cabal` cli tool and the ghc version we're using: ```sh -$ ghcup install ghc 9.4 +$ ghcup install ghc 9.8 -$ ghcup set ghc 9.4 +$ ghcup set ghc 9.8 $ cabal update $ cabal build ``` @@ -29,16 +29,16 @@ In previous GHC versions (8.10), `llvm` was required Ok, the quickstart worked for you, but why, and how? -> `ghcup install ghc 9.4` +> `ghcup install ghc 9.8` When you install `ghcup`, `ghc` and `cabal-install` are installed automatically as part of the initial installation (see [Tools](#tools) for descriptions of `ghc` and `cabal-install`). -The `ghc` version that is automatically installed may not be the correct version we use (though it may work just fine). So we install the correct version with `ghcup install ghc 9.4`. +The `ghc` version that is automatically installed may not be the correct version we use (though it may work just fine). So we install the correct version with `ghcup install ghc 9.8`. Currently, the best place to check the correct version is our CI build files (try `.github/workflows/build.yml`). -> `ghcup set ghc 9.4` +> `ghcup set ghc 9.8` -`ghcup` works by setting symlinks to the "active" version of the tool you're using. Here, we're telling `ghcup` to set GHC 9.4 as the active GHC version. -Now, when you run `ghc`, you'll be running GHC 9.4. +`ghcup` works by setting symlinks to the "active" version of the tool you're using. Here, we're telling `ghcup` to set GHC 9.8 as the active GHC version. +Now, when you run `ghc`, you'll be running GHC 9.8. > `cabal update` diff --git a/spectrometer.cabal b/spectrometer.cabal index 3e0bc4e203..7aa0e51565 100644 --- a/spectrometer.cabal +++ b/spectrometer.cabal @@ -551,7 +551,6 @@ test-suite unit-tests type: exitcode-stdio-1.0 hs-source-dirs: test main-is: test.hs - ghc-options: -Wwarn=x-partial -- cabal-fmt: expand test other-modules: From d445aa2e9684ec655eb302a8aa20b5c5283df6cd Mon Sep 17 00:00:00 2001 From: Christopher Sasarak Date: Fri, 16 Aug 2024 17:44:37 -0500 Subject: [PATCH 18/21] Lint with new haskell-dev-tools. --- .github/workflows/lint.yml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/workflows/lint.yml b/.github/workflows/lint.yml index 383edf7ee1..1631230ffc 100644 --- a/.github/workflows/lint.yml +++ b/.github/workflows/lint.yml @@ -6,7 +6,7 @@ jobs: linter-check: name: linter-check runs-on: ubuntu-latest - container: ghcr.io/fossas/haskell-dev-tools:9.4.8 + container: ghcr.io/fossas/haskell-dev-tools:9.8.2 steps: - uses: dtolnay/rust-toolchain@stable @@ -39,7 +39,7 @@ jobs: format-check: name: formatter-check runs-on: ubuntu-latest - container: ghcr.io/fossas/haskell-dev-tools:9.4.8 + container: ghcr.io/fossas/haskell-dev-tools:9.8.2 steps: - uses: dtolnay/rust-toolchain@stable @@ -56,7 +56,7 @@ jobs: cabal-format-check: name: cabal-format-check runs-on: ubuntu-latest - container: ghcr.io/fossas/haskell-dev-tools:9.4.8 + container: ghcr.io/fossas/haskell-dev-tools:9.8.2 steps: - uses: actions/checkout@v4 From 13ef532b794a2989844bb97079ab491f366e1dd7 Mon Sep 17 00:00:00 2001 From: Christopher Sasarak Date: Mon, 19 Aug 2024 13:10:33 -0500 Subject: [PATCH 19/21] Make a release. --- Changelog.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/Changelog.md b/Changelog.md index a795f465be..4989fe88c8 100644 --- a/Changelog.md +++ b/Changelog.md @@ -1,9 +1,10 @@ # FOSSA CLI Changelog -## Unreleased +## 3.9.31 - Resolve an issue parsing toml configuration files. ([#1459](https://github.com/fossas/fossa-cli/pull/1459)) - Gradle: ignore deprecated configurations ([#1457](https://github.com/fossas/fossa-cli/pull/1457)) +- Upgrade the GHC we use to build the CLI. ([#1460](https://github.com/fossas/fossa-cli/pull/1460)) ## 3.9.30 From 2bd61bba904d9a2e7f6a55226d58fb481bc2be9e Mon Sep 17 00:00:00 2001 From: Christopher Sasarak Date: Mon, 19 Aug 2024 13:19:56 -0500 Subject: [PATCH 20/21] learnyouahaskell.com seems to be down. There is a community fork which may be more reliable/up-to-date anyway: https://learnyouahaskell.github.io. --- docs/contributing/STYLE-GUIDE.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/contributing/STYLE-GUIDE.md b/docs/contributing/STYLE-GUIDE.md index f373c9eebb..63f1cbe8f8 100644 --- a/docs/contributing/STYLE-GUIDE.md +++ b/docs/contributing/STYLE-GUIDE.md @@ -137,7 +137,7 @@ If your match guards are any less readable than the introductory examples in [Learn you a haskell][guards], then you should stick to `case` and `if` expressions within the function body. -[guards]: http://learnyouahaskell.com/syntax-in-functions#guards-guards +[guards]: https://learnyouahaskell.github.io/syntax-in-functions.html#guards-guards ### Don't go crazy with point-free definitions From 83301aa31e791180034caa58fd2b6b871436ce5c Mon Sep 17 00:00:00 2001 From: Christopher Sasarak Date: Wed, 21 Aug 2024 15:46:30 -0500 Subject: [PATCH 21/21] Fix benches. --- .github/workflows/bench.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/bench.yml b/.github/workflows/bench.yml index a76bf1018d..d6e3eb6c5e 100644 --- a/.github/workflows/bench.yml +++ b/.github/workflows/bench.yml @@ -5,7 +5,7 @@ jobs: benchmarks: name: benchmarks runs-on: ubuntu-latest - container: fossa/haskell-static-alpine:ghc-9.8 + container: fossa/haskell-static-alpine:ghc-9.8.2 steps: - uses: dtolnay/rust-toolchain@stable