content: -- | Module for resolving hash-related queries.
  -- Note that for most API calls we need to somehow validate that the caller has access to the
  -- resource they're accessing.
  --
  -- The rule goes like this:
  -- * If a hash is provided, we should validate that the user has access to that resource by
  -- checking that it's in their codebase via the appropriate ownership table, and then convert
  -- it into the appropriate ID rather than Hash and pass the ID around from that point onwards.
  -- * If an ID is provided, we assume that the caller has already validated that they have access
  -- to that resource and any resources contained within it. E.g. if a call provides a CausalId,
  -- it's assumed the caller has already validated that they have access to the Causal and by
  -- extension all branches, definitions, patches, and metadata contained inside.
  module Share.Postgres.Hashes.Queries
    ( ensureComponentHashIdsOf,
      expectComponentHashIdsOf,
      expectComponentHashesOf,
      expectComponentHashId,
      componentHashIdsOf,
      expectPatchHashesOf,
      expectPatchIdsOf,
      ensureBranchHashId,
      loadBranchHashId,
      expectBranchHashId,
      expectBranchHash,
      expectCausalHashesByIdsOf,
      expectCausalAndBranchHashesOf,
      expectCausalIdsOf,
      loadCausalIdByHash,
      expectCausalIdByHash,
      expectNamespaceIdsByCausalIdsOf,
      expectNamespaceHashesByNamespaceHashIdsOf,
      isComponentHashAllowedToBeMismatched,
      isCausalHashAllowedToBeMismatched,
      addKnownComponentHashMismatch,
      addKnownCausalHashMismatch,
      expectComponentSummaryDigest,
    )
  where
  
  import Control.Lens
  import Share.Codebase.Types (CodebaseEnv (CodebaseEnv))
  import Share.Codebase.Types qualified as Codebase
  import Share.Postgres
  import Share.Postgres.IDs
  import Share.Prelude
  import Share.Utils.Postgres (ordered)
  import Share.Web.Errors (EntityMissing (EntityMissing), MissingExpectedEntity (..))
  
  -- | Get the matching hashId for every component hash, saving any that are missing.
  -- Maintains the invariant that the returned list matches the positions of the input list.
  ensureComponentHashIdsOf :: forall m s t. (QueryA m, HasCallStack) => Traversal s t ComponentHash ComponentHashId -> s -> m t
  ensureComponentHashIdsOf trav s =
    s
      & asListOf trav %%~ \componentHashes ->
        do
          let numberedHashIds = zip [1 :: Int32 ..] componentHashes
          queryListCol @ComponentHashId
            [sql|
      WITH new_hashes(ord, hash) AS (
            SELECT * FROM ^{toTable numberedHashIds}
      ), inserted_hashes(hash, id) AS (
        INSERT INTO component_hashes (base32)
          SELECT DISTINCT new_hashes.hash FROM new_hashes
          ON CONFLICT DO NOTHING
          RETURNING base32, id
      )
      SELECT COALESCE(inserted_hashes.id, existing_hash.id)
        FROM new_hashes
          LEFT JOIN component_hashes existing_hash ON existing_hash.base32 = new_hashes.hash
          LEFT JOIN inserted_hashes ON inserted_hashes.hash = new_hashes.hash
        ORDER BY new_hashes.ord ASC
      |]
  
  expectComponentHashIdsOf :: (HasCallStack, QueryA m) => Traversal s t ComponentHash ComponentHashId -> s -> m t
  expectComponentHashIdsOf trav s = do
    let expectJust f ch = fmap (fromMaybe $ error "Expected a component hash but got Nothing!") $ f ch
    componentHashIdsOf (trav . expectJust) s
  
  -- | Get the matching hashId for every component hash, or Nothing if the hash is not found.
  componentHashIdsOf :: (HasCallStack, QueryA m) => Traversal s t ComponentHash (Maybe ComponentHashId) -> s -> m t
  componentHashIdsOf trav s = do
    s
      & asListOf trav %%~ \componentHashes -> do
        let numberedHashes = zip [1 :: Int32 ..] componentHashes
        queryListCol @(Maybe ComponentHashId)
          [sql|
        WITH hashes(ord, hash) AS (
          SELECT * FROM ^{toTable numberedHashes}
        )
        SELECT component_hashes.id FROM hashes
          LEFT JOIN component_hashes ON component_hashes.base32 = hashes.hash
          ORDER BY hashes.ord ASC
        |]
  
  expectComponentHashId :: (HasCallStack, QueryM m) => ComponentHash -> m ComponentHashId
  expectComponentHashId componentHash = do
    queryExpect1Col [sql|SELECT id FROM component_hashes WHERE base32 = #{componentHash}|]
  
  expectComponentHashesOf :: (HasCallStack, QueryA m) => Traversal s t ComponentHashId ComponentHash -> s -> m t
  expectComponentHashesOf trav = do
    asListOf trav %%~ \hashIds ->
      do
        let numberedHashIds = zip [0 :: Int32 ..] hashIds
        queryListCol
          [sql|
        WITH hash_ids(ord, id) AS (
          SELECT * FROM ^{toTable numberedHashIds}
        )
        SELECT base32 FROM component_hashes JOIN hash_ids ON component_hashes.id = hash_ids.id
          ORDER BY hash_ids.ord ASC
        |]
  
  expectPatchHashesOf :: (HasCallStack, QueryA m) => Traversal s t PatchId PatchHash -> s -> m t
  expectPatchHashesOf trav = do
    asListOf trav %%~ \hashIds -> do
      let numberedHashIds = zip [0 :: Int32 ..] hashIds
      queryListCol
        [sql|
        WITH hash_ids(ord, id) AS (
          SELECT * FROM ^{toTable numberedHashIds}
        )
        SELECT patch.hash FROM patches patch JOIN hash_ids ON patch.id = hash_ids.id
          ORDER BY hash_ids.ord ASC
        |]
  
  expectPatchIdsOf :: (HasCallStack, QueryA m) => CodebaseEnv -> Traversal s t PatchHash PatchId -> s -> m t
  expectPatchIdsOf (CodebaseEnv {codebaseOwner}) trav = do
    asListOf trav %%~ \hashes -> do
      let numberedHashes = zip [0 :: Int32 ..] hashes
      queryListCol
        [sql|
        WITH hashes(ord, hash) AS (
          SELECT * FROM ^{toTable numberedHashes}
        )
        SELECT p.id FROM patches p JOIN hashes h ON p.hash = h.hash
          WHERE EXISTS (
            SELECT FROM patch_ownership po
              WHERE po.patch_id = p.id
                AND po.user_id = #{codebaseOwner}
          )
          ORDER BY h.ord ASC
        |]
  
  -- | Save a branch hash, or return the existing hash id if it already exists
  ensureBranchHashId :: (HasCallStack, QueryM m) => BranchHash -> m BranchHashId
  ensureBranchHashId branchHash = do
    query1Col [sql|SELECT id FROM branch_hashes WHERE base32 = #{branchHash}|] >>= \case
      Just hashId -> pure hashId
      Nothing -> queryExpect1Col [sql|INSERT INTO branch_hashes (base32) VALUES (#{branchHash}) RETURNING id|]
  
  loadBranchHashId :: (QueryM m) => CodebaseEnv -> BranchHash -> m (Maybe BranchHashId)
  loadBranchHashId (CodebaseEnv {codebaseOwner}) branchHash = do
    query1Col
      [sql|
      SELECT bh.id FROM branch_hashes bh
        WHERE bh.base32 = #{branchHash}
          AND EXISTS (
            SELECT FROM namespace_ownership no
              WHERE no.namespace_hash_id = bh.id
                AND no.user_id = #{codebaseOwner}
        )
      |]
  
  expectBranchHashId :: (QueryM m, HasCallStack) => CodebaseEnv -> BranchHash -> m BranchHashId
  expectBranchHashId codebase branchHash = do
    loadBranchHashId codebase branchHash >>= \case
      Just hashId -> pure hashId
      Nothing -> unrecoverableError $ EntityMissing "missing-namespace-for-hash" ("Namespace not found for hash: " <> into @Text branchHash)
  
  expectBranchHash :: (HasCallStack, QueryM m) => BranchHashId -> m BranchHash
  expectBranchHash hashId = queryExpect1Col [sql|SELECT base32 FROM branch_hashes WHERE id = #{hashId}|]
  
  -- | Returns whether we should allow a hash mismatch for the given pair of hashes.
  isComponentHashAllowedToBeMismatched :: (HasCallStack, QueryM m) => ComponentHash -> ComponentHash -> m Bool
  isComponentHashAllowedToBeMismatched providedHash actualHash = do
    queryExpect1Col
      [sql|
      SELECT EXISTS(
        SELECT FROM known_component_hash_mismatches mismatch
          WHERE mismatch.provided_component_hash = #{providedHash}
            AND mismatch.actual_component_hash = #{actualHash}
        )
      |]
  
  -- | Returns whether we should allow a hash mismatch for the given pair of hashes.
  isCausalHashAllowedToBeMismatched :: (HasCallStack, QueryM m) => CausalHash -> CausalHash -> m Bool
  isCausalHashAllowedToBeMismatched providedHash actualHash = do
    queryExpect1Col
      [sql|
      SELECT EXISTS(
        SELECT FROM known_causal_hash_mismatches mismatches
          WHERE mismatches.provided_causal_hash = #{providedHash}
            AND mismatches.actual_causal_hash = #{actualHash}
        )
      |]
  
  addKnownComponentHashMismatch :: (QueryM m) => ComponentHash -> ComponentHash -> m ()
  addKnownComponentHashMismatch providedHash actualHash = do
    execute_
      [sql|
      INSERT INTO known_component_hash_mismatches (provided_component_hash, actual_component_hash)
        VALUES (#{providedHash}, #{actualHash})
        ON CONFLICT DO NOTHING
      |]
  
  addKnownCausalHashMismatch :: (QueryM m) => CausalHash -> CausalHash -> m ()
  addKnownCausalHashMismatch providedHash actualHash = do
    execute_
      [sql|
      INSERT INTO known_causal_hash_mismatches (provided_causal_hash, actual_causal_hash)
        VALUES (#{providedHash}, #{actualHash})
        ON CONFLICT DO NOTHING
      |]
  
  -- | Generic helper which fetches both branch hashes and causal hashes
  expectCausalHashesOfG :: (HasCallStack, QueryA m) => ((BranchHash, CausalHash) -> h) -> Traversal s t CausalId h -> s -> m t
  expectCausalHashesOfG project trav = do
    asListOf trav %%~ \hashIds -> do
      let numberedHashIds = zip [0 :: Int32 ..] hashIds
      (\results -> if length results /= length hashIds then error "expectCausalHashesOf: Missing expected causal hash" else (project <$> results))
        <$> queryListRows
          [sql|
            WITH causal_ids(ord, id) AS (
              SELECT * FROM ^{toTable numberedHashIds}
            )
            SELECT bh.base32, causal.hash
              FROM causal_ids
                JOIN causals causal ON causal.id = causal_ids.id
                JOIN branch_hashes bh ON causal.namespace_hash_id = bh.id
              ORDER BY causal_ids.ord ASC
          |]
  
  expectCausalAndBranchHashesOf :: (HasCallStack, QueryA m) => Traversal s t CausalId (BranchHash, CausalHash) -> s -> m t
  expectCausalAndBranchHashesOf = expectCausalHashesOfG id
  
  expectCausalHashesByIdsOf :: (HasCallStack, QueryA m) => Traversal s t CausalId CausalHash -> s -> m t
  expectCausalHashesByIdsOf = expectCausalHashesOfG snd
  
  expectCausalIdsOf :: (HasCallStack, QueryA m) => CodebaseEnv -> Traversal s t CausalHash (BranchHashId, CausalId) -> s -> m t
  expectCausalIdsOf (CodebaseEnv {codebaseOwner}) trav = do
    asListOf trav %%~ \hashes -> do
      let numberedHashes = zip [0 :: Int32 ..] hashes
      queryListRows @(BranchHashId, CausalId)
        [sql|
        WITH hashes(ord, hash) AS (
          SELECT * FROM ^{toTable numberedHashes}
        )
        SELECT bh.id, causal.id
          FROM hashes
            JOIN causals causal ON causal.hash = hashes.hash
            JOIN branch_hashes bh ON causal.namespace_hash_id = bh.id
            WHERE EXISTS (
              SELECT FROM causal_ownership co
                WHERE co.causal_id = causal.id
                  AND co.user_id = #{codebaseOwner}
            )
          ORDER BY hashes.ord ASC
        |]
  
  expectNamespaceIdsByCausalIdsOf :: (QueryA m) => Traversal s t CausalId BranchHashId -> s -> m t
  expectNamespaceIdsByCausalIdsOf trav s = do
    s
      & asListOf trav %%~ \causalIds -> do
        let causalIdsTable = ordered causalIds
        queryListCol @(BranchHashId)
          [sql| WITH causal_ids(ord, causal_id) AS (
                  SELECT ord, causal_id FROM ^{toTable causalIdsTable} as t(ord, causal_id)
                )
                SELECT c.namespace_hash_id
                  FROM causal_ids cid
                  JOIN causals c ON cid.causal_id = c.id
                  ORDER BY cid.ord
          |]
  
  expectNamespaceHashesByNamespaceHashIdsOf :: (HasCallStack, QueryA m) => Traversal s t BranchHashId BranchHash -> s -> m t
  expectNamespaceHashesByNamespaceHashIdsOf trav s = do
    s
      & asListOf trav %%~ \namespaceHashIds -> do
        let namespaceHashIdsTable = ordered namespaceHashIds
        queryListCol @(BranchHash)
          [sql| WITH namespace_hash_ids(ord, namespace_hash_id) AS (
                  SELECT ord, namespace_hash_id FROM ^{toTable namespaceHashIdsTable} as t(ord, namespace_hash_id)
                )
                SELECT bh.base32
                  FROM namespace_hash_ids nhi
                  JOIN branch_hashes bh ON nhi.namespace_hash_id = bh.id
                  ORDER BY nhi.ord
          |]
  
  loadCausalIdByHash :: (QueryM m) => CodebaseEnv -> CausalHash -> m (Maybe CausalId)
  loadCausalIdByHash (CodebaseEnv {codebaseOwner}) causalHash = do
    query1Col
      [sql| SELECT causals.id FROM causals
              WHERE causals.hash = #{causalHash}
                AND EXISTS (SELECT FROM causal_ownership o WHERE o.causal_id = causals.id AND o.user_id = #{codebaseOwner})
      |]
  
  expectCausalIdByHash :: (HasCallStack, QueryM m) => CodebaseEnv -> CausalHash -> m CausalId
  expectCausalIdByHash codebase causalHash = do
    loadCausalIdByHash codebase causalHash
      `whenNothingM` unrecoverableError (MissingExpectedEntity $ "Expected causal id for hash: " <> tShow causalHash)
  
  -- | Computes the summary digest of a component within the given user's codebase.
  expectComponentSummaryDigest :: (HasCallStack, QueryM m) => CodebaseEnv -> ComponentHashId -> m ComponentSummaryDigest
  expectComponentSummaryDigest (CodebaseEnv {codebaseOwner}) componentHashId = do
    queryExpect1Col
      [sql|
      SELECT compute_component_summary_digest(#{codebaseOwner}, #{componentHashId})
      |]
  