{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE RankNTypes #-}

module Ouroboros.Consensus.Storage.LeiosDB.API
  ( -- * Handle
    LeiosDbHandle (..)
  , LeiosDbStats (..)
  , LeiosEbNotification (..)

    -- * Reading
  , LeiosDbReader (..)
  , withReader
  , allocateReader

    -- * Writing
  , LeiosDbWriter (..)
  , Promise (..)
  , awaitAll
  , withWriter
  , allocateWriter
  , CompletedEbs
  ) where

import Cardano.Slotting.Slot (SlotNo)
import Control.Concurrent.Class.MonadSTM.Strict (StrictTChan)
import Control.ResourceRegistry (ResourceRegistry, allocate)
import Data.ByteString (ByteString)
import Data.Foldable (traverse_)
import GHC.Stack (HasCallStack)
import NoThunks.Class (OnlyCheckWhnfNamed (..))
import Ouroboros.Consensus.Leios.Types
  ( BytesSize
  , EbHash
  , LeiosEb
  , LeiosPoint
  , TxHash
  )
import Ouroboros.Consensus.Storage.LeiosDB.Trace (LeiosDbStats (..))
import Ouroboros.Consensus.Util.IOLike (IOLike, MonadThrow, NoThunks (..), bracket)

-- | The Leios database. Hands out readers, writers and subscriptions.
data LeiosDbHandle m = LeiosDbHandle
  { forall (m :: * -> *). LeiosDbHandle m -> m ()
closeLeiosDbHandle :: m ()
  -- ^ Close the database: flush what is in flight, stop whatever it runs
  -- behind the scenes, release its connections. Readers and writers handed
  -- out earlier are not usable afterwards.
  , forall (m :: * -> *).
LeiosDbHandle m -> HasCallStack => m (LeiosDbReader m)
openReader :: HasCallStack => m (LeiosDbReader m)
  -- ^ Get a new reader. No interaction between readers or writers.
  , forall (m :: * -> *).
LeiosDbHandle m -> HasCallStack => m (LeiosDbWriter m)
openWriter :: HasCallStack => m (LeiosDbWriter m)
  -- ^ Get a new writer. All writes of all writers are serialised.
  , forall (m :: * -> *).
LeiosDbHandle m
-> HasCallStack => m (StrictTChan m LeiosEbNotification)
subscribeEbNotifications :: HasCallStack => m (StrictTChan m LeiosEbNotification)
  -- ^ New EBs and EB closures as they are stored, from the moment of
  -- subscription.
  -- TODO: make return type more descriptive (e.g. Subscription { getNext :: STM m LeiosEbNotification })
  , forall (m :: * -> *).
LeiosDbHandle m -> HasCallStack => SlotNo -> m ()
leiosDbGarbageCollect :: HasCallStack => SlotNo -> m ()
  -- ^ Trigger garbage collection of the LeiosDB.
  --
  --   This function does not do have to do the actual GC, but rather
  --   act as the MARK phase of GC and "create work" for a background SWEEP thread.
  --
  --   See 'sqlGarbageCollect' for the SQL backend implementation.
  , forall (m :: * -> *).
LeiosDbHandle m -> HasCallStack => [LeiosPoint] -> m ()
leiosDbPromoteToImmutable :: HasCallStack => [LeiosPoint] -> m ()
  -- ^ Promote the given EBs' bodies and tx closures from volatile into immutable
  --   LeiosDb. Takes a batch: the caller holds the ImmutableDB write lock and
  --   blocks on the shared writer queue, so this must be one round-trip per
  --   'copyToImmutableDB' pass, not one per certified EB.
  , forall (m :: * -> *).
LeiosDbHandle m -> HasCallStack => m LeiosDbStats
leiosDbSampleStats :: HasCallStack => m LeiosDbStats
  -- ^ Sample 'LeiosDbStats' counters.
  }
  deriving Context -> LeiosDbHandle m -> IO (Maybe ThunkInfo)
Proxy (LeiosDbHandle m) -> String
(Context -> LeiosDbHandle m -> IO (Maybe ThunkInfo))
-> (Context -> LeiosDbHandle m -> IO (Maybe ThunkInfo))
-> (Proxy (LeiosDbHandle m) -> String)
-> NoThunks (LeiosDbHandle m)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall (m :: * -> *).
Context -> LeiosDbHandle m -> IO (Maybe ThunkInfo)
forall (m :: * -> *). Proxy (LeiosDbHandle m) -> String
$cnoThunks :: forall (m :: * -> *).
Context -> LeiosDbHandle m -> IO (Maybe ThunkInfo)
noThunks :: Context -> LeiosDbHandle m -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (m :: * -> *).
Context -> LeiosDbHandle m -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> LeiosDbHandle m -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall (m :: * -> *). Proxy (LeiosDbHandle m) -> String
showTypeOf :: Proxy (LeiosDbHandle m) -> String
NoThunks via OnlyCheckWhnfNamed "LeiosDbHandle" (LeiosDbHandle m)

-- | Query API into the LeiosDb. Do not use a reader in two concurrent threads.
data LeiosDbReader m = LeiosDbReader
  { forall (m :: * -> *). LeiosDbReader m -> m ()
closeReader :: m ()
  , forall (m :: * -> *).
LeiosDbReader m
-> HasCallStack => EbHash -> m [(TxHash, BytesSize)]
lookupEbBody :: HasCallStack => EbHash -> m [(TxHash, BytesSize)]
  -- ^ The EB "body": tx hashes and sizes in order, no tx bytes.
  , forall (m :: * -> *).
LeiosDbReader m
-> HasCallStack => EbHash -> m (Maybe [(TxHash, ByteString)])
lookupEbClosure :: HasCallStack => EbHash -> m (Maybe [(TxHash, ByteString)])
  -- ^ The EB "closure": tx hashes /and/ their bytes, or 'Nothing' if the EB is
  -- not complete.
  , forall (m :: * -> *).
LeiosDbReader m
-> HasCallStack =>
   EbHash -> [Int] -> m [(Int, TxHash, Maybe ByteString)]
batchRetrieveTxs ::
      HasCallStack =>
      EbHash -> [Int] -> m [(Int, TxHash, Maybe ByteString)]
  -- ^ Tx bytes for a batch of offsets into one EB.
  , forall (m :: * -> *).
LeiosDbReader m -> HasCallStack => m [(SlotNo, EbHash)]
testScanEbPoints :: HasCallStack => m [(SlotNo, EbHash)]
  -- ^ Every announced EB point.
  --
  -- Not used in production, only used in tests to observe point
  -- writes and truncation.
  , forall (m :: * -> *).
LeiosDbReader m -> HasCallStack => SlotNo -> m [LeiosPoint]
scanCompleteEbClosuresNotOlderThanSlot ::
      HasCallStack =>
      SlotNo -> m [LeiosPoint]
  -- ^ EBs whose closure is complete and whose announcer is no older than the
  -- given slot. Seeds the ChainDB's acquired-closures set at startup.
  }
  deriving Context -> LeiosDbReader m -> IO (Maybe ThunkInfo)
Proxy (LeiosDbReader m) -> String
(Context -> LeiosDbReader m -> IO (Maybe ThunkInfo))
-> (Context -> LeiosDbReader m -> IO (Maybe ThunkInfo))
-> (Proxy (LeiosDbReader m) -> String)
-> NoThunks (LeiosDbReader m)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall (m :: * -> *).
Context -> LeiosDbReader m -> IO (Maybe ThunkInfo)
forall (m :: * -> *). Proxy (LeiosDbReader m) -> String
$cnoThunks :: forall (m :: * -> *).
Context -> LeiosDbReader m -> IO (Maybe ThunkInfo)
noThunks :: Context -> LeiosDbReader m -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (m :: * -> *).
Context -> LeiosDbReader m -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> LeiosDbReader m -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall (m :: * -> *). Proxy (LeiosDbReader m) -> String
showTypeOf :: Proxy (LeiosDbReader m) -> String
NoThunks via OnlyCheckWhnfNamed "LeiosDbReader" (LeiosDbReader m)

-- | Modifying API into the LeiosDb.
--
-- Asynchronous interface where each operation returns upon submission. The
-- returned 'Promise' can be used to 'await' the write being performed. Any
-- exceptions are thrown through 'await'.
data LeiosDbWriter m = LeiosDbWriter
  { forall (m :: * -> *). LeiosDbWriter m -> m ()
closeWriter :: m ()
  -- ^ Close writer and flush all remaining writes.
  , forall (m :: * -> *).
LeiosDbWriter m
-> HasCallStack => LeiosPoint -> BytesSize -> m (Promise m ())
writeEbPoint :: HasCallStack => LeiosPoint -> BytesSize -> m (Promise m ())
  -- ^ Record an announced EB's point and expected size.
  , forall (m :: * -> *).
LeiosDbWriter m
-> HasCallStack =>
   LeiosPoint -> LeiosEb -> m (Promise m [LeiosPoint])
writeEbBody :: HasCallStack => LeiosPoint -> LeiosEb -> m (Promise m CompletedEbs)
  -- ^ Persist an EB body. Returns any EBs whose closure this completed.
  --
  -- The returned EB is only used for tracing and too broad: it can actually only
  -- be this same EB which got completed.
  , forall (m :: * -> *).
LeiosDbWriter m
-> HasCallStack =>
   [(TxHash, ByteString)] -> m (Promise m [LeiosPoint])
writeTxs ::
      HasCallStack =>
      [(TxHash, ByteString)] -> m (Promise m CompletedEbs)
  -- ^ Persist tx bodies. Returns the EBs whose closure this completed.
  }
  deriving Context -> LeiosDbWriter m -> IO (Maybe ThunkInfo)
Proxy (LeiosDbWriter m) -> String
(Context -> LeiosDbWriter m -> IO (Maybe ThunkInfo))
-> (Context -> LeiosDbWriter m -> IO (Maybe ThunkInfo))
-> (Proxy (LeiosDbWriter m) -> String)
-> NoThunks (LeiosDbWriter m)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall (m :: * -> *).
Context -> LeiosDbWriter m -> IO (Maybe ThunkInfo)
forall (m :: * -> *). Proxy (LeiosDbWriter m) -> String
$cnoThunks :: forall (m :: * -> *).
Context -> LeiosDbWriter m -> IO (Maybe ThunkInfo)
noThunks :: Context -> LeiosDbWriter m -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (m :: * -> *).
Context -> LeiosDbWriter m -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> LeiosDbWriter m -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall (m :: * -> *). Proxy (LeiosDbWriter m) -> String
showTypeOf :: Proxy (LeiosDbWriter m) -> String
NoThunks via OnlyCheckWhnfNamed "LeiosDbWriter" (LeiosDbWriter m)

-- | The result of a submitted write.
--
-- 'await' rethrows whatever the write threw, in the awaiting thread, as a
-- 'LeiosDbException' naming the write and the site that submitted it.
-- Awaiting twice is fine. Not awaiting discards the failure along with the
-- result: collect promises and 'awaitAll' them instead, unless the write's
-- fate genuinely does not matter.
newtype Promise m a = Promise {forall (m :: * -> *) a. Promise m a -> m a
await :: m a}
  deriving stock (forall a b. (a -> b) -> Promise m a -> Promise m b)
-> (forall a b. a -> Promise m b -> Promise m a)
-> Functor (Promise m)
forall a b. a -> Promise m b -> Promise m a
forall a b. (a -> b) -> Promise m a -> Promise m b
forall (m :: * -> *) a b.
Functor m =>
a -> Promise m b -> Promise m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> Promise m a -> Promise m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> Promise m a -> Promise m b
fmap :: forall a b. (a -> b) -> Promise m a -> Promise m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> Promise m b -> Promise m a
<$ :: forall a b. a -> Promise m b -> Promise m a
Functor

-- | Await every promise, in order.
awaitAll :: (Foldable t, Applicative m) => t (Promise m ()) -> m ()
awaitAll :: forall (t :: * -> *) (m :: * -> *).
(Foldable t, Applicative m) =>
t (Promise m ()) -> m ()
awaitAll = (Promise m () -> m ()) -> t (Promise m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Promise m () -> m ()
forall (m :: * -> *) a. Promise m a -> m a
await

-- | EBs whose tx closure became complete as a result of a write.
type CompletedEbs = [LeiosPoint]

data LeiosEbNotification
  = -- | An EB body was written.
    AcquiredEb
      -- | the EB's point
      LeiosPoint
      -- | its size in bytes
      BytesSize
  | -- | Every tx of the EB is now in the DB.
    AcquiredEbTxs
      -- | the EB's point
      LeiosPoint

withReader :: MonadThrow m => LeiosDbHandle m -> (LeiosDbReader m -> m a) -> m a
withReader :: forall (m :: * -> *) a.
MonadThrow m =>
LeiosDbHandle m -> (LeiosDbReader m -> m a) -> m a
withReader LeiosDbHandle m
db = m (LeiosDbReader m)
-> (LeiosDbReader m -> m ()) -> (LeiosDbReader m -> m a) -> m a
forall a b c. m a -> (a -> m b) -> (a -> m c) -> m c
forall (m :: * -> *) a b c.
MonadThrow m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (LeiosDbHandle m -> HasCallStack => m (LeiosDbReader m)
forall (m :: * -> *).
LeiosDbHandle m -> HasCallStack => m (LeiosDbReader m)
openReader LeiosDbHandle m
db) LeiosDbReader m -> m ()
forall (m :: * -> *). LeiosDbReader m -> m ()
closeReader

withWriter :: MonadThrow m => LeiosDbHandle m -> (LeiosDbWriter m -> m a) -> m a
withWriter :: forall (m :: * -> *) a.
MonadThrow m =>
LeiosDbHandle m -> (LeiosDbWriter m -> m a) -> m a
withWriter LeiosDbHandle m
db = m (LeiosDbWriter m)
-> (LeiosDbWriter m -> m ()) -> (LeiosDbWriter m -> m a) -> m a
forall a b c. m a -> (a -> m b) -> (a -> m c) -> m c
forall (m :: * -> *) a b c.
MonadThrow m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (LeiosDbHandle m -> HasCallStack => m (LeiosDbWriter m)
forall (m :: * -> *).
LeiosDbHandle m -> HasCallStack => m (LeiosDbWriter m)
openWriter LeiosDbHandle m
db) LeiosDbWriter m -> m ()
forall (m :: * -> *). LeiosDbWriter m -> m ()
closeWriter

allocateReader :: IOLike m => ResourceRegistry m -> LeiosDbHandle m -> m (LeiosDbReader m)
allocateReader :: forall (m :: * -> *).
IOLike m =>
ResourceRegistry m -> LeiosDbHandle m -> m (LeiosDbReader m)
allocateReader ResourceRegistry m
registry LeiosDbHandle m
db = (ResourceKey m, LeiosDbReader m) -> LeiosDbReader m
forall a b. (a, b) -> b
snd ((ResourceKey m, LeiosDbReader m) -> LeiosDbReader m)
-> m (ResourceKey m, LeiosDbReader m) -> m (LeiosDbReader m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ResourceRegistry m
-> (ResourceId -> m (LeiosDbReader m))
-> (LeiosDbReader m -> m ())
-> m (ResourceKey m, LeiosDbReader m)
forall (m :: * -> *) a.
(MonadSTM m, MonadMask m, MonadThread m, MonadEvaluate m,
 HasCallStack) =>
ResourceRegistry m
-> (ResourceId -> m a) -> (a -> m ()) -> m (ResourceKey m, a)
allocate ResourceRegistry m
registry (\ResourceId
_ -> LeiosDbHandle m -> HasCallStack => m (LeiosDbReader m)
forall (m :: * -> *).
LeiosDbHandle m -> HasCallStack => m (LeiosDbReader m)
openReader LeiosDbHandle m
db) LeiosDbReader m -> m ()
forall (m :: * -> *). LeiosDbReader m -> m ()
closeReader

allocateWriter :: IOLike m => ResourceRegistry m -> LeiosDbHandle m -> m (LeiosDbWriter m)
allocateWriter :: forall (m :: * -> *).
IOLike m =>
ResourceRegistry m -> LeiosDbHandle m -> m (LeiosDbWriter m)
allocateWriter ResourceRegistry m
registry LeiosDbHandle m
db = (ResourceKey m, LeiosDbWriter m) -> LeiosDbWriter m
forall a b. (a, b) -> b
snd ((ResourceKey m, LeiosDbWriter m) -> LeiosDbWriter m)
-> m (ResourceKey m, LeiosDbWriter m) -> m (LeiosDbWriter m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ResourceRegistry m
-> (ResourceId -> m (LeiosDbWriter m))
-> (LeiosDbWriter m -> m ())
-> m (ResourceKey m, LeiosDbWriter m)
forall (m :: * -> *) a.
(MonadSTM m, MonadMask m, MonadThread m, MonadEvaluate m,
 HasCallStack) =>
ResourceRegistry m
-> (ResourceId -> m a) -> (a -> m ()) -> m (ResourceKey m, a)
allocate ResourceRegistry m
registry (\ResourceId
_ -> LeiosDbHandle m -> HasCallStack => m (LeiosDbWriter m)
forall (m :: * -> *).
LeiosDbHandle m -> HasCallStack => m (LeiosDbWriter m)
openWriter LeiosDbHandle m
db) LeiosDbWriter m -> m ()
forall (m :: * -> *). LeiosDbWriter m -> m ()
closeWriter