make getProject take an issue locator type too

src/App/Fossa/API/BuildWait.hs

@@ -76,7 +76,7 @@ waitForScanCompletion ::
   m ()
 waitForScanCompletion revision locatorType cancelFlag = do
   -- Route is new, this may fail on on-prem if they haven't updated
-  project <- recover $ getProject revision
+  project <- recover $ getProject revision locatorType
   if maybe False projectIsMonorepo project
     then fatalText "The project you are attempting to test is a monorepo project. Monorepo projects are no longer supported by FOSSA."
     else waitForBuild revision locatorType cancelFlag

src/App/Fossa/Analyze/Upload.hs

@@ -15,6 +15,7 @@ import App.Fossa.Reachability.Upload (upload)
 import App.Types (
   BaseDir (BaseDir),
   FileUpload,
+  IssueLocatorType (..),
   ProjectMetadata,
   ProjectRevision (..),
  )
@@ -186,7 +187,7 @@ uploadAnalysisWithFirstPartyLicensesToS3 revision mergedUnits = do
 
 dieOnMonorepoUpload :: (Has Diagnostics sig m, Has FossaApiClient sig m) => ProjectRevision -> m ()
 dieOnMonorepoUpload revision = do
-  project <- recover $ getProject revision
+  project <- recover $ getProject revision IssueLocatorCustom
   when (maybe False projectIsMonorepo project) $
     fatalText "This project already exists as a monorepo project. Monorepo projects are no longer supported; please create a new project instead."
 

src/Control/Carrier/FossaApiClient.hs

@@ -45,7 +45,7 @@ runFossaApiClient apiOpts =
           GetRevisionDependencyCacheStatus rev -> Core.getRevisionDependencyCacheStatus rev
           GetOrganization -> Core.getOrganization
           GetPolicies -> Core.getPolicies
-          GetProject rev -> Core.getProject rev
+          GetProject rev locatorType -> Core.getProject rev locatorType
           GetTeams -> Core.getTeams
           AddTeamProjects teamId req -> Core.addTeamProjects teamId req
           GetAnalyzedRevisions vdeps -> Core.getAnalyzedRevisions vdeps

src/Control/Carrier/FossaApiClient/Internal/Core.hs

@@ -118,10 +118,11 @@ getProject ::
   , Has (Reader ApiOpts) sig m
   ) =>
   ProjectRevision ->
+  IssueLocatorType ->
   m Project
-getProject revision = do
+getProject revision locatorType = do
   apiOpts <- ask
-  API.getProject apiOpts revision
+  API.getProject apiOpts revision locatorType
 
 getAnalyzedRevisions ::
   ( Has (Lift IO) sig m

src/Control/Carrier/FossaApiClient/Internal/FossaAPIV1.hs

@@ -862,13 +862,14 @@ getProject ::
   ) =>
   ApiOpts ->
   ProjectRevision ->
+  IssueLocatorType ->
   m Project
-getProject apiopts ProjectRevision{..} = fossaReq $ do
+getProject apiopts ProjectRevision{..} locatorType = fossaReq $ do
   (baseurl, baseopts) <- useApiOpts apiopts
 
   orgid <- organizationId <$> getOrganization apiopts
 
-  let endpoint = projectEndpoint baseurl orgid $ Locator "custom" projectName Nothing
+  let endpoint = projectEndpoint baseurl orgid $ Locator (toText locatorType) projectName Nothing
 
   responseBody <$> req GET endpoint NoReqBody jsonResponse baseopts
 

src/Control/Effect/FossaApiClient.hs

@@ -128,7 +128,7 @@ data FossaApiClientF a where
   GetLatestBuild :: ProjectRevision -> IssueLocatorType -> FossaApiClientF Build
   GetOrganization :: FossaApiClientF Organization
   GetPolicies :: FossaApiClientF [CoreTypes.Policy]
-  GetProject :: ProjectRevision -> FossaApiClientF Project
+  GetProject :: ProjectRevision -> IssueLocatorType -> FossaApiClientF Project
   GetTeams :: FossaApiClientF [CoreTypes.Team]
   GetAnalyzedRevisions :: NonEmpty VendoredDependency -> FossaApiClientF [Text]
   GetAnalyzedPathRevisions :: ProjectRevision -> FossaApiClientF [AnalyzedPathDependency]
@@ -190,8 +190,8 @@ getOrganization :: (Has FossaApiClient sig m) => m Organization
 getOrganization = sendSimple GetOrganization
 
 -- | Fetches the project associated with a revision
-getProject :: (Has FossaApiClient sig m) => ProjectRevision -> m Project
-getProject = sendSimple . GetProject
+getProject :: (Has FossaApiClient sig m) => ProjectRevision -> IssueLocatorType -> m Project
+getProject revision locatorType = sendSimple $ GetProject revision locatorType
 
 -- | Returns the API options currently in scope.
 -- The API options contain a lot of information required to build URLs.

test/App/Fossa/API/BuildWaitSpec.hs

@@ -141,7 +141,7 @@ expectGetOrganization :: Has MockApi sig m => m ()
 expectGetOrganization = GetOrganization `alwaysReturns` Fixtures.organization
 
 expectGetProject :: Has MockApi sig m => m ()
