{-# LANGUAGE Strict #-}

{-|
Module      : Database.PostgreSQL.Replicant.Message
Description : Streaming replication message types
Copyright   : (c) James King, 2020, 2021
License     : BSD3
Maintainer  : james@agentultra.com
Stability   : experimental
Portability : POSIX

This module contains the binary protocols messages used in the
streaming replication protocol as well as the messages used in the
body of the logical stream messages.
-}
module Database.PostgreSQL.Replicant.Message where

import Control.Monad
import Data.Aeson
import Data.ByteString (ByteString)
import Data.Scientific (Scientific)
import Data.Serialize
import Data.Text (Text)
import GHC.Generics
import GHC.Int

import Database.PostgreSQL.Replicant.Serialize
import Database.PostgreSQL.Replicant.Types.Lsn

-- WAL Replication Stream messages

-- | Indicates whether the server or the client should respond to the
-- message.
data ResponseExpectation
  = ShouldRespond
  | DoNotRespond
  deriving (ResponseExpectation -> ResponseExpectation -> Bool
(ResponseExpectation -> ResponseExpectation -> Bool)
-> (ResponseExpectation -> ResponseExpectation -> Bool)
-> Eq ResponseExpectation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResponseExpectation -> ResponseExpectation -> Bool
$c/= :: ResponseExpectation -> ResponseExpectation -> Bool
== :: ResponseExpectation -> ResponseExpectation -> Bool
$c== :: ResponseExpectation -> ResponseExpectation -> Bool
Eq, (forall x. ResponseExpectation -> Rep ResponseExpectation x)
-> (forall x. Rep ResponseExpectation x -> ResponseExpectation)
-> Generic ResponseExpectation
forall x. Rep ResponseExpectation x -> ResponseExpectation
forall x. ResponseExpectation -> Rep ResponseExpectation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ResponseExpectation x -> ResponseExpectation
$cfrom :: forall x. ResponseExpectation -> Rep ResponseExpectation x
Generic, Int -> ResponseExpectation -> ShowS
[ResponseExpectation] -> ShowS
ResponseExpectation -> String
(Int -> ResponseExpectation -> ShowS)
-> (ResponseExpectation -> String)
-> ([ResponseExpectation] -> ShowS)
-> Show ResponseExpectation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResponseExpectation] -> ShowS
$cshowList :: [ResponseExpectation] -> ShowS
show :: ResponseExpectation -> String
$cshow :: ResponseExpectation -> String
showsPrec :: Int -> ResponseExpectation -> ShowS
$cshowsPrec :: Int -> ResponseExpectation -> ShowS
Show)

instance Serialize ResponseExpectation where
  put :: Putter ResponseExpectation
put ResponseExpectation
ShouldRespond = Putter Word8
putWord8 Word8
1
  put ResponseExpectation
DoNotRespond  = Putter Word8
putWord8 Word8
0

  get :: Get ResponseExpectation
get = do
    Word8
responseFlag <- Get Word8
getWord8
    case Word8
responseFlag of
      Word8
0 -> ResponseExpectation -> Get ResponseExpectation
forall (f :: * -> *) a. Applicative f => a -> f a
pure ResponseExpectation
DoNotRespond
      Word8
1 -> ResponseExpectation -> Get ResponseExpectation
forall (f :: * -> *) a. Applicative f => a -> f a
pure ResponseExpectation
ShouldRespond
      Word8
_ -> String -> Get ResponseExpectation
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unrecognized response expectation flag"

-- | The Postgres WAL sender thread may periodically send these
-- messages.  When the server expects the client to respond it updates
-- its internal state of the client based on the response.  Failure to
-- respond results in the dreaded "WAL timeout" error.
--
-- See StandbyStatusUpdate for the message the client should respond
-- with.
data PrimaryKeepAlive
  = PrimaryKeepAlive
  { PrimaryKeepAlive -> Int64
primaryKeepAliveWalEnd              :: !Int64
  , PrimaryKeepAlive -> Int64
primaryKeepAliveSendTime            :: !Int64
  , PrimaryKeepAlive -> ResponseExpectation
primaryKeepAliveResponseExpectation :: !ResponseExpectation
  }
  deriving (PrimaryKeepAlive -> PrimaryKeepAlive -> Bool
(PrimaryKeepAlive -> PrimaryKeepAlive -> Bool)
-> (PrimaryKeepAlive -> PrimaryKeepAlive -> Bool)
-> Eq PrimaryKeepAlive
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrimaryKeepAlive -> PrimaryKeepAlive -> Bool
$c/= :: PrimaryKeepAlive -> PrimaryKeepAlive -> Bool
== :: PrimaryKeepAlive -> PrimaryKeepAlive -> Bool
$c== :: PrimaryKeepAlive -> PrimaryKeepAlive -> Bool
Eq, (forall x. PrimaryKeepAlive -> Rep PrimaryKeepAlive x)
-> (forall x. Rep PrimaryKeepAlive x -> PrimaryKeepAlive)
-> Generic PrimaryKeepAlive
forall x. Rep PrimaryKeepAlive x -> PrimaryKeepAlive
forall x. PrimaryKeepAlive -> Rep PrimaryKeepAlive x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PrimaryKeepAlive x -> PrimaryKeepAlive
$cfrom :: forall x. PrimaryKeepAlive -> Rep PrimaryKeepAlive x
Generic, Int -> PrimaryKeepAlive -> ShowS
[PrimaryKeepAlive] -> ShowS
PrimaryKeepAlive -> String
(Int -> PrimaryKeepAlive -> ShowS)
-> (PrimaryKeepAlive -> String)
-> ([PrimaryKeepAlive] -> ShowS)
-> Show PrimaryKeepAlive
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrimaryKeepAlive] -> ShowS
$cshowList :: [PrimaryKeepAlive] -> ShowS
show :: PrimaryKeepAlive -> String
$cshow :: PrimaryKeepAlive -> String
showsPrec :: Int -> PrimaryKeepAlive -> ShowS
$cshowsPrec :: Int -> PrimaryKeepAlive -> ShowS
Show)

