Codd.hs

{-# LANGUAGE TemplateHaskell #-}

module Kiroku.Store.Migrations.History.Codd
  ( kirokuCoddHistoryMappings,
    kirokuCoddManifestText,
    kirokuCoddSourceConfig,
    kirokuCoddSourcePayloads,
    kirokuLegacyMigrationNames,
  )
where

import Data.Bifunctor (first)
import Data.ByteString (ByteString)
import Data.Foldable (toList)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Map.Strict qualified as Map
import Data.Text (Text)
import Database.PostgreSQL.Migrate
  ( Confirmation,
    ConnectionProvider,
    EvidenceRequirement (Evidence),
    HistoryMapping,
    PayloadRelation (SamePayload),
    historyMapping,
    migrationId,
  )
import Database.PostgreSQL.Migrate.History.Codd
  ( CoddDefinitionError,
    CoddSourceConfig,
    coddEvidenceKey,
    coddSourceConfig,
    parseCoddManifest,
  )
import Kiroku.Store.Migrations.Internal.Definition (embeddedMigrationEntries)
import Kiroku.Store.Migrations.Internal.EmbedFile (embedTextFile)

kirokuLegacyMigrationNames :: NonEmpty FilePath
kirokuLegacyMigrationNames =
  "2026-05-16-12-17-14-kiroku-bootstrap.sql"
    :| [ "2026-05-29-15-26-04-add-subscription-dead-letters.sql",
         "2026-06-14-13-17-09-notify-trigger-append-guard.sql",
         "2026-06-14-13-25-40-dead-letters-event-id-index.sql",
         "2026-06-14-13-54-48-index-hygiene-and-streams-fillfactor.sql",
         "2026-06-14-14-01-17-stream-name-length-check.sql",
         "2026-06-24-09-42-22-stream-truncate-before.sql"
       ]

kirokuCoddHistoryMappings :: NonEmpty HistoryMapping
kirokuCoddHistoryMappings =
  zipWithNonEmpty mapping kirokuLegacyMigrationNames nativeMigrationNames
  where
    mapping sourceFilename targetName =
      historyMapping
        (definitionInvariant (migrationId "kiroku" targetName))
        (Evidence sourceKey)
        (SamePayload sourceKey)
      where
        sourceKey = definitionInvariant (first show (coddEvidenceKey sourceFilename))

kirokuCoddSourceConfig ::
  ConnectionProvider ->
  Bool ->
  Text ->
  Confirmation ->
  Either CoddDefinitionError CoddSourceConfig
kirokuCoddSourceConfig sourceProvider strictSource reason confirmation =
  coddSourceConfig
    sourceProvider
    kirokuLegacyMigrationNames
    strictSource
    kirokuCoddSourcePayloads
    (Just (definitionInvariant (parseCoddManifest kirokuCoddManifestText)))
    reason
    confirmation

nativeMigrationNames :: NonEmpty Text
nativeMigrationNames =
  "0001-kiroku-bootstrap"
    :| [ "0002-add-subscription-dead-letters",
         "0003-notify-trigger-append-guard",
         "0004-dead-letters-event-id-index",
         "0005-index-hygiene-and-streams-fillfactor",
         "0006-stream-name-length-check",
         "0007-stream-truncate-before"
       ]

kirokuCoddSourcePayloads :: Map.Map FilePath ByteString
kirokuCoddSourcePayloads =
  Map.fromList
    (zip (toList kirokuLegacyMigrationNames) (snd <$> toList embeddedMigrationEntries))

kirokuCoddManifestText :: Text
kirokuCoddManifestText = $(embedTextFile "migrations.lock")

zipWithNonEmpty :: (a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
zipWithNonEmpty combine (firstA :| restA) (firstB :| restB) =
  combine firstA firstB :| zipWith combine restA restB

definitionInvariant :: (Show error) => Either error value -> value
definitionInvariant = either (error . ("invalid checked-in Kiroku migration definition: " <>) . show) id