{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

module Simplex.Messaging.Agent.Store.Shared
  ( Migration (..),
    MigrationsToRun (..),
    DownMigration (..),
    MTRError (..),
    mtrErrorDescription,
    MigrationConfig (..),
    MigrationConfirmation (..),
    MigrationError (..),
    UpMigration (..),
    migrationErrorDescription,
    -- for tests
    toDownMigration,
    upMigration,
  )
where

import qualified Data.Aeson.TH as J
import qualified Data.Attoparsec.ByteString.Char8 as A
import Data.List (intercalate)
import Data.Maybe (isJust)
import Data.Text (Text)
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, sumTypeJSON)

data Migration = Migration {Migration -> String
name :: String, Migration -> Text
up :: Text, Migration -> Maybe Text
down :: Maybe Text}
  deriving (Migration -> Migration -> Bool
(Migration -> Migration -> Bool)
-> (Migration -> Migration -> Bool) -> Eq Migration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Migration -> Migration -> Bool
== :: Migration -> Migration -> Bool
$c/= :: Migration -> Migration -> Bool
/= :: Migration -> Migration -> Bool
Eq, Int -> Migration -> ShowS
[Migration] -> ShowS
Migration -> String
(Int -> Migration -> ShowS)
-> (Migration -> String)
-> ([Migration] -> ShowS)
-> Show Migration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Migration -> ShowS
showsPrec :: Int -> Migration -> ShowS
$cshow :: Migration -> String
show :: Migration -> String
$cshowList :: [Migration] -> ShowS
showList :: [Migration] -> ShowS
Show)

data DownMigration = DownMigration {DownMigration -> String
downName :: String, DownMigration -> Text
downQuery :: Text}
  deriving (DownMigration -> DownMigration -> Bool
(DownMigration -> DownMigration -> Bool)
-> (DownMigration -> DownMigration -> Bool) -> Eq DownMigration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DownMigration -> DownMigration -> Bool
== :: DownMigration -> DownMigration -> Bool
$c/= :: DownMigration -> DownMigration -> Bool
/= :: DownMigration -> DownMigration -> Bool
Eq, Int -> DownMigration -> ShowS
[DownMigration] -> ShowS
DownMigration -> String
(Int -> DownMigration -> ShowS)
-> (DownMigration -> String)
-> ([DownMigration] -> ShowS)
-> Show DownMigration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DownMigration -> ShowS
showsPrec :: Int -> DownMigration -> ShowS
$cshow :: DownMigration -> String
show :: DownMigration -> String
$cshowList :: [DownMigration] -> ShowS
showList :: [DownMigration] -> ShowS
Show)

toDownMigration :: Migration -> Maybe DownMigration
toDownMigration :: Migration -> Maybe DownMigration
toDownMigration Migration {String
name :: Migration -> String
name :: String
name, Maybe Text
down :: Migration -> Maybe Text
down :: Maybe Text
down} = String -> Text -> DownMigration
DownMigration String
name (Text -> DownMigration) -> Maybe Text -> Maybe DownMigration
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
down

data MigrationsToRun = MTRUp [Migration] | MTRDown [DownMigration] | MTRNone
  deriving (MigrationsToRun -> MigrationsToRun -> Bool
(MigrationsToRun -> MigrationsToRun -> Bool)
-> (MigrationsToRun -> MigrationsToRun -> Bool)
-> Eq MigrationsToRun
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MigrationsToRun -> MigrationsToRun -> Bool
== :: MigrationsToRun -> MigrationsToRun -> Bool
$c/= :: MigrationsToRun -> MigrationsToRun -> Bool
/= :: MigrationsToRun -> MigrationsToRun -> Bool
Eq, Int -> MigrationsToRun -> ShowS
[MigrationsToRun] -> ShowS
MigrationsToRun -> String
(Int -> MigrationsToRun -> ShowS)
-> (MigrationsToRun -> String)
-> ([MigrationsToRun] -> ShowS)
-> Show MigrationsToRun
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MigrationsToRun -> ShowS
showsPrec :: Int -> MigrationsToRun -> ShowS
$cshow :: MigrationsToRun -> String
show :: MigrationsToRun -> String
$cshowList :: [MigrationsToRun] -> ShowS
showList :: [MigrationsToRun] -> ShowS
Show)