instance Serialize PrimaryKeepAlive where
  put :: Putter PrimaryKeepAlive
put (PrimaryKeepAlive Int64
walEnd Int64
sendTime ResponseExpectation
responseExpectation) = do
    Putter Word8
putWord8 Word8
0x6B -- 'k'
    Putter Int64
putInt64be Int64
walEnd
    Putter Int64
putInt64be Int64
sendTime
    Putter ResponseExpectation
forall t. Serialize t => Putter t
put ResponseExpectation
responseExpectation

  get :: Get PrimaryKeepAlive
get = do
    ByteString
_ <- Int -> Get ByteString
getBytes Int
1
    Int64
walEnd <- Get Int64
getInt64be
    Int64
sendTime <- Get Int64
getInt64be
    ResponseExpectation
responseExpectation <- Get ResponseExpectation
forall t. Serialize t => Get t
get
    PrimaryKeepAlive -> Get PrimaryKeepAlive
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrimaryKeepAlive -> Get PrimaryKeepAlive)
-> PrimaryKeepAlive -> Get PrimaryKeepAlive
forall a b. (a -> b) -> a -> b
$ Int64 -> Int64 -> ResponseExpectation -> PrimaryKeepAlive
PrimaryKeepAlive Int64
walEnd Int64
sendTime ResponseExpectation
responseExpectation

-- | Sent by the client.  Can be sent periodically or in response to a
-- PrimaryKeepAlive message from the server.  Gives the server
-- information about the client stream state.
data StandbyStatusUpdate
  = StandbyStatusUpdate
  { StandbyStatusUpdate -> LSN
standbyStatuUpdateLastWalByteReceived  :: !LSN
  , StandbyStatusUpdate -> LSN
standbyStatusUpdateLastWalByteFlushed  :: !LSN
  , StandbyStatusUpdate -> LSN
standbyStatusUpdateLastWalByteApplied  :: !LSN
  , StandbyStatusUpdate -> Int64
standbyStatusUpdateSendTime            :: !Int64
  , StandbyStatusUpdate -> ResponseExpectation
standbyStatusUpdateResponseExpectation :: !ResponseExpectation
  }
  deriving (StandbyStatusUpdate -> StandbyStatusUpdate -> Bool
(StandbyStatusUpdate -> StandbyStatusUpdate -> Bool)
-> (StandbyStatusUpdate -> StandbyStatusUpdate -> Bool)
-> Eq StandbyStatusUpdate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StandbyStatusUpdate -> StandbyStatusUpdate -> Bool
$c/= :: StandbyStatusUpdate -> StandbyStatusUpdate -> Bool
== :: StandbyStatusUpdate -> StandbyStatusUpdate -> Bool
$c== :: StandbyStatusUpdate -> StandbyStatusUpdate -> Bool
Eq, (forall x. StandbyStatusUpdate -> Rep StandbyStatusUpdate x)
-> (forall x. Rep StandbyStatusUpdate x -> StandbyStatusUpdate)
-> Generic StandbyStatusUpdate
forall x. Rep StandbyStatusUpdate x -> StandbyStatusUpdate
forall x. StandbyStatusUpdate -> Rep StandbyStatusUpdate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StandbyStatusUpdate x -> StandbyStatusUpdate
$cfrom :: forall x. StandbyStatusUpdate -> Rep StandbyStatusUpdate x
Generic, Int -> StandbyStatusUpdate -> ShowS
[StandbyStatusUpdate] -> ShowS
StandbyStatusUpdate -> String
(Int -> StandbyStatusUpdate -> ShowS)
-> (StandbyStatusUpdate -> String)
-> ([StandbyStatusUpdate] -> ShowS)
-> Show StandbyStatusUpdate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StandbyStatusUpdate] -> ShowS
$cshowList :: [StandbyStatusUpdate] -> ShowS
show :: StandbyStatusUpdate -> String
$cshow :: StandbyStatusUpdate -> String
showsPrec :: Int -> StandbyStatusUpdate -> ShowS
$cshowsPrec :: Int -> StandbyStatusUpdate -> ShowS
Show)

instance Serialize StandbyStatusUpdate where
  put :: Putter StandbyStatusUpdate
put (StandbyStatusUpdate
       LSN
walReceived
       LSN
walFlushed
       LSN
walApplied
       Int64
sendTime
       ResponseExpectation
responseExpectation) = do
    Putter Word8
putWord8 Word8
0x72 -- 'r'
    Putter LSN
forall t. Serialize t => Putter t
put LSN
walReceived
    Putter LSN
forall t. Serialize t => Putter t
put LSN
walFlushed
    Putter LSN
forall t. Serialize t => Putter t
put LSN
walApplied
    Putter Int64
putInt64be Int64
sendTime
    Putter ResponseExpectation
forall t. Serialize t => Putter t
put ResponseExpectation
responseExpectation

  get :: Get StandbyStatusUpdate
