content: {-# LANGUAGE OverloadedRecordDot #-}
  
  module App.Fossa.API.BuildWait (
    waitForScanCompletion,
    waitForIssues,
    waitForBuild,
    waitForReportReadiness,
  ) where
  
  import App.Fossa.Config.Test (DiffRevision)
  import App.Types (LocatorType (..), ProjectRevision, projectRevision)
  import Control.Effect.Diagnostics (
    Diagnostics,
    Has,
    ToDiagnostic (..),
    fatal,
    fatalText,
    recover,
   )
  import Control.Effect.Exception (Lift)
  import Control.Effect.FossaApiClient (
    FossaApiClient,
    getApiOpts,
    getIssues,
    getLatestBuild,
    getOrganization,
    getProject,
    getRevisionDependencyCacheStatus,
   )
  import Control.Effect.StickyLogger (StickyLogger, logSticky, logSticky')
  import Control.Monad (void, when)
  import Control.Timeout (Cancel, checkForCancel, delay)
  import Data.Error (SourceLocation, createEmptyBlock, getSourceLocation)
  import Data.String.Conversion (showText)
  import Effect.Logger (Logger, viaShow)
  import Errata (errataSimple)
  import Errata.Types (Errata)
  import Fossa.API.Types (
    ApiOpts (apiOptsPollDelay),
    Build (buildTask),
    BuildStatus (StatusFailed, StatusSucceeded),
    BuildTask (buildTaskStatus),
    Issues (issuesStatus),
    Organization (orgSupportsDependenciesCachePolling),
    Project (projectIsMonorepo),
    RevisionDependencyCache (status),
    RevisionDependencyCacheStatus (Ready, UnknownDependencyCacheStatus, Waiting),
   )
  
  data WaitError
    = -- | We encountered the FAILED status on a build
      BuildFailed SourceLocation
    | -- | We ran out of time locally, and aborted
      LocalTimeout SourceLocation
    deriving (Eq, Ord, Show)
  
  instance ToDiagnostic WaitError where
    renderDiagnostic :: WaitError -> Errata
    renderDiagnostic (BuildFailed srcLoc) =
      errataSimple (Just "The build failed. Check the FOSSA webapp for more details") (createEmptyBlock srcLoc) Nothing
    renderDiagnostic (LocalTimeout srcLoc) =
      errataSimple (Just "Build/Issue scan was not completed on the FOSSA server, and the --timeout duration has expired") (createEmptyBlock srcLoc) Nothing
  
  -- | Wait for either a normal build completion or a monorepo scan completion.
  -- Try to detect the correct method, use provided fallback
  waitForScanCompletion ::
    ( Has Diagnostics sig m
    , Has Logger sig m
    , Has StickyLogger sig m
    , Has FossaApiClient sig m
    , Has (Lift IO) sig m
    ) =>
    ProjectRevision ->
    LocatorType ->
    Cancel ->
    m ()
  waitForScanCompletion revision locatorType cancelFlag = do
    -- Route is new, this may fail on on-prem if they haven't updated
    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
  
  waitForIssues ::
    ( Has Diagnostics sig m
    , Has FossaApiClient sig m
    , Has Logger sig m
    , Has (Lift IO) sig m
    ) =>
    ProjectRevision ->
    Maybe DiffRevision ->
    LocatorType ->
    Cancel ->
    m Issues
  waitForIssues revision diffRevision locatorType cancelFlag = do
    checkForTimeout cancelFlag
    issues <- getIssues revision diffRevision locatorType
    case issuesStatus issues of
      "WAITING" -> do
        pauseForRetry
        waitForIssues revision diffRevision locatorType cancelFlag
      _ -> pure issues
  
  -- | Wait for build completion
  waitForBuild ::
    ( Has Diagnostics sig m
    , Has Logger sig m
    , Has StickyLogger sig m
    , Has FossaApiClient sig m
    , Has (Lift IO) sig m
    ) =>
    ProjectRevision ->
    LocatorType ->
    Cancel ->
    m ()
  waitForBuild revision locatorType cancelFlag = do
    checkForTimeout cancelFlag
    build <- getLatestBuild revision locatorType
  
    case buildTaskStatus (buildTask build) of
      StatusSucceeded -> pure ()
      StatusFailed -> fatal $ BuildFailed getSourceLocation
      otherStatus -> do
        logSticky $ "[ Waiting for build completion (revision " <> revision.projectRevision <> ")... last status: " <> showText otherStatus <> " ]"
        pauseForRetry
        waitForBuild revision locatorType cancelFlag
  
  -- | Specialized version of 'checkForCancel' which represents
  -- a backend build/issue scan timeout.
  checkForTimeout ::
    ( Has Diagnostics sig m
    , Has (Lift IO) sig m
    ) =>
    Cancel ->
    m ()
  checkForTimeout = checkForCancel $ LocalTimeout getSourceLocation
  
  pauseForRetry ::
    ( Has (Lift IO) sig m
    , Has FossaApiClient sig m
    ) =>
    m ()
  pauseForRetry = do
    apiOpts <- getApiOpts
    delay $ apiOptsPollDelay apiOpts
  
  waitForReportReadiness ::
    ( Has Diagnostics sig m
    , Has Logger sig m
    , Has StickyLogger sig m
    , Has FossaApiClient sig m
    , Has (Lift IO) sig m
    ) =>
    ProjectRevision ->
    Cancel ->
    LocatorType ->
    m ()
  waitForReportReadiness revision cancelFlag locatorType = do
    void $ waitForIssues revision Nothing locatorType cancelFlag
  
    supportsDepCacheReadinessPolling <- orgSupportsDependenciesCachePolling <$> getOrganization
    when supportsDepCacheReadinessPolling $
      waitForValidDependenciesCache revision cancelFlag locatorType
  
  waitForValidDependenciesCache ::
    ( Has Diagnostics sig m
    , Has Logger sig m
    , Has StickyLogger sig m
    , Has FossaApiClient sig m
    , Has (Lift IO) sig m
    ) =>
    ProjectRevision ->
    Cancel ->
    LocatorType ->
    m ()
  waitForValidDependenciesCache revision cancelFlag locatorType = do
    checkForTimeout cancelFlag
    cacheStatus <- getRevisionDependencyCacheStatus revision locatorType
  
    case status cacheStatus of
      Ready -> pure ()
      Waiting -> do
        logSticky' $ "[ Waiting for revision's dependency cache... last status: " <> viaShow Waiting <> " ]"
        pauseForRetry
        waitForValidDependenciesCache revision cancelFlag locatorType
      UnknownDependencyCacheStatus status -> fatalText $ "unknown status of " <> status <> " received for revision's dependency cache"
  