module Hasura.Server.Migrate.Version
  ( MetadataCatalogVersion (..),
    SourceCatalogVersion (..),
    SourceCatalogMigrationState (..),
  )
where

import Data.Aeson qualified as J
import Data.List (isPrefixOf)
import Data.Text.Extended
import Hasura.Logging (Hasura, LogLevel (..), ToEngineLog (..))
import Hasura.Prelude
import Hasura.RQL.Types.BackendType (BackendType)
import Hasura.RQL.Types.Common (SourceName)
import Hasura.Server.Logging (StartupLog (..))
import Language.Haskell.TH.Lift (Lift)

-- | Represents the catalog version. This is stored in the database and then
-- compared with the latest version on startup.
data MetadataCatalogVersion
  = -- | A typical catalog version.
    MetadataCatalogVersion Int
  | -- | Maintained for compatibility with catalog version 0.8.
    MetadataCatalogVersion08
  deriving stock (MetadataCatalogVersion -> MetadataCatalogVersion -> Bool
(MetadataCatalogVersion -> MetadataCatalogVersion -> Bool)
-> (MetadataCatalogVersion -> MetadataCatalogVersion -> Bool)
-> Eq MetadataCatalogVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MetadataCatalogVersion -> MetadataCatalogVersion -> Bool
== :: MetadataCatalogVersion -> MetadataCatalogVersion -> Bool
$c/= :: MetadataCatalogVersion -> MetadataCatalogVersion -> Bool
/= :: MetadataCatalogVersion -> MetadataCatalogVersion -> Bool
Eq, (forall (m :: * -> *). Quote m => MetadataCatalogVersion -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    MetadataCatalogVersion -> Code m MetadataCatalogVersion)
-> Lift MetadataCatalogVersion
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => MetadataCatalogVersion -> m Exp
forall (m :: * -> *).
Quote m =>
MetadataCatalogVersion -> Code m MetadataCatalogVersion
$clift :: forall (m :: * -> *). Quote m => MetadataCatalogVersion -> m Exp
lift :: forall (m :: * -> *). Quote m => MetadataCatalogVersion -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
MetadataCatalogVersion -> Code m MetadataCatalogVersion
liftTyped :: forall (m :: * -> *).
Quote m =>
MetadataCatalogVersion -> Code m MetadataCatalogVersion
Lift)

instance Ord MetadataCatalogVersion where
  compare :: MetadataCatalogVersion -> MetadataCatalogVersion -> Ordering