get = do
    ByteString
_ <- Int -> Get ByteString
getBytes Int
1 -- should expect 0x72, 'r'
    LSN
walReceived         <- Get LSN
forall t. Serialize t => Get t
get
    LSN
walFlushed          <- Get LSN
forall t. Serialize t => Get t
get
    LSN
walApplied          <- Get LSN
forall t. Serialize t => Get t
get
    Int64
sendTime            <- Get Int64
getInt64be
    ResponseExpectation
responseExpectation <- Get ResponseExpectation
forall t. Serialize t => Get t
get
    StandbyStatusUpdate -> Get StandbyStatusUpdate
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StandbyStatusUpdate -> Get StandbyStatusUpdate)
-> StandbyStatusUpdate -> Get StandbyStatusUpdate
forall a b. (a -> b) -> a -> b
$
      LSN
-> LSN
-> LSN
-> Int64
-> ResponseExpectation
-> StandbyStatusUpdate
StandbyStatusUpdate
      LSN
walReceived
      LSN
walFlushed
      LSN
walApplied
      Int64
sendTime
      ResponseExpectation
responseExpectation

-- | Carries WAL segments in the streaming protocol.
data XLogData
  = XLogData
  { XLogData -> LSN
xLogDataWalStart :: !LSN
  , XLogData -> LSN
xLogDataWalEnd   :: !LSN
  , XLogData -> Int64
xLogDataSendTime :: !Int64
  , XLogData -> ByteString
xLogDataWalData  :: !ByteString
  }
  deriving (XLogData -> XLogData -> Bool
(XLogData -> XLogData -> Bool)
-> (XLogData -> XLogData -> Bool) -> Eq XLogData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XLogData -> XLogData -> Bool
$c/= :: XLogData -> XLogData -> Bool
== :: XLogData -> XLogData -> Bool
$c== :: XLogData -> XLogData -> Bool
Eq, (forall x. XLogData -> Rep XLogData x)
-> (forall x. Rep XLogData x -> XLogData) -> Generic XLogData
forall x. Rep XLogData x -> XLogData
forall x. XLogData -> Rep XLogData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep XLogData x -> XLogData
$cfrom :: forall x. XLogData -> Rep XLogData x
Generic, Int -> XLogData -> ShowS
[XLogData] -> ShowS
XLogData -> String
(Int -> XLogData -> ShowS)
-> (XLogData -> String) -> ([XLogData] -> ShowS) -> Show XLogData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XLogData] -> ShowS
$cshowList :: [XLogData] -> ShowS
show :: XLogData -> String
$cshow :: XLogData -> String
showsPrec :: Int -> XLogData -> ShowS
$cshowsPrec :: Int -> XLogData -> ShowS
Show)

instance Serialize XLogData where
  put :: Putter XLogData
put (XLogData LSN
walStart LSN
walEnd Int64
sendTime ByteString
walData) = do
    Putter Word8
putWord8 Word8
0x77 -- 'w'
    Putter LSN
forall t. Serialize t => Putter t
put LSN
walStart
    Putter LSN
forall t. Serialize t => Putter t
put LSN
walEnd
    Putter Int64
putInt64be Int64
sendTime
    Putter ByteString
putByteString ByteString
walData

  get :: Get XLogData
get = do
    ByteString
_ <- Int -> Get ByteString
getBytes Int
1 -- should expec '0x77', 'w'
    LSN
walStart <- Get LSN
forall t. Serialize t => Get t
get
    LSN
walEnd   <- Get LSN
forall t. Serialize t => Get t
get
    Int64
sendTime <- Get Int64
getInt64be
    ByteString
walData  <- Get ByteString
consumeByteStringToEnd
    XLogData -> Get XLogData
forall (f :: * -> *) a. Applicative f => a -> f a
pure (XLogData -> Get XLogData) -> XLogData -> Get XLogData
forall a b. (a -> b) -> a -> b
$ LSN -> LSN -> Int64 -> ByteString -> XLogData
XLogData LSN
walStart LSN
walEnd Int64
sendTime ByteString
walData

-- | Not used yet but enables streaming in hot-standby mode.
data HotStandbyFeedback
  = HotStandbyFeedback
  { HotStandbyFeedback -> Int64
hotStandbyFeedbackClientSendTime :: !Int64
  , HotStandbyFeedback -> Int32
hotStandbyFeedbackCurrentXmin    :: !Int32
  , HotStandbyFeedback -> Int32
hotStandbyFeedbackCurrentEpoch   :: !Int32
  }
  deriving (HotStandbyFeedback -> HotStandbyFeedback -> Bool
(HotStandbyFeedback -> HotStandbyFeedback -> Bool)
-> (HotStandbyFeedback -> HotStandbyFeedback -> Bool)
-> Eq HotStandbyFeedback
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HotStandbyFeedback -> HotStandbyFeedback -> Bool
$c/= :: HotStandbyFeedback -> HotStandbyFeedback -> Bool
== :: HotStandbyFeedback -> HotStandbyFeedback -> Bool
$c== :: HotStandbyFeedback -> HotStandbyFeedback -> Bool
Eq, (forall x. HotStandbyFeedback -> Rep HotStandbyFeedback x)
-> (forall x. Rep HotStandbyFeedback x -> HotStandbyFeedback)
-> Generic HotStandbyFeedback
forall x. Rep HotStandbyFeedback x -> HotStandbyFeedback
forall x. HotStandbyFeedback -> Rep HotStandbyFeedback x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HotStandbyFeedback x -> HotStandbyFeedback
$cfrom :: forall x. HotStandbyFeedback -> Rep HotStandbyFeedback x
Generic, Int -> HotStandbyFeedback -> ShowS
[HotStandbyFeedback] -> ShowS
HotStandbyFeedback -> String
(Int -> HotStandbyFeedback -> ShowS)
-> (HotStandbyFeedback -> String)
-> ([HotStandbyFeedback] -> ShowS)
-> Show HotStandbyFeedback
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HotStandbyFeedback] -> ShowS
$cshowList :: [HotStandbyFeedback] -> ShowS
show :: HotStandbyFeedback -> String
$cshow :: HotStandbyFeedback -> String
showsPrec :: Int -> HotStandbyFeedback -> ShowS
$cshowsPrec :: Int -> HotStandbyFeedback -> ShowS
Show)

