{-|
Module      : Database.PostgreSQL.Replicant.State
Description : Internal replication stream state
Copyright   : (c) James King, 2020, 2021
License     : BSD3
Maintainer  : james@agentultra.com
Stability   : experimental
Portability : POSIX

This module has the types and functions for maintaining the client
stream state.

After initiating a replication stream the wal_sender process on the
server may require clients to periodically send progress updates.  The
wal_sender process uses those updates to maintain its internal view of
the clients' state.

This enables the server to report on things like replication lag and
enables the client to disconnect and restart the stream where it left
off.
-}
module Database.PostgreSQL.Replicant.State where

import Control.Concurrent
import Database.PostgreSQL.Replicant.Types.Lsn

data WalProgress
  = WalProgress
  { WalProgress -> LSN
walProgressReceived :: LSN
  , WalProgress -> LSN
walProgressFlushed  :: LSN
  , WalProgress -> LSN
walProgressApplied  :: LSN
  }
  deriving (WalProgress -> WalProgress -> Bool
(WalProgress -> WalProgress -> Bool)
-> (WalProgress -> WalProgress -> Bool) -> Eq WalProgress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WalProgress -> WalProgress -> Bool
$c/= :: WalProgress -> WalProgress -> Bool
== :: WalProgress -> WalProgress -> Bool
$c== :: WalProgress -> WalProgress -> Bool
Eq, Int -> WalProgress -> ShowS
[WalProgress] -> ShowS
WalProgress -> String
(Int -> WalProgress -> ShowS)
-> (WalProgress -> String)
-> ([WalProgress] -> ShowS)
-> Show WalProgress
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WalProgress] -> ShowS
$cshowList :: [WalProgress] -> ShowS
show :: WalProgress -> String
$cshow :: WalProgress -> String
showsPrec :: Int -> WalProgress -> ShowS
$cshowsPrec :: Int -> WalProgress -> ShowS
Show)

newtype WalProgressState = WalProgressState (MVar WalProgress)

updateWalProgress :: WalProgressState -> LSN -> IO ()
updateWalProgress :: WalProgressState -> LSN -> IO ()
updateWalProgress (WalProgressState MVar WalProgress
state) LSN
lsn = do
  WalProgress
walProgress <- MVar WalProgress -> IO WalProgress
forall a. MVar a -> IO a
takeMVar MVar WalProgress
state
  MVar WalProgress -> WalProgress -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar WalProgress
state
    (WalProgress -> IO ()) -> WalProgress -> IO ()
forall a b. (a -> b) -> a -> b
$ WalProgress
walProgress { walProgressReceived :: LSN
walProgressReceived = LSN
lsn
                  , walProgressFlushed :: LSN
walProgressFlushed  = LSN
lsn
                  , walProgressApplied :: LSN
walProgressApplied  = LSN
lsn
                  }