data MTRError
  = MTRENoDown {MTRError -> [String]
dbMigrations :: [String]}
  | MTREDifferent {MTRError -> String
appMigration :: String, MTRError -> String
dbMigration :: String}
  deriving (MTRError -> MTRError -> Bool
(MTRError -> MTRError -> Bool)
-> (MTRError -> MTRError -> Bool) -> Eq MTRError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MTRError -> MTRError -> Bool
== :: MTRError -> MTRError -> Bool
$c/= :: MTRError -> MTRError -> Bool
/= :: MTRError -> MTRError -> Bool
Eq, Int -> MTRError -> ShowS
[MTRError] -> ShowS
MTRError -> String
(Int -> MTRError -> ShowS)
-> (MTRError -> String) -> ([MTRError] -> ShowS) -> Show MTRError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MTRError -> ShowS
showsPrec :: Int -> MTRError -> ShowS
$cshow :: MTRError -> String
show :: MTRError -> String
$cshowList :: [MTRError] -> ShowS
showList :: [MTRError] -> ShowS
Show)

mtrErrorDescription :: MTRError -> String
mtrErrorDescription :: MTRError -> String
mtrErrorDescription = \case
  MTRENoDown [String]
ms -> String
"database version is newer than the app, but no down migration for: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
ms
  MTREDifferent String
a String
d -> String
"different migration in the app/database: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
a String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" / " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
d

data MigrationError
  = MEUpgrade {MigrationError -> [UpMigration]
upMigrations :: [UpMigration]}
  | MEDowngrade {MigrationError -> [String]
downMigrations :: [String]}
  | MigrationError {MigrationError -> MTRError
mtrError :: MTRError}
  deriving (MigrationError -> MigrationError -> Bool
(MigrationError -> MigrationError -> Bool)
-> (MigrationError -> MigrationError -> Bool) -> Eq MigrationError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MigrationError -> MigrationError -> Bool
== :: MigrationError -> MigrationError -> Bool
$c/= :: MigrationError -> MigrationError -> Bool
/= :: MigrationError -> MigrationError -> Bool
Eq, Int -> MigrationError -> ShowS
[MigrationError] -> ShowS
MigrationError -> String
(Int -> MigrationError -> ShowS)
-> (MigrationError -> String)
-> ([MigrationError] -> ShowS)
-> Show MigrationError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MigrationError -> ShowS
showsPrec :: Int -> MigrationError -> ShowS
$cshow :: MigrationError -> String
show :: MigrationError -> String
$cshowList :: [MigrationError] -> ShowS
showList :: [MigrationError] -> ShowS
Show)

migrationErrorDescription :: Bool -> MigrationError -> String
migrationErrorDescription :: Bool -> MigrationError -> String
migrationErrorDescription Bool
withBackup = \case
  MEUpgrade [UpMigration]
ums ->
    String
"The app has a newer version than the database.\nConfirm to " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
backupStr String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"upgrade using these migrations: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((UpMigration -> String) -> [UpMigration] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map UpMigration -> String
upName [UpMigration]
ums)
  MEDowngrade [String]
dms ->
    String
"Database version is newer than the app.\nConfirm to " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
backupStr String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"downgrade using these migrations: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
dms
  MigrationError MTRError
err -> MTRError -> String
mtrErrorDescription MTRError
err
  where
    backupStr :: String
backupStr = if Bool
withBackup then String
"back up and " else String
""