instance Serialize HotStandbyFeedback where
  put :: Putter HotStandbyFeedback
put (HotStandbyFeedback Int64
clientSendTime Int32
currentXMin Int32
currentEpoch) = do
    Putter Word8
putWord8 Word8
0x68
    Putter Int64
putInt64be Int64
clientSendTime
    Putter Int32
putInt32be Int32
currentXMin
    Putter Int32
putInt32be Int32
currentEpoch

  get :: Get HotStandbyFeedback
get = do
    ByteString
_ <- Int -> Get ByteString
getBytes Int
1 -- should expect '0x68' 'h'
    Int64
clientSendTime <- Get Int64
getInt64be
    Int32
currentXmin <- Get Int32
getInt32be
    Int32
currentEpoch <- Get Int32
getInt32be
    HotStandbyFeedback -> Get HotStandbyFeedback
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HotStandbyFeedback -> Get HotStandbyFeedback)
-> HotStandbyFeedback -> Get HotStandbyFeedback
forall a b. (a -> b) -> a -> b
$ Int64 -> Int32 -> Int32 -> HotStandbyFeedback
HotStandbyFeedback Int64
clientSendTime Int32
currentXmin Int32
currentEpoch

-- | This structure wraps the two messages sent by the server so that
-- we get a Serialize instance for both.
data WalCopyData
  = XLogDataM !XLogData
  | KeepAliveM !PrimaryKeepAlive
  deriving (WalCopyData -> WalCopyData -> Bool
(WalCopyData -> WalCopyData -> Bool)
-> (WalCopyData -> WalCopyData -> Bool) -> Eq WalCopyData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WalCopyData -> WalCopyData -> Bool
$c/= :: WalCopyData -> WalCopyData -> Bool
== :: WalCopyData -> WalCopyData -> Bool
$c== :: WalCopyData -> WalCopyData -> Bool
Eq, (forall x. WalCopyData -> Rep WalCopyData x)
-> (forall x. Rep WalCopyData x -> WalCopyData)
-> Generic WalCopyData
forall x. Rep WalCopyData x -> WalCopyData
forall x. WalCopyData -> Rep WalCopyData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WalCopyData x -> WalCopyData
$cfrom :: forall x. WalCopyData -> Rep WalCopyData x
Generic, Int -> WalCopyData -> ShowS
[WalCopyData] -> ShowS
WalCopyData -> String
(Int -> WalCopyData -> ShowS)
-> (WalCopyData -> String)
-> ([WalCopyData] -> ShowS)
-> Show WalCopyData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WalCopyData] -> ShowS
$cshowList :: [WalCopyData] -> ShowS
show :: WalCopyData -> String
$cshow :: WalCopyData -> String
showsPrec :: Int -> WalCopyData -> ShowS
$cshowsPrec :: Int -> WalCopyData -> ShowS
Show)

instance Serialize WalCopyData where
  put :: Putter WalCopyData
put (XLogDataM XLogData
xLogData)   = Putter XLogData
forall t. Serialize t => Putter t
put XLogData
xLogData
  put (KeepAliveM PrimaryKeepAlive
keepAlive) = Putter PrimaryKeepAlive
forall t. Serialize t => Putter t
put PrimaryKeepAlive
keepAlive
  get :: Get WalCopyData
get = do
    Word8
messageTypeFlag <- Get Word8 -> Get Word8
forall a. Get a -> Get a
lookAhead (Get Word8 -> Get Word8) -> Get Word8 -> Get Word8
forall a b. (a -> b) -> a -> b
$ Get Word8
getWord8
    case Word8
messageTypeFlag of
      -- 'w' XLogData
      Word8
0x77 -> do
        XLogData
xLogData <- Get XLogData
forall t. Serialize t => Get t
get
        WalCopyData -> Get WalCopyData
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WalCopyData -> Get WalCopyData) -> WalCopyData -> Get WalCopyData
forall a b. (a -> b) -> a -> b
$ XLogData -> WalCopyData
XLogDataM XLogData
xLogData
      -- 'k' PrimaryKeepAlive
      Word8
0x6B -> do
        PrimaryKeepAlive
keepAlive <- Get PrimaryKeepAlive
forall t. Serialize t => Get t
get
        WalCopyData -> Get WalCopyData
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WalCopyData -> Get WalCopyData) -> WalCopyData -> Get WalCopyData
forall a b. (a -> b) -> a -> b
$ PrimaryKeepAlive -> WalCopyData
KeepAliveM PrimaryKeepAlive
keepAlive
      Word8
_    -> String -> Get WalCopyData
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unrecognized WalCopyData"

