{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE DerivingVia         #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}

module Ouroboros.Consensus.Storage.ImmutableDB.Impl.Index (
    -- * Index
    Index (..)
  , readEntry
  , readOffset
    -- * File-backed index
  , fileBackedIndex
    -- * Cached index
  , CacheConfig (..)
  , cachedIndex
  ) where

import           Control.Tracer (Tracer)
import           Data.Functor.Identity (Identity (..))
import           Data.Proxy (Proxy (..))
import           Data.Typeable (Typeable)
import           Data.Word (Word64)
import           GHC.Stack (HasCallStack)
import           NoThunks.Class (OnlyCheckWhnfNamed (..))

import           Ouroboros.Consensus.Block (ConvertRawHash, IsEBB, StandardHash)
import           Ouroboros.Consensus.Util.IOLike
import           Ouroboros.Consensus.Util.ResourceRegistry

import           Ouroboros.Consensus.Storage.FS.API (HasFS)
import           Ouroboros.Consensus.Storage.FS.API.Types (AllowExisting,
                     Handle)

import           Ouroboros.Consensus.Storage.ImmutableDB.Chunks
import           Ouroboros.Consensus.Storage.ImmutableDB.Impl.Index.Cache
                     (CacheConfig (..))
import qualified Ouroboros.Consensus.Storage.ImmutableDB.Impl.Index.Cache as Cache
import           Ouroboros.Consensus.Storage.ImmutableDB.Impl.Index.Primary
                     (SecondaryOffset)
import qualified Ouroboros.Consensus.Storage.ImmutableDB.Impl.Index.Primary as Primary
import           Ouroboros.Consensus.Storage.ImmutableDB.Impl.Index.Secondary
                     (BlockSize)
import qualified Ouroboros.Consensus.Storage.ImmutableDB.Impl.Index.Secondary as Secondary
import           Ouroboros.Consensus.Storage.ImmutableDB.Impl.Types
                     (TraceCacheEvent, WithBlockSize (..))

{------------------------------------------------------------------------------
  Index
------------------------------------------------------------------------------}

-- | Bundle the operations on the primary and secondary index that touch the
-- files. This allows us to easily introduce an intermediary caching layer.
data Index m blk h = Index
  { -- | See 'Primary.readOffsets'
    Index m blk h
-> forall (t :: * -> *).
   (HasCallStack, Traversable t) =>
   ChunkNo -> t RelativeSlot -> m (t (Maybe SecondaryOffset))
readOffsets
      :: forall t. (HasCallStack, Traversable t)
      => ChunkNo
      -> t RelativeSlot
      -> m (t (Maybe SecondaryOffset))

    -- |  See 'Primary.readFirstFilledSlot'
  , Index m blk h -> HasCallStack => ChunkNo -> m (Maybe RelativeSlot)
readFirstFilledSlot
      :: HasCallStack
      => ChunkNo
      -> m (Maybe RelativeSlot)

    -- | See 'Primary.open'
  , Index m blk h
-> HasCallStack => ChunkNo -> AllowExisting -> m (Handle h)
openPrimaryIndex
      :: HasCallStack
      => ChunkNo
      -> AllowExisting
      -> m (Handle h)

    -- | See 'Primary.appendOffsets'
  , Index m blk h
-> forall (f :: * -> *).
   (HasCallStack, Foldable f) =>
   Handle h -> f SecondaryOffset -> m ()
appendOffsets
      :: forall f. (HasCallStack, Foldable f)
      => Handle h
      -> f SecondaryOffset
      -> m ()

    -- | See 'Secondary.readEntries'
  , Index m blk h
-> forall (t :: * -> *).
   (HasCallStack, Traversable t) =>
   ChunkNo
   -> t (IsEBB, SecondaryOffset) -> m (t (Entry blk, BlockSize))
readEntries
      :: forall t. (HasCallStack, Traversable t)
      => ChunkNo
      -> t (IsEBB, SecondaryOffset)
      -> m (t (Secondary.Entry blk, BlockSize))

    -- | See 'Secondary.readAllEntries'
  , Index m blk h
-> HasCallStack =>
   SecondaryOffset
   -> ChunkNo
   -> (Entry blk -> Bool)
   -> Word64
   -> IsEBB
   -> m [WithBlockSize (Entry blk)]
readAllEntries
      :: HasCallStack
      => SecondaryOffset
      -> ChunkNo
      -> (Secondary.Entry blk -> Bool)
      -> Word64
      -> IsEBB
      -> m [WithBlockSize (Secondary.Entry blk)]

    -- | See 'Secondary.appendEntry'
  , Index m blk h
-> HasCallStack =>
   ChunkNo -> Handle h -> WithBlockSize (Entry blk) -> m Word64
appendEntry
      :: HasCallStack
      => ChunkNo
      -> Handle h
      -> WithBlockSize (Secondary.Entry blk)
      -> m Word64

    -- | Close the index and stop any background threads.
    --
    -- Should be called when the ImmutableDB is closed.
  , Index m blk h -> HasCallStack => m ()
close
      :: HasCallStack
      => m ()

    -- | Restart a closed index using the given chunk as the current chunk,
    -- drop all previously cached information.
    --
    -- NOTE: this will only used in the testsuite, when we need to truncate.
  , Index m blk h -> HasCallStack => ChunkNo -> m ()
restart
      :: HasCallStack
      => ChunkNo
      -> m ()
  }
  deriving Context -> Index m blk h -> IO (Maybe ThunkInfo)
Proxy (Index m blk h) -> String
(Context -> Index m blk h -> IO (Maybe ThunkInfo))
-> (Context -> Index m blk h -> IO (Maybe ThunkInfo))
-> (Proxy (Index m blk h) -> String)
-> NoThunks (Index m blk h)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall (m :: * -> *) blk h.
Context -> Index m blk h -> IO (Maybe ThunkInfo)
forall (m :: * -> *) blk h. Proxy (Index m blk h) -> String
showTypeOf :: Proxy (Index m blk h) -> String
$cshowTypeOf :: forall (m :: * -> *) blk h. Proxy (Index m blk h) -> String
wNoThunks :: Context -> Index m blk h -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (m :: * -> *) blk h.
Context -> Index m blk h -> IO (Maybe ThunkInfo)
noThunks :: Context -> Index m blk h -> IO (Maybe ThunkInfo)
$cnoThunks :: forall (m :: * -> *) blk h.
Context -> Index m blk h -> IO (Maybe ThunkInfo)
NoThunks via OnlyCheckWhnfNamed "Index" (Index m blk h)

-- | See 'Primary.readOffset'.
readOffset
  :: Functor m
  => Index m blk h
  -> ChunkNo
  -> RelativeSlot
  -> m (Maybe SecondaryOffset)
readOffset :: Index m blk h
-> ChunkNo -> RelativeSlot -> m (Maybe SecondaryOffset)
readOffset Index m blk h
index ChunkNo
chunk RelativeSlot
slot = Identity (Maybe SecondaryOffset) -> Maybe SecondaryOffset
forall a. Identity a -> a
runIdentity (Identity (Maybe SecondaryOffset) -> Maybe SecondaryOffset)
-> m (Identity (Maybe SecondaryOffset))
-> m (Maybe SecondaryOffset)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Index m blk h
-> ChunkNo
-> Identity RelativeSlot
-> m (Identity (Maybe SecondaryOffset))
forall (m :: * -> *) blk h.
Index m blk h
-> forall (t :: * -> *).
   (HasCallStack, Traversable t) =>
   ChunkNo -> t RelativeSlot -> m (t (Maybe SecondaryOffset))
readOffsets Index m blk h
index ChunkNo
chunk (RelativeSlot -> Identity RelativeSlot
forall a. a -> Identity a
Identity RelativeSlot
slot)

-- | See 'Secondary.readEntry'.
readEntry
  :: Functor m
  => Index m blk h
  -> ChunkNo
  -> IsEBB
  -> SecondaryOffset
  -> m (Secondary.Entry blk, BlockSize)
readEntry :: Index m blk h
-> ChunkNo -> IsEBB -> SecondaryOffset -> m (Entry blk, BlockSize)
readEntry Index m blk h
index ChunkNo
chunk IsEBB
isEBB SecondaryOffset
slotOffset = Identity (Entry blk, BlockSize) -> (Entry blk, BlockSize)
forall a. Identity a -> a
runIdentity (Identity (Entry blk, BlockSize) -> (Entry blk, BlockSize))
-> m (Identity (Entry blk, BlockSize)) -> m (Entry blk, BlockSize)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Index m blk h
-> ChunkNo
-> Identity (IsEBB, SecondaryOffset)
-> m (Identity (Entry blk, BlockSize))
forall (m :: * -> *) blk h.
Index m blk h
-> forall (t :: * -> *).
   (HasCallStack, Traversable t) =>
   ChunkNo
   -> t (IsEBB, SecondaryOffset) -> m (t (Entry blk, BlockSize))
readEntries Index m blk h
index ChunkNo
chunk ((IsEBB, SecondaryOffset) -> Identity (IsEBB, SecondaryOffset)
forall a. a -> Identity a
Identity (IsEBB
isEBB, SecondaryOffset
slotOffset))

{------------------------------------------------------------------------------
  File-backed index
------------------------------------------------------------------------------}

fileBackedIndex
  :: forall m blk h.
     (ConvertRawHash blk, MonadCatch m, StandardHash blk, Typeable blk)
  => HasFS m h
  -> ChunkInfo
  -> Index m blk h
fileBackedIndex :: HasFS m h -> ChunkInfo -> Index m blk h
fileBackedIndex HasFS m h
hasFS ChunkInfo
chunkInfo = Index :: forall (m :: * -> *) blk h.
(forall (t :: * -> *).
 (HasCallStack, Traversable t) =>
 ChunkNo -> t RelativeSlot -> m (t (Maybe SecondaryOffset)))
-> (HasCallStack => ChunkNo -> m (Maybe RelativeSlot))
-> (HasCallStack => ChunkNo -> AllowExisting -> m (Handle h))
-> (forall (f :: * -> *).
    (HasCallStack, Foldable f) =>
    Handle h -> f SecondaryOffset -> m ())
-> (forall (t :: * -> *).
    (HasCallStack, Traversable t) =>
    ChunkNo
    -> t (IsEBB, SecondaryOffset) -> m (t (Entry blk, BlockSize)))
-> (HasCallStack =>
    SecondaryOffset
    -> ChunkNo
    -> (Entry blk -> Bool)
    -> Word64
    -> IsEBB
    -> m [WithBlockSize (Entry blk)])
-> (HasCallStack =>
    ChunkNo -> Handle h -> WithBlockSize (Entry blk) -> m Word64)
-> (HasCallStack => m ())
-> (HasCallStack => ChunkNo -> m ())
-> Index m blk h
Index
    { readOffsets :: forall (t :: * -> *).
(HasCallStack, Traversable t) =>
ChunkNo -> t RelativeSlot -> m (t (Maybe SecondaryOffset))
readOffsets         = Proxy blk
-> HasFS m h
-> ChunkNo
-> t RelativeSlot
-> m (t (Maybe SecondaryOffset))
forall blk (m :: * -> *) h (t :: * -> *).
(HasCallStack, MonadThrow m, Traversable t, StandardHash blk,
 Typeable blk) =>
Proxy blk
-> HasFS m h
-> ChunkNo
-> t RelativeSlot
-> m (t (Maybe SecondaryOffset))
Primary.readOffsets         Proxy blk
p HasFS m h
hasFS
    , readFirstFilledSlot :: HasCallStack => ChunkNo -> m (Maybe RelativeSlot)
readFirstFilledSlot = Proxy blk
-> HasFS m h -> ChunkInfo -> ChunkNo -> m (Maybe RelativeSlot)
forall blk (m :: * -> *) h.
(HasCallStack, MonadThrow m, StandardHash blk, Typeable blk) =>
Proxy blk
-> HasFS m h -> ChunkInfo -> ChunkNo -> m (Maybe RelativeSlot)
Primary.readFirstFilledSlot Proxy blk
p HasFS m h
hasFS ChunkInfo
chunkInfo
    , openPrimaryIndex :: HasCallStack => ChunkNo -> AllowExisting -> m (Handle h)
openPrimaryIndex    = HasFS m h -> ChunkNo -> AllowExisting -> m (Handle h)
forall (m :: * -> *) h.
(HasCallStack, MonadCatch m) =>
HasFS m h -> ChunkNo -> AllowExisting -> m (Handle h)
Primary.open                  HasFS m h
hasFS
    , appendOffsets :: forall (f :: * -> *).
(HasCallStack, Foldable f) =>
Handle h -> f SecondaryOffset -> m ()
appendOffsets       = HasFS m h -> Handle h -> f SecondaryOffset -> m ()
forall (m :: * -> *) (f :: * -> *) h.
(Monad m, Foldable f, HasCallStack) =>
HasFS m h -> Handle h -> f SecondaryOffset -> m ()
Primary.appendOffsets         HasFS m h
hasFS
    , readEntries :: forall (t :: * -> *).
(HasCallStack, Traversable t) =>
ChunkNo
-> t (IsEBB, SecondaryOffset) -> m (t (Entry blk, BlockSize))
readEntries         = HasFS m h
-> ChunkNo
-> t (IsEBB, SecondaryOffset)
-> m (t (Entry blk, BlockSize))
forall (m :: * -> *) blk h (t :: * -> *).
(HasCallStack, ConvertRawHash blk, MonadThrow m, StandardHash blk,
 Typeable blk, Traversable t) =>
HasFS m h
-> ChunkNo
-> t (IsEBB, SecondaryOffset)
-> m (t (Entry blk, BlockSize))
Secondary.readEntries         HasFS m h
hasFS
    , readAllEntries :: HasCallStack =>
SecondaryOffset
-> ChunkNo
-> (Entry blk -> Bool)
-> Word64
-> IsEBB
-> m [WithBlockSize (Entry blk)]
readAllEntries      = HasFS m h
-> SecondaryOffset
-> ChunkNo
-> (Entry blk -> Bool)
-> Word64
-> IsEBB
-> m [WithBlockSize (Entry blk)]
forall (m :: * -> *) blk h.
(HasCallStack, ConvertRawHash blk, MonadThrow m, StandardHash blk,
 Typeable blk) =>
HasFS m h
-> SecondaryOffset
-> ChunkNo
-> (Entry blk -> Bool)
-> Word64
-> IsEBB
-> m [WithBlockSize (Entry blk)]
Secondary.readAllEntries      HasFS m h
hasFS
    , appendEntry :: HasCallStack =>
ChunkNo -> Handle h -> WithBlockSize (Entry blk) -> m Word64
appendEntry         = \ChunkNo
_chunk Handle h
h (WithBlockSize SecondaryOffset
_ Entry blk
entry) ->
                            HasFS m h -> Handle h -> Entry blk -> m Word64
forall (m :: * -> *) blk h.
(HasCallStack, ConvertRawHash blk, MonadThrow m) =>
HasFS m h -> Handle h -> Entry blk -> m Word64
Secondary.appendEntry         HasFS m h
hasFS Handle h
h Entry blk
entry
      -- Nothing to do
    , close :: HasCallStack => m ()
close               = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    , restart :: HasCallStack => ChunkNo -> m ()
restart             = \ChunkNo
_newCurChunk -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    }
  where
    p :: Proxy blk
    p :: Proxy blk
p = Proxy blk
forall k (t :: k). Proxy t
Proxy

{------------------------------------------------------------------------------
  Cached index
------------------------------------------------------------------------------}

-- | Caches the current chunk's indices as well as a number of past chunk's
-- indices.
--
-- Spawns a background thread to expire past chunks from the cache that
-- haven't been used for a while.
cachedIndex
  :: forall m blk h.
     (IOLike m, ConvertRawHash blk, StandardHash blk, Typeable blk)
  => HasFS m h
  -> ResourceRegistry m
  -> Tracer m TraceCacheEvent
  -> CacheConfig
  -> ChunkInfo
  -> ChunkNo  -- ^ Current chunk
  -> m (Index m blk h)
cachedIndex :: HasFS m h
-> ResourceRegistry m
-> Tracer m TraceCacheEvent
-> CacheConfig
-> ChunkInfo
-> ChunkNo
-> m (Index m blk h)
cachedIndex HasFS m h
hasFS ResourceRegistry m
registry Tracer m TraceCacheEvent
tracer CacheConfig
cacheConfig ChunkInfo
chunkInfo ChunkNo
chunk = do
    CacheEnv m blk h
cacheEnv <- HasFS m h
-> ResourceRegistry m
-> Tracer m TraceCacheEvent
-> CacheConfig
-> ChunkInfo
-> ChunkNo
-> m (CacheEnv m blk h)
forall blk (m :: * -> *) h.
(HasCallStack, ConvertRawHash blk, IOLike m, StandardHash blk,
 Typeable blk) =>
HasFS m h
-> ResourceRegistry m
-> Tracer m TraceCacheEvent
-> CacheConfig
-> ChunkInfo
-> ChunkNo
-> m (CacheEnv m blk h)
Cache.newEnv
                  HasFS m h
hasFS
                  ResourceRegistry m
registry
                  Tracer m TraceCacheEvent
tracer
                  CacheConfig
cacheConfig
                  ChunkInfo
chunkInfo
                  ChunkNo
chunk
    Index m blk h -> m (Index m blk h)
forall (m :: * -> *) a. Monad m => a -> m a
return Index :: forall (m :: * -> *) blk h.
(forall (t :: * -> *).
 (HasCallStack, Traversable t) =>
 ChunkNo -> t RelativeSlot -> m (t (Maybe SecondaryOffset)))
-> (HasCallStack => ChunkNo -> m (Maybe RelativeSlot))
-> (HasCallStack => ChunkNo -> AllowExisting -> m (Handle h))
-> (forall (f :: * -> *).
    (HasCallStack, Foldable f) =>
    Handle h -> f SecondaryOffset -> m ())
-> (forall (t :: * -> *).
    (HasCallStack, Traversable t) =>
    ChunkNo
    -> t (IsEBB, SecondaryOffset) -> m (t (Entry blk, BlockSize)))
-> (HasCallStack =>
    SecondaryOffset
    -> ChunkNo
    -> (Entry blk -> Bool)
    -> Word64
    -> IsEBB
    -> m [WithBlockSize (Entry blk)])
-> (HasCallStack =>
    ChunkNo -> Handle h -> WithBlockSize (Entry blk) -> m Word64)
-> (HasCallStack => m ())
-> (HasCallStack => ChunkNo -> m ())
-> Index m blk h
Index
      { readOffsets :: forall (t :: * -> *).
(HasCallStack, Traversable t) =>
ChunkNo -> t RelativeSlot -> m (t (Maybe SecondaryOffset))
readOffsets         = CacheEnv m blk h
-> ChunkNo -> t RelativeSlot -> m (t (Maybe SecondaryOffset))
forall blk (m :: * -> *) (t :: * -> *) h.
(HasCallStack, ConvertRawHash blk, IOLike m, StandardHash blk,
 Typeable blk, Traversable t) =>
CacheEnv m blk h
-> ChunkNo -> t RelativeSlot -> m (t (Maybe SecondaryOffset))
Cache.readOffsets         CacheEnv m blk h
cacheEnv
      , readFirstFilledSlot :: HasCallStack => ChunkNo -> m (Maybe RelativeSlot)
readFirstFilledSlot = CacheEnv m blk h -> ChunkNo -> m (Maybe RelativeSlot)
forall blk (m :: * -> *) h.
(HasCallStack, ConvertRawHash blk, IOLike m, StandardHash blk,
 Typeable blk) =>
CacheEnv m blk h -> ChunkNo -> m (Maybe RelativeSlot)
Cache.readFirstFilledSlot CacheEnv m blk h
cacheEnv
      , openPrimaryIndex :: HasCallStack => ChunkNo -> AllowExisting -> m (Handle h)
openPrimaryIndex    = CacheEnv m blk h -> ChunkNo -> AllowExisting -> m (Handle h)
forall blk (m :: * -> *) h.
(HasCallStack, ConvertRawHash blk, IOLike m, StandardHash blk,
 Typeable blk) =>
CacheEnv m blk h -> ChunkNo -> AllowExisting -> m (Handle h)
Cache.openPrimaryIndex    CacheEnv m blk h
cacheEnv
      , appendOffsets :: forall (f :: * -> *).
(HasCallStack, Foldable f) =>
Handle h -> f SecondaryOffset -> m ()
appendOffsets       = CacheEnv m blk h -> Handle h -> f SecondaryOffset -> m ()
forall (f :: * -> *) (m :: * -> *) blk h.
(HasCallStack, Foldable f, IOLike m) =>
CacheEnv m blk h -> Handle h -> f SecondaryOffset -> m ()
Cache.appendOffsets       CacheEnv m blk h
cacheEnv
      , readEntries :: forall (t :: * -> *).
(HasCallStack, Traversable t) =>
ChunkNo
-> t (IsEBB, SecondaryOffset) -> m (t (Entry blk, BlockSize))
readEntries         = CacheEnv m blk h
-> ChunkNo
-> t (IsEBB, SecondaryOffset)
-> m (t (Entry blk, BlockSize))
forall (m :: * -> *) blk h (t :: * -> *).
(HasCallStack, ConvertRawHash blk, IOLike m, StandardHash blk,
 Typeable blk, Traversable t) =>
CacheEnv m blk h
-> ChunkNo
-> t (IsEBB, SecondaryOffset)
-> m (t (Entry blk, BlockSize))
Cache.readEntries         CacheEnv m blk h
cacheEnv
      , readAllEntries :: HasCallStack =>
SecondaryOffset
-> ChunkNo
-> (Entry blk -> Bool)
-> Word64
-> IsEBB
-> m [WithBlockSize (Entry blk)]
readAllEntries      = CacheEnv m blk h
-> SecondaryOffset
-> ChunkNo
-> (Entry blk -> Bool)
-> Word64
-> IsEBB
-> m [WithBlockSize (Entry blk)]
forall (m :: * -> *) blk h.
(HasCallStack, ConvertRawHash blk, IOLike m, StandardHash blk,
 Typeable blk) =>
CacheEnv m blk h
-> SecondaryOffset
-> ChunkNo
-> (Entry blk -> Bool)
-> Word64
-> IsEBB
-> m [WithBlockSize (Entry blk)]
Cache.readAllEntries      CacheEnv m blk h
cacheEnv
      , appendEntry :: HasCallStack =>
ChunkNo -> Handle h -> WithBlockSize (Entry blk) -> m Word64
appendEntry         = CacheEnv m blk h
-> ChunkNo -> Handle h -> WithBlockSize (Entry blk) -> m Word64
forall (m :: * -> *) blk h.
(HasCallStack, ConvertRawHash blk, IOLike m) =>
CacheEnv m blk h -> ChunkNo -> Handle h -> Entry blk -> m Word64
Cache.appendEntry         CacheEnv m blk h
cacheEnv
      , close :: HasCallStack => m ()
close               = CacheEnv m blk h -> m ()
forall (m :: * -> *) blk h. IOLike m => CacheEnv m blk h -> m ()
Cache.close               CacheEnv m blk h
cacheEnv
      , restart :: HasCallStack => ChunkNo -> m ()
restart             = CacheEnv m blk h -> ChunkNo -> m ()
forall blk (m :: * -> *) h.
(ConvertRawHash blk, IOLike m, StandardHash blk, Typeable blk) =>
CacheEnv m blk h -> ChunkNo -> m ()
Cache.restart             CacheEnv m blk h
cacheEnv
      }