data UpMigration = UpMigration {UpMigration -> String
upName :: String, UpMigration -> Bool
withDown :: Bool}
  deriving (UpMigration -> UpMigration -> Bool
(UpMigration -> UpMigration -> Bool)
-> (UpMigration -> UpMigration -> Bool) -> Eq UpMigration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UpMigration -> UpMigration -> Bool
== :: UpMigration -> UpMigration -> Bool
$c/= :: UpMigration -> UpMigration -> Bool
/= :: UpMigration -> UpMigration -> Bool
Eq, Int -> UpMigration -> ShowS
[UpMigration] -> ShowS
UpMigration -> String
(Int -> UpMigration -> ShowS)
-> (UpMigration -> String)
-> ([UpMigration] -> ShowS)
-> Show UpMigration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UpMigration -> ShowS
showsPrec :: Int -> UpMigration -> ShowS
$cshow :: UpMigration -> String
show :: UpMigration -> String
$cshowList :: [UpMigration] -> ShowS
showList :: [UpMigration] -> ShowS
Show)

upMigration :: Migration -> UpMigration
upMigration :: Migration -> UpMigration
upMigration Migration {String
name :: Migration -> String
name :: String
name, Maybe Text
down :: Migration -> Maybe Text
down :: Maybe Text
down} = String -> Bool -> UpMigration
UpMigration String
name (Bool -> UpMigration) -> Bool -> UpMigration
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Maybe Text
down

data MigrationConfig = MigrationConfig
  { MigrationConfig -> MigrationConfirmation
confirm :: MigrationConfirmation,
    MigrationConfig -> Maybe String
backupPath :: Maybe FilePath -- Nothing - no backup, empty string - the same folder
  }

data MigrationConfirmation = MCYesUp | MCYesUpDown | MCConsole | MCError
  deriving (MigrationConfirmation -> MigrationConfirmation -> Bool
(MigrationConfirmation -> MigrationConfirmation -> Bool)
-> (MigrationConfirmation -> MigrationConfirmation -> Bool)
-> Eq MigrationConfirmation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MigrationConfirmation -> MigrationConfirmation -> Bool
== :: MigrationConfirmation -> MigrationConfirmation -> Bool
$c/= :: MigrationConfirmation -> MigrationConfirmation -> Bool
/= :: MigrationConfirmation -> MigrationConfirmation -> Bool
Eq, Int -> MigrationConfirmation -> ShowS
[MigrationConfirmation] -> ShowS
MigrationConfirmation -> String
(Int -> MigrationConfirmation -> ShowS)
-> (MigrationConfirmation -> String)
-> ([MigrationConfirmation] -> ShowS)
-> Show MigrationConfirmation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MigrationConfirmation -> ShowS
showsPrec :: Int -> MigrationConfirmation -> ShowS
$cshow :: MigrationConfirmation -> String
show :: MigrationConfirmation -> String
$cshowList :: [MigrationConfirmation] -> ShowS
showList :: [MigrationConfirmation] -> ShowS
Show)

instance StrEncoding MigrationConfirmation where
  strEncode :: MigrationConfirmation -> ByteString
strEncode = \case
    MigrationConfirmation
MCYesUp -> ByteString
"yesUp"
    MigrationConfirmation
MCYesUpDown -> ByteString
"yesUpDown"
    MigrationConfirmation
MCConsole -> ByteString
"console"
    MigrationConfirmation
MCError -> ByteString
"error"
  strP :: Parser MigrationConfirmation
strP =
    Parser ByteString
A.takeByteString Parser ByteString
-> (ByteString -> Parser MigrationConfirmation)
-> Parser MigrationConfirmation
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      ByteString
"yesUp" -> MigrationConfirmation -> Parser MigrationConfirmation
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MigrationConfirmation
MCYesUp
      ByteString
"yesUpDown" -> MigrationConfirmation -> Parser MigrationConfirmation
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MigrationConfirmation
MCYesUpDown
      ByteString
"console" -> MigrationConfirmation -> Parser MigrationConfirmation
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MigrationConfirmation
MCConsole
      ByteString
"error" -> MigrationConfirmation -> Parser MigrationConfirmation
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MigrationConfirmation
MCError
      ByteString
_ -> String -> Parser MigrationConfirmation
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid MigrationConfirmation"

$(J.deriveJSON (sumTypeJSON $ dropPrefix "MTRE") ''MTRError)

$(J.deriveJSON defaultJSON ''UpMigration)

$(J.deriveToJSON (sumTypeJSON $ dropPrefix "ME") ''MigrationError)