-- WAL Log Data

-- | Wraps Postgres values.  Since this library currently supports
-- only the @wal2json@ logical decoder plugin we have the JSON values
-- much like Aeson does.
data WalValue
  = WalString !Text
  | WalNumber !Scientific
  | WalBool !Bool
  | WalNull
  deriving (WalValue -> WalValue -> Bool
(WalValue -> WalValue -> Bool)
-> (WalValue -> WalValue -> Bool) -> Eq WalValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WalValue -> WalValue -> Bool
$c/= :: WalValue -> WalValue -> Bool
== :: WalValue -> WalValue -> Bool
$c== :: WalValue -> WalValue -> Bool
Eq, (forall x. WalValue -> Rep WalValue x)
-> (forall x. Rep WalValue x -> WalValue) -> Generic WalValue
forall x. Rep WalValue x -> WalValue
forall x. WalValue -> Rep WalValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WalValue x -> WalValue
$cfrom :: forall x. WalValue -> Rep WalValue x
Generic, Int -> WalValue -> ShowS
[WalValue] -> ShowS
WalValue -> String
(Int -> WalValue -> ShowS)
-> (WalValue -> String) -> ([WalValue] -> ShowS) -> Show WalValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WalValue] -> ShowS
$cshowList :: [WalValue] -> ShowS
show :: WalValue -> String
$cshow :: WalValue -> String
showsPrec :: Int -> WalValue -> ShowS
$cshowsPrec :: Int -> WalValue -> ShowS
Show)

instance FromJSON WalValue where
  parseJSON :: Value -> Parser WalValue
parseJSON (String Text
txt) = WalValue -> Parser WalValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WalValue -> Parser WalValue) -> WalValue -> Parser WalValue
forall a b. (a -> b) -> a -> b
$ Text -> WalValue
WalString Text
txt
  parseJSON (Number Scientific
num) = WalValue -> Parser WalValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WalValue -> Parser WalValue) -> WalValue -> Parser WalValue
forall a b. (a -> b) -> a -> b
$ Scientific -> WalValue
WalNumber Scientific
num
  parseJSON (Bool Bool
bool)  = WalValue -> Parser WalValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WalValue -> Parser WalValue) -> WalValue -> Parser WalValue
forall a b. (a -> b) -> a -> b
$ Bool -> WalValue
WalBool Bool
bool
  parseJSON Value
Null         = WalValue -> Parser WalValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure WalValue
WalNull
  parseJSON Value
_            = String -> Parser WalValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unrecognized WalValue"

instance ToJSON WalValue where
  toJSON :: WalValue -> Value
toJSON (WalString Text
txt) = Text -> Value
String Text
txt
  toJSON (WalNumber Scientific
n)   = Scientific -> Value
Number Scientific
n
  toJSON (WalBool Bool
b)     = Bool -> Value
Bool Bool
b
  toJSON (WalValue
WalNull)       = Value
Null

-- | Represents a single table column.  We only support the `wal2json`
-- logical decoder plugin and make no attempt to parse anything but
-- JSON-like primitives.
data Column
  = Column
  { Column -> Text
columnName  :: !Text
  , Column -> Text
columnType  :: !Text
  , Column -> WalValue
columnValue :: !WalValue
  }
  deriving (Column -> Column -> Bool
(Column -> Column -> Bool)
-> (Column -> Column -> Bool) -> Eq Column
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Column -> Column -> Bool
$c/= :: Column -> Column -> Bool
== :: Column -> Column -> Bool
$c== :: Column -> Column -> Bool
Eq, Int -> Column -> ShowS
[Column] -> ShowS
Column -> String
(Int -> Column -> ShowS)
-> (Column -> String) -> ([Column] -> ShowS) -> Show Column
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Column] -> ShowS
$cshowList :: [Column] -> ShowS
show :: Column -> String
$cshow :: Column -> String
showsPrec :: Int -> Column -> ShowS
$cshowsPrec :: Int -> Column -> ShowS
Show)

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

-- | Some WAL output plugins encode column values in three, equal
-- length, heterogeneous lists.
columns :: [Text] -> [Text] -> [WalValue] -> Either ColumnParseError [Column]
columns :: [Text] -> [Text] -> [WalValue] -> Either ColumnParseError [Column]
columns [Text]
colNames [Text]
colTypes [WalValue]
colValues
  | [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
colNames Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
colTypes Bool -> Bool -> Bool
&& [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
colTypes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [WalValue] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [WalValue]
colValues
  = [Column] -> Either ColumnParseError [Column]
forall a b. b -> Either a b
Right (((Text, Text, WalValue) -> Column)
-> [(Text, Text, WalValue)] -> [Column]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text, WalValue) -> Column
toColumn ([(Text, Text, WalValue)] -> [Column])
-> [(Text, Text, WalValue)] -> [Column]
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text] -> [WalValue] -> [(Text, Text, WalValue)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Text]
colNames [Text]
colTypes [WalValue]
colValues)
  | Bool
otherwise = ColumnParseError -> Either ColumnParseError [Column]
forall a b. a -> Either a b
Left ColumnParseError
ColumnLengthMatchError
  where
    toColumn :: (Text, Text, WalValue) -> Column
toColumn (Text
n, Text
t, WalValue
v) = Text -> Text -> WalValue -> Column
Column Text
n Text
t WalValue
v

fromColumn :: Column -> (Text, Text, WalValue)
fromColumn :: Column -> (Text, Text, WalValue)
fromColumn (Column Text
cName Text
cType WalValue
cValue) = (Text
cName, Text
cType, WalValue
cValue)