compare = Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float -> Ordering)
-> (MetadataCatalogVersion -> Float)
-> MetadataCatalogVersion
-> MetadataCatalogVersion
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` MetadataCatalogVersion -> Float
toFloat
    where
      toFloat :: MetadataCatalogVersion -> Float
      toFloat :: MetadataCatalogVersion -> Float
toFloat (MetadataCatalogVersion Int
v) = Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
v
      toFloat MetadataCatalogVersion
MetadataCatalogVersion08 = Float
0.8

instance Enum MetadataCatalogVersion where
  toEnum :: Int -> MetadataCatalogVersion
toEnum = Int -> MetadataCatalogVersion
MetadataCatalogVersion
  fromEnum :: MetadataCatalogVersion -> Int
fromEnum (MetadataCatalogVersion Int
v) = Int
v
  fromEnum MetadataCatalogVersion
MetadataCatalogVersion08 = [Char] -> Int
forall a. HasCallStack => [Char] -> a
error [Char]
"Cannot enumerate unstable catalog versions."

instance Show MetadataCatalogVersion where
  show :: MetadataCatalogVersion -> [Char]
show (MetadataCatalogVersion Int
v) = Int -> [Char]
forall a. Show a => a -> [Char]
show Int
v
  show MetadataCatalogVersion
MetadataCatalogVersion08 = [Char]
"0.8"

instance Read MetadataCatalogVersion where
  readsPrec :: Int -> ReadS MetadataCatalogVersion
readsPrec Int
prec [Char]
s
    | [Char]
"0.8" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
s =
        [(MetadataCatalogVersion
MetadataCatalogVersion08, Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
3 [Char]
s)]
    | Bool
otherwise =
        ((Int, [Char]) -> (MetadataCatalogVersion, [Char]))
-> [(Int, [Char])] -> [(MetadataCatalogVersion, [Char])]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> MetadataCatalogVersion)
-> (Int, [Char]) -> (MetadataCatalogVersion, [Char])
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Int -> MetadataCatalogVersion
MetadataCatalogVersion) ([(Int, [Char])] -> [(MetadataCatalogVersion, [Char])])
-> [(Int, [Char])] -> [(MetadataCatalogVersion, [Char])]
forall a b. (a -> b) -> a -> b
$ ((Int, [Char]) -> Bool) -> [(Int, [Char])] -> [(Int, [Char])]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) (Int -> Bool) -> ((Int, [Char]) -> Int) -> (Int, [Char]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, [Char]) -> Int
forall a b. (a, b) -> a
fst) ([(Int, [Char])] -> [(Int, [Char])])
-> [(Int, [Char])] -> [(Int, [Char])]
forall a b. (a -> b) -> a -> b
$ forall a. Read a => Int -> ReadS a
readsPrec @Int Int
prec [Char]
s

-- | This is the source catalog version, used when deciding whether to (re-)create event triggers.
newtype SourceCatalogVersion (backend :: BackendType) = SourceCatalogVersion {forall (backend :: BackendType).
SourceCatalogVersion backend -> Int
unSourceCatalogVersion :: Int}
  deriving newtype (SourceCatalogVersion backend
-> SourceCatalogVersion backend -> Bool
(SourceCatalogVersion backend
 -> SourceCatalogVersion backend -> Bool)
-> (SourceCatalogVersion backend
    -> SourceCatalogVersion backend -> Bool)
-> Eq (SourceCatalogVersion backend)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (backend :: BackendType).
SourceCatalogVersion backend
-> SourceCatalogVersion backend -> Bool
$c== :: forall (backend :: BackendType).
SourceCatalogVersion backend
-> SourceCatalogVersion backend -> Bool
== :: SourceCatalogVersion backend
-> SourceCatalogVersion backend -> Bool
$c/= :: forall (backend :: BackendType).
SourceCatalogVersion backend
-> SourceCatalogVersion backend -> Bool
/= :: SourceCatalogVersion backend
-> SourceCatalogVersion backend -> Bool
Eq, Int -> SourceCatalogVersion backend
SourceCatalogVersion backend -> Int
SourceCatalogVersion backend -> [SourceCatalogVersion backend]
SourceCatalogVersion backend -> SourceCatalogVersion backend
SourceCatalogVersion backend
-> SourceCatalogVersion backend -> [SourceCatalogVersion backend]
SourceCatalogVersion backend
-> SourceCatalogVersion backend
-> SourceCatalogVersion backend
-> [SourceCatalogVersion backend]
(SourceCatalogVersion backend -> SourceCatalogVersion backend)
-> (SourceCatalogVersion backend -> SourceCatalogVersion backend)
-> (Int -> SourceCatalogVersion backend)
-> (SourceCatalogVersion backend -> Int)
-> (SourceCatalogVersion backend -> [SourceCatalogVersion backend])
-> (SourceCatalogVersion backend
    -> SourceCatalogVersion backend -> [SourceCatalogVersion backend])
-> (SourceCatalogVersion backend
    -> SourceCatalogVersion backend -> [SourceCatalogVersion backend])
-> (SourceCatalogVersion backend
    -> SourceCatalogVersion backend
    -> SourceCatalogVersion backend
    -> [SourceCatalogVersion backend])
-> Enum (SourceCatalogVersion backend)
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
forall (backend :: BackendType).
Int -> SourceCatalogVersion backend
forall (backend :: BackendType).
SourceCatalogVersion backend -> Int
forall (backend :: BackendType).
SourceCatalogVersion backend -> [SourceCatalogVersion backend]
forall (backend :: BackendType).
SourceCatalogVersion backend -> SourceCatalogVersion backend
forall (backend :: BackendType).
SourceCatalogVersion backend
-> SourceCatalogVersion backend -> [SourceCatalogVersion backend]
forall (backend :: BackendType).
SourceCatalogVersion backend
-> SourceCatalogVersion backend
-> SourceCatalogVersion backend
-> [SourceCatalogVersion backend]
$csucc :: forall (backend :: BackendType).
SourceCatalogVersion backend -> SourceCatalogVersion backend
succ :: SourceCatalogVersion backend -> SourceCatalogVersion backend
$cpred :: forall (backend :: BackendType).
SourceCatalogVersion backend -> SourceCatalogVersion backend
pred :: SourceCatalogVersion backend -> SourceCatalogVersion backend
$ctoEnum :: forall (backend :: BackendType).
Int -> SourceCatalogVersion backend
toEnum :: Int -> SourceCatalogVersion backend
$cfromEnum :: forall (backend :: BackendType).
SourceCatalogVersion backend -> Int
fromEnum :: SourceCatalogVersion backend -> Int
$cenumFrom :: forall (backend :: BackendType).
SourceCatalogVersion backend -> [SourceCatalogVersion backend]
enumFrom :: SourceCatalogVersion backend -> [SourceCatalogVersion backend]
$cenumFromThen :: forall (backend :: BackendType).
SourceCatalogVersion backend
-> SourceCatalogVersion backend -> [SourceCatalogVersion backend]
enumFromThen :: SourceCatalogVersion backend
-> SourceCatalogVersion backend -> [SourceCatalogVersion backend]
$cenumFromTo :: forall (backend :: BackendType).
SourceCatalogVersion backend
-> SourceCatalogVersion backend -> [SourceCatalogVersion backend]
enumFromTo :: SourceCatalogVersion backend
-> SourceCatalogVersion backend -> [SourceCatalogVersion backend]
$cenumFromThenTo :: forall (backend :: BackendType).
SourceCatalogVersion backend
-> SourceCatalogVersion backend
-> SourceCatalogVersion backend
-> [SourceCatalogVersion backend]
enumFromThenTo :: SourceCatalogVersion backend
-> SourceCatalogVersion backend
-> SourceCatalogVersion backend
-> [SourceCatalogVersion backend]
Enum, Int -> SourceCatalogVersion backend -> ShowS
[SourceCatalogVersion backend] -> ShowS
SourceCatalogVersion backend -> [Char]
(Int -> SourceCatalogVersion backend -> ShowS)
-> (SourceCatalogVersion backend -> [Char])
-> ([SourceCatalogVersion backend] -> ShowS)
-> Show (SourceCatalogVersion backend)
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
forall (backend :: BackendType).
Int -> SourceCatalogVersion backend -> ShowS
forall (backend :: BackendType).
[SourceCatalogVersion backend] -> ShowS
forall (backend :: BackendType).
SourceCatalogVersion backend -> [Char]
$cshowsPrec :: forall (backend :: BackendType).
Int -> SourceCatalogVersion backend -> ShowS
showsPrec :: Int -> SourceCatalogVersion backend -> ShowS
$cshow :: forall (backend :: BackendType).
SourceCatalogVersion backend -> [Char]
show :: SourceCatalogVersion backend -> [Char]
$cshowList :: forall (backend :: BackendType).
[SourceCatalogVersion backend] -> ShowS
showList :: [SourceCatalogVersion backend] -> ShowS
Show, ReadPrec [SourceCatalogVersion backend]
ReadPrec (SourceCatalogVersion backend)
Int -> ReadS (SourceCatalogVersion backend)
ReadS [SourceCatalogVersion backend]
(Int -> ReadS (SourceCatalogVersion backend))
-> ReadS [SourceCatalogVersion backend]
-> ReadPrec (SourceCatalogVersion backend)
-> ReadPrec [SourceCatalogVersion backend]
-> Read (SourceCatalogVersion backend)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (backend :: BackendType).
ReadPrec [SourceCatalogVersion backend]
forall (backend :: BackendType).
ReadPrec (SourceCatalogVersion backend)
forall (backend :: BackendType).
Int -> ReadS (SourceCatalogVersion backend)
forall (backend :: BackendType).
ReadS [SourceCatalogVersion backend]
$creadsPrec :: forall (backend :: BackendType).
Int -> ReadS (SourceCatalogVersion backend)
readsPrec :: Int -> ReadS (SourceCatalogVersion backend)
$creadList :: forall (backend :: BackendType).
ReadS [SourceCatalogVersion backend]
readList :: ReadS [SourceCatalogVersion backend]
$creadPrec :: forall (backend :: BackendType).
ReadPrec (SourceCatalogVersion backend)
readPrec :: ReadPrec (SourceCatalogVersion backend)
$creadListPrec :: forall (backend :: BackendType).
ReadPrec [SourceCatalogVersion backend]
readListPrec :: ReadPrec [SourceCatalogVersion backend]
Read)
  deriving stock ((forall (m :: * -> *).
 Quote m =>
 SourceCatalogVersion backend -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    SourceCatalogVersion backend
    -> Code m (SourceCatalogVersion backend))
-> Lift (SourceCatalogVersion backend)
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (backend :: BackendType) (m :: * -> *).
Quote m =>
SourceCatalogVersion backend -> m Exp
forall (backend :: BackendType) (m :: * -> *).
Quote m =>
SourceCatalogVersion backend
-> Code m (SourceCatalogVersion backend)
forall (m :: * -> *).
Quote m =>
SourceCatalogVersion backend -> m Exp
forall (m :: * -> *).
Quote m =>
SourceCatalogVersion backend
-> Code m (SourceCatalogVersion backend)
$clift :: forall (backend :: BackendType) (m :: * -> *).
Quote m =>
SourceCatalogVersion backend -> m Exp
lift :: forall (m :: * -> *).
Quote m =>
SourceCatalogVersion backend -> m Exp
$cliftTyped :: forall (backend :: BackendType) (m :: * -> *).
Quote m =>
SourceCatalogVersion backend
-> Code m (SourceCatalogVersion backend)
liftTyped :: forall (m :: * -> *).
Quote m =>
SourceCatalogVersion backend
-> Code m (SourceCatalogVersion backend)
Lift)

data SourceCatalogMigrationState
  = -- | Source has not been initialized yet.
    SCMSUninitializedSource
  | -- | Source catalog is already at the latest catalog version.
    SCMSNothingToDo Int
  | -- | Initialization of the source catalog along with the catalog version.
    SCMSInitialized Int
  | -- | Source catalog migration <old catalog version> to <new catalog version>.
    SCMSMigratedTo Int Int
  | -- | Source catalog migration on hold with reason (Maintenance mode, read only mode etc).
    SCMSMigrationOnHold Text
  | SCMSNotSupported

instance ToEngineLog (SourceName, SourceCatalogMigrationState) Hasura where
  toEngineLog :: (SourceName, SourceCatalogMigrationState)
-> (LogLevel, EngineLogType Hasura, Value)
toEngineLog (SourceName
sourceName, SourceCatalogMigrationState
migrationStatus) =
    let migrationStatusMessage :: Text
migrationStatusMessage =
          case SourceCatalogMigrationState
migrationStatus of
            SourceCatalogMigrationState
SCMSUninitializedSource -> Text
"source " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SourceName
sourceName SourceName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" has not been initialized yet."
            SCMSNothingToDo Int
catalogVersion ->
              Text
"source "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SourceName
sourceName
                SourceName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" is already at the latest catalog version ("
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
catalogVersion
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")."
            SCMSInitialized Int
catalogVersion ->
              Text
"source "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SourceName
sourceName
                SourceName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" has the source catalog version successfully initialized (at version "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
catalogVersion
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")."
            SCMSMigratedTo Int
oldCatalogVersion Int
newCatalogVersion ->
              Text
"source "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SourceName
sourceName
                SourceName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" has been migrated successfully from catalog version "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
oldCatalogVersion
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
newCatalogVersion
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
            SCMSMigrationOnHold Text
reason ->
              Text
"Source catalog migration for source: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SourceName
sourceName SourceName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" is on hold due to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
reason Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
            SourceCatalogMigrationState
SCMSNotSupported ->
              Text
"Source catalog migration is not supported for source " Text -> SourceName -> Text
forall t. ToTxt t => Text -> t -> Text
<>> SourceName
sourceName
     in StartupLog -> (LogLevel, EngineLogType Hasura, Value)
forall a impl.
ToEngineLog a impl =>
a -> (LogLevel, EngineLogType impl, Value)
toEngineLog
          (StartupLog -> (LogLevel, EngineLogType Hasura, Value))
-> StartupLog -> (LogLevel, EngineLogType Hasura, Value)
forall a b. (a -> b) -> a -> b
$ StartupLog
            { slLogLevel :: LogLevel
slLogLevel = LogLevel
LevelInfo,
              slKind :: Text
slKind = Text
"source_catalog_migrate",
              slInfo :: Value
slInfo =
                Value -> Value
forall a. ToJSON a => a -> Value
J.toJSON
                  (Value -> Value) -> Value -> Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
J.object
                    [ Key
"source" Key -> SourceName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= SourceName
sourceName,
                      Key
"message" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= Text
migrationStatusMessage
                    ]
            }