-expectGetProject = (GetProject Fixtures.projectRevision) `alwaysReturns` Fixtures.project
+expectGetProject = (GetProject Fixtures.projectRevision IssueLocatorCustom) `alwaysReturns` Fixtures.project
 
 expectGetLatestBuild :: Has MockApi sig m => BuildStatus -> m ()
 expectGetLatestBuild status =

test/App/Fossa/Analyze/UploadSpec.hs

@@ -4,7 +4,7 @@ module App.Fossa.Analyze.UploadSpec (spec) where
 
 import App.Fossa.Analyze.Upload (ScanUnits (..), mergeSourceAndLicenseUnits, uploadSuccessfulAnalysis)
 import App.Fossa.Config.Analyze (JsonOutput (JsonOutput))
-import App.Types (FileUpload (..))
+import App.Types (FileUpload (..), IssueLocatorType (..))
 import Control.Algebra (Has)
 import Control.Carrier.Git (GitC)
 import Control.Carrier.Simple (interpret)
@@ -39,12 +39,12 @@ expectedLocator = uploadLocator Fixtures.uploadResponse
 
 expectGetSuccess :: Has MockApi sig m => m ()
 expectGetSuccess = do
-  GetProject Fixtures.projectRevision `alwaysReturns` Fixtures.project
+  GetProject Fixtures.projectRevision IssueLocatorCustom `alwaysReturns` Fixtures.project
   GetOrganization `alwaysReturns` Fixtures.organization
   GetApiOpts `alwaysReturns` Fixtures.apiOpts
 
 expectGetProject :: Has MockApi sig m => m ()
-expectGetProject = GetProject Fixtures.projectRevision `alwaysReturns` Fixtures.project
+expectGetProject = GetProject Fixtures.projectRevision IssueLocatorCustom `alwaysReturns` Fixtures.project
 
 expectGetOrganizationWithFullFileUploads :: Has MockApi sig m => m ()
 expectGetOrganizationWithFullFileUploads =
@@ -106,7 +106,7 @@ expectedMergedFullSourceUnits = NE.fromList [fullSourceUnit, fullLicenseUnit]
 
 expectGetSuccessWithReachability :: Has MockApi sig m => m ()
 expectGetSuccessWithReachability = do
-  GetProject Fixtures.projectRevision `alwaysReturns` Fixtures.project
+  GetProject Fixtures.projectRevision IssueLocatorCustom `alwaysReturns` Fixtures.project
   GetOrganization `alwaysReturns` Fixtures.organization{orgSupportsReachability = True}
   GetApiOpts `alwaysReturns` Fixtures.apiOpts
 
@@ -178,7 +178,7 @@ uploadSuccessfulAnalysisSpec = do
         . expectFatal'
         . withGit mockGit
         $ do
-          GetProject Fixtures.projectRevision `returnsOnce` Fixtures.project{projectIsMonorepo = True}
+          GetProject Fixtures.projectRevision IssueLocatorCustom `returnsOnce` Fixtures.project{projectIsMonorepo = True}
           uploadSuccessfulAnalysis
             baseDir
             Fixtures.projectMetadata
@@ -189,7 +189,7 @@ uploadSuccessfulAnalysisSpec = do
       it' "continues if fetching the project fails"
         . withGit mockGit
         $ do
-          GetProject Fixtures.projectRevision `fails` "Mocked failure fetching project"
+          GetProject Fixtures.projectRevision IssueLocatorCustom `fails` "Mocked failure fetching project"
           expectAnalysisUploadSuccess
           expectContributorUploadSuccess
           GetOrganization `alwaysReturns` Fixtures.organization

test/App/Fossa/ReportSpec.hs

@@ -75,18 +75,18 @@ parseReportOutputSpec =
 
 expectBuildSuccess :: (Has MockApi sig m) => m ()
 expectBuildSuccess = do
-  (GetProject Fixtures.projectRevision) `returnsOnce` Fixtures.project
+  (GetProject Fixtures.projectRevision IssueLocatorCustom) `returnsOnce` Fixtures.project
   (GetLatestBuild Fixtures.projectRevision IssueLocatorCustom) `returnsOnce` Fixtures.successfulBuild
 
 expectBuildPending :: (Has MockApi sig m) => m ()
 expectBuildPending = do
   GetApiOpts `alwaysReturns` Fixtures.apiOpts -- It needs to fetch the poll delay
-  (GetProject Fixtures.projectRevision) `returnsOnce` Fixtures.project
+  (GetProject Fixtures.projectRevision IssueLocatorCustom) `returnsOnce` Fixtures.project
   (GetLatestBuild Fixtures.projectRevision IssueLocatorCustom) `alwaysReturns` Fixtures.pendingBuild
 
 expectBuildError :: (Has MockApi sig m) => m ()
 expectBuildError = do
-  (GetProject Fixtures.projectRevision) `returnsOnce` Fixtures.project
+  (GetProject Fixtures.projectRevision IssueLocatorCustom) `returnsOnce` Fixtures.project
   (GetLatestBuild Fixtures.projectRevision IssueLocatorCustom) `fails` "Mock failure: GetLatestBuild"
 
 expectFetchIssuesSuccess :: (Has MockApi sig m) => m ()