fromColumns :: [Column] -> ([Text], [Text], [WalValue])
fromColumns :: [Column] -> ([Text], [Text], [WalValue])
fromColumns = [(Text, Text, WalValue)] -> ([Text], [Text], [WalValue])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 ([(Text, Text, WalValue)] -> ([Text], [Text], [WalValue]))
-> ([Column] -> [(Text, Text, WalValue)])
-> [Column]
-> ([Text], [Text], [WalValue])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Column -> (Text, Text, WalValue))
-> [Column] -> [(Text, Text, WalValue)]
forall a b. (a -> b) -> [a] -> [b]
map Column -> (Text, Text, WalValue)
fromColumn

-- | Represents a single insert query in the logical replication
-- format.
data Insert
  = Insert
  { Insert -> String
insertSchema  :: !String
  , Insert -> String
insertTable   :: !String
  , Insert -> [Column]
insertColumns :: ![Column]
  }
  deriving (Insert -> Insert -> Bool
(Insert -> Insert -> Bool)
-> (Insert -> Insert -> Bool) -> Eq Insert
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Insert -> Insert -> Bool
$c/= :: Insert -> Insert -> Bool
== :: Insert -> Insert -> Bool
$c== :: Insert -> Insert -> Bool
Eq, Int -> Insert -> ShowS
[Insert] -> ShowS
Insert -> String
(Int -> Insert -> ShowS)
-> (Insert -> String) -> ([Insert] -> ShowS) -> Show Insert
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Insert] -> ShowS
$cshowList :: [Insert] -> ShowS
show :: Insert -> String
$cshow :: Insert -> String
showsPrec :: Int -> Insert -> ShowS
$cshowsPrec :: Int -> Insert -> ShowS
Show)

instance FromJSON Insert where
  parseJSON :: Value -> Parser Insert
parseJSON = String -> (Object -> Parser Insert) -> Value -> Parser Insert
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Insert" ((Object -> Parser Insert) -> Value -> Parser Insert)
-> (Object -> Parser Insert) -> Value -> Parser Insert
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Value
kind         <- Object
o Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"kind"
    Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Value
kind Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Value
String Text
"insert") (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid insert"
    String
schema       <- Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"schema"
    String
table        <- Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"table"
    [Text]
columnNames  <- Object
o Object -> Key -> Parser [Text]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"columnnames"
    [Text]
columnTypes  <- Object
o Object -> Key -> Parser [Text]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"columntypes"
    [WalValue]
columnValues <- Object
o Object -> Key -> Parser [WalValue]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"columnvalues"
    case [Text] -> [Text] -> [WalValue] -> Either ColumnParseError [Column]
columns [Text]
columnNames [Text]
columnTypes [WalValue]
columnValues of
      Left ColumnParseError
err      -> String -> Parser Insert
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Insert) -> String -> Parser Insert
forall a b. (a -> b) -> a -> b
$ ColumnParseError -> String
forall a. Show a => a -> String
show ColumnParseError
err
      Right [Column]
columns -> Insert -> Parser Insert
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Insert -> Parser Insert) -> Insert -> Parser Insert
forall a b. (a -> b) -> a -> b
$ String -> String -> [Column] -> Insert
Insert String
schema String
table [Column]
columns

instance ToJSON Insert where
  toJSON :: Insert -> Value
toJSON (Insert String
schema String
table [Column]
columns) =
    let ([Text]
cNames, [Text]
cTypes, [WalValue]
cValues) = [Column] -> ([Text], [Text], [WalValue])
fromColumns [Column]
columns
    in [Pair] -> Value
object [ Key
"kind"         Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"insert"
              , Key
"schema"       Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
schema
              , Key
"table"        Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
table
              , Key
"columnnames"  Key -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text]
cNames
              , Key
"columntypes"  Key -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text]
cTypes
              , Key
"columnvalues" Key -> [WalValue] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [WalValue]
cValues
              ]

-- | Represents a single update query in the logical replication
-- format.
data Update
  = Update
  { Update -> Text
updateSchema  :: !Text
  , Update -> Text
updateTable   :: !Text
  , Update -> [Column]
updateColumns :: ![Column]
  }
  deriving (Update -> Update -> Bool
(Update -> Update -> Bool)
-> (Update -> Update -> Bool) -> Eq Update
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Update -> Update -> Bool
$c/= :: Update -> Update -> Bool
== :: Update -> Update -> Bool
$c== :: Update -> Update -> Bool
Eq, Int -> Update -> ShowS
[Update] -> ShowS
Update -> String
(Int -> Update -> ShowS)
-> (Update -> String) -> ([Update] -> ShowS) -> Show Update
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Update] -> ShowS
$cshowList :: [Update] -> ShowS
show :: Update -> String
$cshow :: Update -> String
showsPrec :: Int -> Update -> ShowS
$cshowsPrec :: Int -> Update -> ShowS
Show)

instance FromJSON Update where
  parseJSON :: Value -> Parser Update
parseJSON = String -> (Object -> Parser Update) -> Value -> Parser Update
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Insert" ((Object -> Parser Update) -> Value -> Parser Update)
-> (Object -> Parser Update) -> Value -> Parser Update
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Value
kind         <- Object
o Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"kind"
    Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Value
