{-# LANGUAGE DeriveGeneric         #-}
# LANGUAGE DuplicateRecordFields #
# LANGUAGE OverloadedStrings      #

module Sql.Update where

import           Control.Monad.IO.Class     (liftIO)
import           Control.Monad.Trans.Except (ExceptT (ExceptT), except,
                                             runExceptT)
import           Control.Monad.Trans.Reader (ask, runReaderT)
import           Data.Aeson
import           Data.Bifunctor             (first)
import           Data.Either.Utils          (maybeToEither)
import           Data.HashMap.Strict        (HashMap)
import qualified Data.HashMap.Strict        as HashMap
import           Data.List                  (partition)
import qualified Data.Maybe                 as Maybe
import qualified Data.Set                   as Set
import           Data.Text                  (Text)
import qualified Data.Text                  as T
import           Data.Tuple                 (swap)
import           Database.PostgreSQL.Simple
import           GHC.Generics
import qualified Network.OAuth.OAuth2       as OAuth2
import qualified Safe

import qualified Builds
import qualified BuildSteps
import qualified CircleApi
import qualified CircleTrigger
import qualified CommitBuilds
import qualified Constants
import qualified DbHelpers
import qualified DebugUtils                 as D
import qualified GitHubAuth
import qualified GitRev
import qualified JsonUtils
import qualified MyUtils
import qualified Sql.QueryUtils             as Q
import qualified Sql.Read.Breakages         as ReadBreakages
import qualified Sql.Read.Builds            as ReadBuilds
import qualified Sql.Read.Matches           as ReadMatches
import qualified Sql.Read.Read              as SqlRead
import qualified Sql.Read.Types             as SqlReadTypes
import qualified Sql.Write                  as SqlWrite


data CommitInfoCounts = NewCommitInfoCounts {
    _failed_build_count        :: Int
  , _timeout_count             :: Int
  , _total_matched_build_count :: Int
  , _flaky_build_count         :: Int
  , _other_matched_build_count :: Int
  , _idiopathic_count          :: Int
  , _unmatched_count           :: Int
  , _known_broken_count        :: Int
  } deriving Generic

instance ToJSON CommitInfoCounts where
  toJSON = genericToJSON JsonUtils.dropUnderscore


data CommitInfo = NewCommitInfo {
    _breakages :: [DbHelpers.WithId ReadBreakages.CodeBreakage]
  , _counts    :: CommitInfoCounts
  } deriving Generic

instance ToJSON CommitInfo where
  toJSON = genericToJSON JsonUtils.dropUnderscore


data SingleBuildInfo = SingleBuildInfo {
    _multi_match_count :: Int
  , _build_info        :: BuildSteps.BuildStep
  , _known_failures    :: [DbHelpers.WithId ReadBreakages.CodeBreakage]
  , _umbrella_build    :: Builds.StorableBuild
  } deriving Generic

instance ToJSON SingleBuildInfo where
  toJSON = genericToJSON JsonUtils.dropUnderscore


data BuildInfoRetrievalBenchmarks = BuildInfoRetrievalBenchmarks {
    _best_match_retrieval       :: Float
  , _breakages_retrieval_timing :: Float
  } deriving Generic

instance ToJSON BuildInfoRetrievalBenchmarks where
  toJSON = genericToJSON JsonUtils.dropUnderscore


data UpstreamBreakagesInfo = UpstreamBreakagesInfo {
    merge_base :: Builds.RawCommit
  , manually_annotated_breakages :: [DbHelpers.WithId ReadBreakages.CodeBreakage]
  , inferred_upstream_breakages_by_job :: HashMap Text SqlReadTypes.UpstreamBrokenJob
  }


getBuildInfo ::
     CircleApi.ThirdPartyAuth
  -> Builds.UniversalBuildId
  -> SqlReadTypes.DbIO (Either Text (DbHelpers.BenchmarkedResponse BuildInfoRetrievalBenchmarks SingleBuildInfo))
getBuildInfo
    (CircleApi.ThirdPartyAuth _ jwt_signer _)
    build@(Builds.UniversalBuildId build_id) = do

  TODO Replace this with SQL COUNT ( )
  DbHelpers.BenchmarkedResponse best_match_retrieval_timing matches <- ReadMatches.getBuildPatternMatches build

  either_storable_build <- ReadBuilds.getGlobalBuild build

  conn <- ask

  liftIO $ do

    xs <- query conn sql $ Only build_id

    let err_msg = unwords [
            "Build with ID"
          , show build_id
          , "not found!"
          ]

        either_tuple = f (length matches) <$> maybeToEither
          (T.pack err_msg)
          (Safe.headMay xs)

    runExceptT $ do

      storable_build <- except either_storable_build

      (multi_match_count, step_container) <- except either_tuple

      let sha1 = Builds.vcs_revision $ BuildSteps.build step_container
          job_name = Builds.job_name $ BuildSteps.build step_container


      github_token_wrapper <- ExceptT $ first T.pack <$>
        GitHubAuth.getGitHubAppInstallationToken jwt_signer

      (_nearest_ancestor, manually_annotated_breakages, breakages_retrieval_timing) <- ExceptT $
        flip runReaderT conn $
          findAnnotatedBuildBreakages
            (GitHubAuth.token github_token_wrapper)
            Constants.pytorchRepoOwner
            sha1

      let breakage_membership_predicate = Set.member job_name . ReadBreakages._jobs . DbHelpers.record
          applicable_breakages = filter breakage_membership_predicate manually_annotated_breakages

          timing_info = BuildInfoRetrievalBenchmarks
            best_match_retrieval_timing
            breakages_retrieval_timing

      return $ DbHelpers.BenchmarkedResponse timing_info $
        SingleBuildInfo
          multi_match_count
          step_container
          applicable_breakages
          storable_build

  where
    f multi_match_count (
        step_id
      , step_name
      , build_num
      , vcs_revision
      , queued_at
      , job_name
      , branch
      , started_at
      , finished_at
      ) = (multi_match_count, step_container)
      where
        step_container = BuildSteps.NewBuildStep
          step_name
          (Builds.NewBuildStepId step_id)
          build_obj

  TODO This is redundant with 
        build_obj = Builds.NewBuild
          (Builds.NewBuildNumber build_num)
          (Builds.RawCommit vcs_revision)
          queued_at
          job_name
          branch
          started_at
          finished_at

    sql = Q.join [
        "SELECT"
      , Q.list [
          "step_id"
        , Q.coalesce "step_name" "''" "step_name"
        , "build_num"
        , "vcs_revision"
        , "queued_at"
        , "job_name"
        , "branch"
        , "started_at"
        , "finished_at"
        ]
      , "FROM builds_join_steps"
      , "WHERE universal_build = ?"
      ]


data RevisionBuildCountBenchmarks = RevisionBuildCountBenchmarks {
    _row_retrieval              :: Float
  , _known_broken_determination :: Float
  } deriving Generic

instance ToJSON RevisionBuildCountBenchmarks where
  toJSON = genericToJSON JsonUtils.dropUnderscore


countRevisionBuilds ::
     CircleApi.ThirdPartyAuth
  -> GitRev.GitSha1
  -> SqlReadTypes.DbIO (Either Text (DbHelpers.BenchmarkedResponse RevisionBuildCountBenchmarks CommitInfo))
countRevisionBuilds
    (CircleApi.ThirdPartyAuth _ jwt_signer _)
    git_revision = do

  conn <- ask

  liftIO $ D.debugList [
      "SQL query for countRevisionBuilds:"
    , show aggregate_causes_sql
    , "PARMS:"
    , show only_commit
    ]
  (row_retrieval_time, rows) <- D.timeThisFloat $ liftIO $
    query conn aggregate_causes_sql only_commit

  liftIO $ runExceptT $ do

    github_token_wrapper <- ExceptT $ first T.pack <$>
      GitHubAuth.getGitHubAppInstallationToken jwt_signer

    let err = T.pack $ unwords [
            "No entries in"
          , MyUtils.quote "build_failure_disjoint_causes_by_commit"
          , "table for commit"
          , T.unpack $ GitRev.sha1 git_revision
          ]

    (   total
      , idiopathic
      , timeout
      , known_broken
      , pattern_matched
      , pattern_matched_other
      , flaky
      , pattern_unmatched
      , succeeded
      ) <- except $ maybeToEither err $ Safe.headMay rows

    (_nearest_ancestor, manually_annotated_breakages, known_broken_determination_time) <- ExceptT $
        flip runReaderT conn $
          findAnnotatedBuildBreakages
            (GitHubAuth.token github_token_wrapper)
            Constants.pytorchRepoOwner
            (Builds.RawCommit sha1)

    return $ DbHelpers.BenchmarkedResponse
      (RevisionBuildCountBenchmarks row_retrieval_time known_broken_determination_time) $
        NewCommitInfo manually_annotated_breakages $ NewCommitInfoCounts
          (total - succeeded)
          timeout
          pattern_matched
          flaky
          pattern_matched_other
          idiopathic
          pattern_unmatched
          known_broken

  where
    sha1 = GitRev.sha1 git_revision
    only_commit = Only sha1

    aggregate_causes_sql = Q.join [
        "SELECT"
      , Q.list [
          "total"
        , "idiopathic"
        , "timeout"
        , "known_broken"
        , "pattern_matched"
        , "pattern_matched_other"
        , "flaky"
        , "pattern_unmatched"
        , "succeeded"
        ]
      , "FROM build_failure_disjoint_causes_by_commit"
      , "WHERE sha1 = ?"
      , "LIMIT 1"
      ]


-- | Find known build breakages applicable to the merge base
-- of this PR commit
findKnownBuildBreakages ::
     OAuth2.AccessToken
  -> DbHelpers.OwnerAndRepo
  -> Builds.RawCommit
  -> SqlReadTypes.DbIO (Either Text UpstreamBreakagesInfo)
findKnownBuildBreakages access_token owned_repo sha1 = do
  conn <- ask
  liftIO $ runExceptT $ do

    (nearest_ancestor, manually_annotated_breakages, _breakages_retrieval_timing) <- ExceptT $
      flip runReaderT conn $
        findAnnotatedBuildBreakages access_token owned_repo sha1

    -- TODO Use both manually annotated and inferred methods for
    -- associating breakages!

    (_inferred_breakages_retrieval_timing, inferred_upstream_caused_broken_jobs) <- D.timeThisFloat $
      liftIO $ flip runReaderT conn $ ReadBreakages.getInferredSpanningBrokenJobsBetter sha1

    let inferred_breakages_map = HashMap.fromList $ map
          (swap . MyUtils.derivePair SqlReadTypes.extractJobName)
          inferred_upstream_caused_broken_jobs

    -- NOTE: This requires that the "merge base" with master of the branch
    -- commit already be cached into the database.
    -- SqlWrite.findMasterAncestor does this for us.
    return $ UpstreamBreakagesInfo
      nearest_ancestor
      manually_annotated_breakages
      inferred_breakages_map


findAnnotatedBuildBreakages access_token owned_repo sha1 = do
  conn <- ask
  liftIO $ runExceptT $ do

  Second , find which " master " commit is the most recent
    -- ancestor of the given PR commit.
    (nearest_ancestor_retrieval_timing, nearest_ancestor) <- D.timeThisFloat $
      ExceptT $ SqlWrite.findMasterAncestor
        conn
        access_token
        owned_repo
        SqlWrite.StoreToCache
        sha1

    -- Third, find whether that commit is within the
    -- [start, end) span of any known breakages
    (manual_breakages_retrieval_timing, manually_annotated_breakages) <- D.timeThisFloat $ ExceptT $
      ReadBreakages.getSpanningBreakages conn nearest_ancestor

    let combined_time = nearest_ancestor_retrieval_timing + manual_breakages_retrieval_timing

    return (nearest_ancestor, manually_annotated_breakages, combined_time)



data CommitRebuildsResponse = CommitRebuildsResponse {
    _all_builds          :: SqlRead.RevisionBuildsWithTimeouts
  , _flaky_candidates    :: [SqlReadTypes.StandardCommitBuildWrapper]
  , _flaky_noncandidates :: [SqlReadTypes.StandardCommitBuildWrapper]
  , _reran_builds        :: [(SqlReadTypes.StandardCommitBuildWrapper, SqlWrite.LocalRebuildTriggerEventId)]
  } deriving Generic

instance ToJSON CommitRebuildsResponse where
  toJSON = genericToJSON JsonUtils.dropUnderscore


getFlakyRebuildTuples ::
     [CommitBuilds.CommitBuildWrapper SqlReadTypes.CommitBuildSupplementalPayload]
  -> ([(Builds.UniversalBuildId, Builds.BuildNumber)], [CommitBuilds.CommitBuildWrapper SqlReadTypes.CommitBuildSupplementalPayload], [CommitBuilds.CommitBuildWrapper SqlReadTypes.CommitBuildSupplementalPayload])
getFlakyRebuildTuples builds =
  (rebuild_id_tuples, retryable_flaky_builds, non_retryable_flaky_builds)
  where
    rebuild_id_tuples = map ids_extractor retryable_flaky_builds

    -- NOTE: This post-database flakiness determination DOES NOT
    -- account for "serially isolated" as a flakiness indicator,
    -- because non-master commits don't have this property.
    pattern_matched_flaky_predicate = CommitBuilds._is_flaky . CommitBuilds._failure_mode . CommitBuilds._commit_build
    possibly_flaky_builds = filter pattern_matched_flaky_predicate builds

    is_retryable_predicate x = not (SqlReadTypes.is_empirically_determined_flaky sup || SqlReadTypes.has_triggered_rebuild sup)
      where
        sup = CommitBuilds._supplemental x

    (retryable_flaky_builds, non_retryable_flaky_builds) = partition is_retryable_predicate possibly_flaky_builds

    ids_extractor x = (Builds.UniversalBuildId $ DbHelpers.db_id $ Builds.universal_build b, Builds.build_id $ Builds.build_record b)
      where
        b = CommitBuilds._build $ CommitBuilds._commit_build x


-- | NOTE: This is not indended for use on master-branch builds
-- because it does not account for "serially isolated" as
-- a determination of flakiness.
triggerFlakyRebuildCandidates ::
     CircleApi.CircleCIApiToken
  -> Builds.RawCommit
  -> SqlReadTypes.AuthDbIO (Either Text (SqlReadTypes.UserWrapper (DbHelpers.BenchmarkedResponse Float CommitRebuildsResponse)))
triggerFlakyRebuildCandidates
    circleci_api_token
    (Builds.RawCommit commit_sha1_text) = do

  dbauth@(SqlReadTypes.AuthConnection conn user) <- ask

  liftIO $ runExceptT $ do
    git_revision <- except $ GitRev.validateSha1 commit_sha1_text
    DbHelpers.BenchmarkedResponse timing builds <- ExceptT $
      flip runReaderT conn $ SqlRead.getRevisionBuilds git_revision

    -- TODO Timed-out builds could be considered flaky!
    let SqlRead.RevisionBuildsWithTimeouts _timed_out_builds non_timed_out_builds = builds

    let (rebuild_id_tuples, retryable_flaky_builds, non_retryable_flaky_builds) = getFlakyRebuildTuples non_timed_out_builds

    results <- ExceptT $ fmap (first T.pack) $
      runExceptT $ CircleTrigger.rebuildCircleJobsInWorkflow
        dbauth
        circleci_api_token
        rebuild_id_tuples

    let retry_keys_by_universal_id = HashMap.fromList $ map (first Builds.extractUniversalId) results

        retryable_builds_with_db_keys = Maybe.mapMaybe (\x -> sequenceA (x, (`HashMap.lookup` retry_keys_by_universal_id) $ DbHelpers.db_id $ Builds.universal_build $ CommitBuilds._build $ CommitBuilds._commit_build x)) retryable_flaky_builds

    return $ SqlReadTypes.UserWrapper user $
      DbHelpers.BenchmarkedResponse timing $
        CommitRebuildsResponse
          builds
          retryable_flaky_builds
          non_retryable_flaky_builds
          retryable_builds_with_db_keys


# LANGUAGE DeriveGeneric         #
 | Find known build breakages applicable to the merge base
 of this PR commit
 TODO Use both manually annotated and inferred methods for
 associating breakages!
 NOTE: This requires that the "merge base" with master of the branch
 commit already be cached into the database.
 SqlWrite.findMasterAncestor does this for us.
 ancestor of the given PR commit.
 Third, find whether that commit is within the
 [start, end) span of any known breakages
 NOTE: This post-database flakiness determination DOES NOT
 account for "serially isolated" as a flakiness indicator,
 because non-master commits don't have this property.
 | NOTE: This is not indended for use on master-branch builds
 because it does not account for "serially isolated" as
 a determination of flakiness.
 TODO Timed-out builds could be considered flaky!
# LANGUAGE DuplicateRecordFields #
# LANGUAGE OverloadedStrings      #

module Sql.Update where

import           Control.Monad.IO.Class     (liftIO)
import           Control.Monad.Trans.Except (ExceptT (ExceptT), except,
                                             runExceptT)
import           Control.Monad.Trans.Reader (ask, runReaderT)
import           Data.Aeson
import           Data.Bifunctor             (first)
import           Data.Either.Utils          (maybeToEither)
import           Data.HashMap.Strict        (HashMap)
import qualified Data.HashMap.Strict        as HashMap
import           Data.List                  (partition)
import qualified Data.Maybe                 as Maybe
import qualified Data.Set                   as Set
import           Data.Text                  (Text)
import qualified Data.Text                  as T
import           Data.Tuple                 (swap)
import           Database.PostgreSQL.Simple
import           GHC.Generics
import qualified Network.OAuth.OAuth2       as OAuth2
import qualified Safe

import qualified Builds
import qualified BuildSteps
import qualified CircleApi
import qualified CircleTrigger
import qualified CommitBuilds
import qualified Constants
import qualified DbHelpers
import qualified DebugUtils                 as D
import qualified GitHubAuth
import qualified GitRev
import qualified JsonUtils
import qualified MyUtils
import qualified Sql.QueryUtils             as Q
import qualified Sql.Read.Breakages         as ReadBreakages
import qualified Sql.Read.Builds            as ReadBuilds
import qualified Sql.Read.Matches           as ReadMatches
import qualified Sql.Read.Read              as SqlRead
import qualified Sql.Read.Types             as SqlReadTypes
import qualified Sql.Write                  as SqlWrite


data CommitInfoCounts = NewCommitInfoCounts {
    _failed_build_count        :: Int
  , _timeout_count             :: Int
  , _total_matched_build_count :: Int
  , _flaky_build_count         :: Int
  , _other_matched_build_count :: Int
  , _idiopathic_count          :: Int
  , _unmatched_count           :: Int
  , _known_broken_count        :: Int
  } deriving Generic

instance ToJSON CommitInfoCounts where
  toJSON = genericToJSON JsonUtils.dropUnderscore


data CommitInfo = NewCommitInfo {
    _breakages :: [DbHelpers.WithId ReadBreakages.CodeBreakage]
  , _counts    :: CommitInfoCounts
  } deriving Generic

instance ToJSON CommitInfo where
  toJSON = genericToJSON JsonUtils.dropUnderscore


data SingleBuildInfo = SingleBuildInfo {
    _multi_match_count :: Int
  , _build_info        :: BuildSteps.BuildStep
  , _known_failures    :: [DbHelpers.WithId ReadBreakages.CodeBreakage]
  , _umbrella_build    :: Builds.StorableBuild
  } deriving Generic

instance ToJSON SingleBuildInfo where
  toJSON = genericToJSON JsonUtils.dropUnderscore


data BuildInfoRetrievalBenchmarks = BuildInfoRetrievalBenchmarks {
    _best_match_retrieval       :: Float
  , _breakages_retrieval_timing :: Float
  } deriving Generic

instance ToJSON BuildInfoRetrievalBenchmarks where
  toJSON = genericToJSON JsonUtils.dropUnderscore


data UpstreamBreakagesInfo = UpstreamBreakagesInfo {
    merge_base :: Builds.RawCommit
  , manually_annotated_breakages :: [DbHelpers.WithId ReadBreakages.CodeBreakage]
  , inferred_upstream_breakages_by_job :: HashMap Text SqlReadTypes.UpstreamBrokenJob
  }


getBuildInfo ::
     CircleApi.ThirdPartyAuth
  -> Builds.UniversalBuildId
  -> SqlReadTypes.DbIO (Either Text (DbHelpers.BenchmarkedResponse BuildInfoRetrievalBenchmarks SingleBuildInfo))
getBuildInfo
    (CircleApi.ThirdPartyAuth _ jwt_signer _)
    build@(Builds.UniversalBuildId build_id) = do

  TODO Replace this with SQL COUNT ( )
  DbHelpers.BenchmarkedResponse best_match_retrieval_timing matches <- ReadMatches.getBuildPatternMatches build

  either_storable_build <- ReadBuilds.getGlobalBuild build

  conn <- ask

  liftIO $ do

    xs <- query conn sql $ Only build_id

    let err_msg = unwords [
            "Build with ID"
          , show build_id
          , "not found!"
          ]

        either_tuple = f (length matches) <$> maybeToEither
          (T.pack err_msg)
          (Safe.headMay xs)

    runExceptT $ do

      storable_build <- except either_storable_build

      (multi_match_count, step_container) <- except either_tuple

      let sha1 = Builds.vcs_revision $ BuildSteps.build step_container
          job_name = Builds.job_name $ BuildSteps.build step_container


      github_token_wrapper <- ExceptT $ first T.pack <$>
        GitHubAuth.getGitHubAppInstallationToken jwt_signer

      (_nearest_ancestor, manually_annotated_breakages, breakages_retrieval_timing) <- ExceptT $
        flip runReaderT conn $
          findAnnotatedBuildBreakages
            (GitHubAuth.token github_token_wrapper)
            Constants.pytorchRepoOwner
            sha1

      let breakage_membership_predicate = Set.member job_name . ReadBreakages._jobs . DbHelpers.record
          applicable_breakages = filter breakage_membership_predicate manually_annotated_breakages

          timing_info = BuildInfoRetrievalBenchmarks
            best_match_retrieval_timing
            breakages_retrieval_timing

      return $ DbHelpers.BenchmarkedResponse timing_info $
        SingleBuildInfo
          multi_match_count
          step_container
          applicable_breakages
          storable_build

  where
    f multi_match_count (
        step_id
      , step_name
      , build_num
      , vcs_revision
      , queued_at
      , job_name
      , branch
      , started_at
      , finished_at
      ) = (multi_match_count, step_container)
      where
        step_container = BuildSteps.NewBuildStep
          step_name
          (Builds.NewBuildStepId step_id)
          build_obj

  TODO This is redundant with 
        build_obj = Builds.NewBuild
          (Builds.NewBuildNumber build_num)
          (Builds.RawCommit vcs_revision)
          queued_at
          job_name
          branch
          started_at
          finished_at

    sql = Q.join [
        "SELECT"
      , Q.list [
          "step_id"
        , Q.coalesce "step_name" "''" "step_name"
        , "build_num"
        , "vcs_revision"
        , "queued_at"
        , "job_name"
        , "branch"
        , "started_at"
        , "finished_at"
        ]
      , "FROM builds_join_steps"
      , "WHERE universal_build = ?"
      ]


data RevisionBuildCountBenchmarks = RevisionBuildCountBenchmarks {
    _row_retrieval              :: Float
  , _known_broken_determination :: Float
  } deriving Generic

instance ToJSON RevisionBuildCountBenchmarks where
  toJSON = genericToJSON JsonUtils.dropUnderscore


countRevisionBuilds ::
     CircleApi.ThirdPartyAuth
  -> GitRev.GitSha1
  -> SqlReadTypes.DbIO (Either Text (DbHelpers.BenchmarkedResponse RevisionBuildCountBenchmarks CommitInfo))
countRevisionBuilds
    (CircleApi.ThirdPartyAuth _ jwt_signer _)
    git_revision = do

  conn <- ask

  liftIO $ D.debugList [
      "SQL query for countRevisionBuilds:"
    , show aggregate_causes_sql
    , "PARMS:"
    , show only_commit
    ]
  (row_retrieval_time, rows) <- D.timeThisFloat $ liftIO $
    query conn aggregate_causes_sql only_commit

  liftIO $ runExceptT $ do

    github_token_wrapper <- ExceptT $ first T.pack <$>
      GitHubAuth.getGitHubAppInstallationToken jwt_signer

    let err = T.pack $ unwords [
            "No entries in"
          , MyUtils.quote "build_failure_disjoint_causes_by_commit"
          , "table for commit"
          , T.unpack $ GitRev.sha1 git_revision
          ]

    (   total
      , idiopathic
      , timeout
      , known_broken
      , pattern_matched
      , pattern_matched_other
      , flaky
      , pattern_unmatched
      , succeeded
      ) <- except $ maybeToEither err $ Safe.headMay rows

    (_nearest_ancestor, manually_annotated_breakages, known_broken_determination_time) <- ExceptT $
        flip runReaderT conn $
          findAnnotatedBuildBreakages
            (GitHubAuth.token github_token_wrapper)
            Constants.pytorchRepoOwner
            (Builds.RawCommit sha1)

    return $ DbHelpers.BenchmarkedResponse
      (RevisionBuildCountBenchmarks row_retrieval_time known_broken_determination_time) $
        NewCommitInfo manually_annotated_breakages $ NewCommitInfoCounts
          (total - succeeded)
          timeout
          pattern_matched
          flaky
          pattern_matched_other
          idiopathic
          pattern_unmatched
          known_broken

  where
    sha1 = GitRev.sha1 git_revision
    only_commit = Only sha1

    aggregate_causes_sql = Q.join [
        "SELECT"
      , Q.list [
          "total"
        , "idiopathic"
        , "timeout"
        , "known_broken"
        , "pattern_matched"
        , "pattern_matched_other"
        , "flaky"
        , "pattern_unmatched"
        , "succeeded"
        ]
      , "FROM build_failure_disjoint_causes_by_commit"
      , "WHERE sha1 = ?"
      , "LIMIT 1"
      ]


findKnownBuildBreakages ::
     OAuth2.AccessToken
  -> DbHelpers.OwnerAndRepo
  -> Builds.RawCommit
  -> SqlReadTypes.DbIO (Either Text UpstreamBreakagesInfo)
findKnownBuildBreakages access_token owned_repo sha1 = do
  conn <- ask
  liftIO $ runExceptT $ do

    (nearest_ancestor, manually_annotated_breakages, _breakages_retrieval_timing) <- ExceptT $
      flip runReaderT conn $
        findAnnotatedBuildBreakages access_token owned_repo sha1


    (_inferred_breakages_retrieval_timing, inferred_upstream_caused_broken_jobs) <- D.timeThisFloat $
      liftIO $ flip runReaderT conn $ ReadBreakages.getInferredSpanningBrokenJobsBetter sha1

    let inferred_breakages_map = HashMap.fromList $ map
          (swap . MyUtils.derivePair SqlReadTypes.extractJobName)
          inferred_upstream_caused_broken_jobs

    return $ UpstreamBreakagesInfo
      nearest_ancestor
      manually_annotated_breakages
      inferred_breakages_map


findAnnotatedBuildBreakages access_token owned_repo sha1 = do
  conn <- ask
  liftIO $ runExceptT $ do

  Second , find which " master " commit is the most recent
    (nearest_ancestor_retrieval_timing, nearest_ancestor) <- D.timeThisFloat $
      ExceptT $ SqlWrite.findMasterAncestor
        conn
        access_token
        owned_repo
        SqlWrite.StoreToCache
        sha1

    (manual_breakages_retrieval_timing, manually_annotated_breakages) <- D.timeThisFloat $ ExceptT $
      ReadBreakages.getSpanningBreakages conn nearest_ancestor

    let combined_time = nearest_ancestor_retrieval_timing + manual_breakages_retrieval_timing

    return (nearest_ancestor, manually_annotated_breakages, combined_time)



data CommitRebuildsResponse = CommitRebuildsResponse {
    _all_builds          :: SqlRead.RevisionBuildsWithTimeouts
  , _flaky_candidates    :: [SqlReadTypes.StandardCommitBuildWrapper]
  , _flaky_noncandidates :: [SqlReadTypes.StandardCommitBuildWrapper]
  , _reran_builds        :: [(SqlReadTypes.StandardCommitBuildWrapper, SqlWrite.LocalRebuildTriggerEventId)]
  } deriving Generic

instance ToJSON CommitRebuildsResponse where
  toJSON = genericToJSON JsonUtils.dropUnderscore


getFlakyRebuildTuples ::
     [CommitBuilds.CommitBuildWrapper SqlReadTypes.CommitBuildSupplementalPayload]
  -> ([(Builds.UniversalBuildId, Builds.BuildNumber)], [CommitBuilds.CommitBuildWrapper SqlReadTypes.CommitBuildSupplementalPayload], [CommitBuilds.CommitBuildWrapper SqlReadTypes.CommitBuildSupplementalPayload])
getFlakyRebuildTuples builds =
  (rebuild_id_tuples, retryable_flaky_builds, non_retryable_flaky_builds)
  where
    rebuild_id_tuples = map ids_extractor retryable_flaky_builds

    pattern_matched_flaky_predicate = CommitBuilds._is_flaky . CommitBuilds._failure_mode . CommitBuilds._commit_build
    possibly_flaky_builds = filter pattern_matched_flaky_predicate builds

    is_retryable_predicate x = not (SqlReadTypes.is_empirically_determined_flaky sup || SqlReadTypes.has_triggered_rebuild sup)
      where
        sup = CommitBuilds._supplemental x

    (retryable_flaky_builds, non_retryable_flaky_builds) = partition is_retryable_predicate possibly_flaky_builds

    ids_extractor x = (Builds.UniversalBuildId $ DbHelpers.db_id $ Builds.universal_build b, Builds.build_id $ Builds.build_record b)
      where
        b = CommitBuilds._build $ CommitBuilds._commit_build x


triggerFlakyRebuildCandidates ::
     CircleApi.CircleCIApiToken
  -> Builds.RawCommit
  -> SqlReadTypes.AuthDbIO (Either Text (SqlReadTypes.UserWrapper (DbHelpers.BenchmarkedResponse Float CommitRebuildsResponse)))
triggerFlakyRebuildCandidates
    circleci_api_token
    (Builds.RawCommit commit_sha1_text) = do

  dbauth@(SqlReadTypes.AuthConnection conn user) <- ask

  liftIO $ runExceptT $ do
    git_revision <- except $ GitRev.validateSha1 commit_sha1_text
    DbHelpers.BenchmarkedResponse timing builds <- ExceptT $
      flip runReaderT conn $ SqlRead.getRevisionBuilds git_revision

    let SqlRead.RevisionBuildsWithTimeouts _timed_out_builds non_timed_out_builds = builds

    let (rebuild_id_tuples, retryable_flaky_builds, non_retryable_flaky_builds) = getFlakyRebuildTuples non_timed_out_builds

    results <- ExceptT $ fmap (first T.pack) $
      runExceptT $ CircleTrigger.rebuildCircleJobsInWorkflow
        dbauth
        circleci_api_token
        rebuild_id_tuples

    let retry_keys_by_universal_id = HashMap.fromList $ map (first Builds.extractUniversalId) results

        retryable_builds_with_db_keys = Maybe.mapMaybe (\x -> sequenceA (x, (`HashMap.lookup` retry_keys_by_universal_id) $ DbHelpers.db_id $ Builds.universal_build $ CommitBuilds._build $ CommitBuilds._commit_build x)) retryable_flaky_builds

    return $ SqlReadTypes.UserWrapper user $
      DbHelpers.BenchmarkedResponse timing $
        CommitRebuildsResponse
          builds
          retryable_flaky_builds
          non_retryable_flaky_builds
          retryable_builds_with_db_keys