kind Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Value
String Text
"update") (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid update"
    Text
schema       <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"schema"
    Text
table        <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"table"
    [Text]
columnNames  <- Object
o Object -> Key -> Parser [Text]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"columnnames"
    [Text]
columnTypes  <- Object
o Object -> Key -> Parser [Text]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"columntypes"
    [WalValue]
columnValues <- Object
o Object -> Key -> Parser [WalValue]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"columnvalues"
    case [Text] -> [Text] -> [WalValue] -> Either ColumnParseError [Column]
columns [Text]
columnNames [Text]
columnTypes [WalValue]
columnValues of
      Left ColumnParseError
err      -> String -> Parser Update
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Update) -> String -> Parser Update
forall a b. (a -> b) -> a -> b
$ ColumnParseError -> String
forall a. Show a => a -> String
show ColumnParseError
err
      Right [Column]
columns -> Update -> Parser Update
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Update -> Parser Update) -> Update -> Parser Update
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Column] -> Update
Update Text
schema Text
table [Column]
columns

instance ToJSON Update where
  toJSON :: Update -> Value
toJSON (Update Text
schema Text
table [Column]
columns) =
    let ([Text]
cNames, [Text]
cTypes, [WalValue]
cValues) = [Column] -> ([Text], [Text], [WalValue])
fromColumns [Column]
columns
    in [Pair] -> Value
object [ Key
"kind"         Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"update"
              , Key
"schema"       Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
schema
              , Key
"table"        Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
table
              , Key
"columnnames"  Key -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text]
cNames
              , Key
"columntypes"  Key -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text]
cTypes
              , Key
"columnvalues" Key -> [WalValue] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [WalValue]
cValues
              ]

-- | Represents a single delete query in the logical replication format
data Delete
  = Delete
  { Delete -> Text
deleteSchema  :: !Text
  , Delete -> Text
deleteTable   :: !Text
  , Delete -> [Column]
deleteColumns :: ![Column]
  }
  deriving (Delete -> Delete -> Bool
(Delete -> Delete -> Bool)
-> (Delete -> Delete -> Bool) -> Eq Delete
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Delete -> Delete -> Bool
$c/= :: Delete -> Delete -> Bool
== :: Delete -> Delete -> Bool
$c== :: Delete -> Delete -> Bool
Eq, Int -> Delete -> ShowS
[Delete] -> ShowS
Delete -> String
(Int -> Delete -> ShowS)
-> (Delete -> String) -> ([Delete] -> ShowS) -> Show Delete
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Delete] -> ShowS
$cshowList :: [Delete] -> ShowS
show :: Delete -> String
$cshow :: Delete -> String
showsPrec :: Int -> Delete -> ShowS
$cshowsPrec :: Int -> Delete -> ShowS
Show)

instance FromJSON Delete where
  parseJSON :: Value -> Parser Delete
parseJSON = String -> (Object -> Parser Delete) -> Value -> Parser Delete
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Delete" ((Object -> Parser Delete) -> Value -> Parser Delete)
-> (Object -> Parser Delete) -> Value -> Parser Delete
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Value
kind      <- Object
o Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"kind"
    Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Value
kind Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Value
String Text
"delete") (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid delete"
    Text
schema    <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"schema"
    Text
table     <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"table"
    Object
oldKeys   <- Object
o Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"oldkeys"
    [Text]
keyNames  <- Object
oldKeys Object -> Key -> Parser [Text]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"keynames"
    [Text]
keyTypes  <- Object
oldKeys Object -> Key -> Parser [Text]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"keytypes"
    [WalValue]
keyValues <- Object
oldKeys Object -> Key -> Parser [WalValue]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"keyvalues"
    case [Text] -> [Text] -> [WalValue] -> Either ColumnParseError [Column]
columns [Text]
keyNames [Text]
keyTypes [WalValue]
keyValues of
      Left ColumnParseError
err      -> String -> Parser Delete
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Delete) -> String -> Parser Delete
forall a b. (a -> b) -> a -> b
$ ColumnParseError -> String
forall a. Show a => a -> String
show ColumnParseError
err
      Right [Column]
columns -> Delete -> Parser Delete
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Delete -> Parser Delete) -> Delete -> Parser Delete
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Column] -> Delete
Delete Text
schema Text
table [Column]
columns

instance ToJSON Delete where
  toJSON :: Delete -> Value
toJSON (Delete Text
schema Text
table [Column]
columns) =
    let ([Text]
cNames, [Text]
cTypes, [WalValue]
cValues) = [Column] -> ([Text], [Text], [WalValue])
fromColumns [Column]
columns
    in [Pair] -> Value
object [ Key
"kind"    Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"delete"
              , Key
"schema"  Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
schema
              , Key
"table"   Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
table
              , Key
"oldkeys" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object
                [ Key
"keynames"  Key -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text]
cNames
                , Key
"keytypes"  Key -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text]
cTypes
                , Key
"keyvalues" Key -> [WalValue] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [WalValue]
cValues
                ]
              ]

-- | Occasionally the server may also send these for informational
-- purposes and can be ignored.  May be used internally.
data Message
  = Message
  { Message -> Bool
messageTransactional :: !Bool
  , Message -> Text
messagePrefix        :: !Text
  , Message -> Text
messageContent       :: !Text
  }
  deriving (Message -> Message -> Bool
(Message -> Message -> Bool)
-> (Message -> Message -> Bool) -> Eq Message
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Message -> Message -> Bool
$c/= :: Message -> Message -> Bool
== :: Message -> Message -> Bool
$c== :: Message -> Message -> Bool
Eq, Int -> Message -> ShowS
[Message] -> ShowS
Message -> String
(Int -> Message -> ShowS)
-> (Message -> String) -> ([Message] -> ShowS) -> Show Message
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Message] -> ShowS
$cshowList :: [Message] -> ShowS
show :: Message -> String
$cshow :: Message -> String
showsPrec :: Int -> Message -> ShowS
$cshowsPrec :: Int -> Message -> ShowS
Show)

instance FromJSON Message where
  parseJSON :: Value -> Parser Message
parseJSON = String -> (Object -> Parser Message) -> Value -> Parser Message
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Message" ((Object -> Parser Message) -> Value -> Parser Message)
-> (Object -> Parser Message) -> Value -> Parser Message
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Value
kind          <- Object
o Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"kind"
    Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Value
kind Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Value
String Text
"message") (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid message"
    Bool
transactional <- Object
o Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"transactional"
    Text
prefix        <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"prefix"
    Text
content       <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"content"
    Message -> Parser Message
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Message -> Parser Message) -> Message -> Parser Message
forall a b. (a -> b) -> a -> b
$ Bool -> Text -> Text -> Message
Message Bool
transactional Text
prefix Text
content

instance ToJSON Message where
  toJSON :: Message -> Value
toJSON (Message Bool
transactional Text
prefix Text
content)
    = [Pair] -> Value
object
    [ Key
"kind"          Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"message"
    , Key
"transactional" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
transactional
    , Key
"prefix"        Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
prefix
    , Key
"content"       Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
content
    ]

data WalLogData
  = WInsert !Insert
  | WUpdate !Update
  | WDelete !Delete
  | WMessage !Message
  deriving (WalLogData -> WalLogData -> Bool
(WalLogData -> WalLogData -> Bool)
-> (WalLogData -> WalLogData -> Bool) -> Eq WalLogData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WalLogData -> WalLogData -> Bool
$c/= :: WalLogData -> WalLogData -> Bool
== :: WalLogData -> WalLogData -> Bool
$c== :: WalLogData -> WalLogData -> Bool
Eq, (forall x. WalLogData -> Rep WalLogData x)
-> (forall x. Rep WalLogData x -> WalLogData) -> Generic WalLogData
forall x. Rep WalLogData x -> WalLogData
forall x. WalLogData -> Rep WalLogData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WalLogData x -> WalLogData
$cfrom :: forall x. WalLogData -> Rep WalLogData x
Generic, Int -> WalLogData -> ShowS
[WalLogData] -> ShowS
WalLogData -> String
(Int -> WalLogData -> ShowS)
-> (WalLogData -> String)
-> ([WalLogData] -> ShowS)
-> Show WalLogData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WalLogData] -> ShowS
$cshowList :: [WalLogData] -> ShowS
show :: WalLogData -> String
$cshow :: WalLogData -> String
showsPrec :: Int -> WalLogData -> ShowS
$cshowsPrec :: Int -> WalLogData -> ShowS
Show)

instance ToJSON WalLogData where
  toJSON :: WalLogData -> Value
toJSON = Options -> WalLogData -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions { sumEncoding :: SumEncoding
sumEncoding = SumEncoding
UntaggedValue }

instance FromJSON WalLogData where
  parseJSON :: Value -> Parser WalLogData
parseJSON = Options -> Value -> Parser WalLogData
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions { sumEncoding :: SumEncoding
sumEncoding = SumEncoding
UntaggedValue }

data Change
  = Change
  { Change -> LSN
changeNextLSN :: LSN
    -- ^ Return this LSN in your callback to update the stream state
    -- in replicant
  , Change -> [WalLogData]
changeDeltas  :: [WalLogData]
    -- ^ The list of WAL log changes in this transaction.
  }
  deriving (Change -> Change -> Bool
(Change -> Change -> Bool)
-> (Change -> Change -> Bool) -> Eq Change
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Change -> Change -> Bool
$c/= :: Change -> Change -> Bool
== :: Change -> Change -> Bool
$c== :: Change -> Change -> Bool
Eq, (forall x. Change -> Rep Change x)
-> (forall x. Rep Change x -> Change) -> Generic Change
forall x. Rep Change x -> Change
forall x. Change -> Rep Change x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Change x -> Change
$cfrom :: forall x. Change -> Rep Change x
Generic, Int -> Change -> ShowS
[Change] -> ShowS
Change -> String
(Int -> Change -> ShowS)
-> (Change -> String) -> ([Change] -> ShowS) -> Show Change
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Change] -> ShowS
$cshowList :: [Change] -> ShowS
show :: Change -> String
$cshow :: Change -> String
showsPrec :: Int -> Change -> ShowS
$cshowsPrec :: Int -> Change -> ShowS
Show)

instance ToJSON Change where
  toJSON :: Change -> Value
toJSON = Options -> Change -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions

instance FromJSON Change where
  parseJSON :: Value -> Parser Change
parseJSON = String -> (Object -> Parser Change) -> Value -> Parser Change
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Change" ((Object -> Parser Change) -> Value -> Parser Change)
-> (Object -> Parser Change) -> Value -> Parser Change
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    LSN
nextLSN <- Object
o Object -> Key -> Parser LSN
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"nextlsn"
    [WalLogData]
deltas  <- Object
o Object -> Key -> Parser [WalLogData]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"change"
    Change -> Parser Change
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Change -> Parser Change) -> Change -> Parser Change
forall a b. (a -> b) -> a -> b
$ LSN -> [WalLogData] -> Change
Change LSN
nextLSN [WalLogData]
deltas