{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Ouroboros.Consensus.Storage.ImmutableDB.Impl.State (
    -- * State types
    ImmutableDBEnv (..)
  , InternalState (..)
  , OpenState (..)
  , dbIsOpen
    -- * State helpers
  , ModifyOpenState
  , cleanUp
  , closeOpenHandles
  , getOpenState
  , mkOpenState
  , modifyOpenState
  , withOpenState
  ) where

import           Control.Monad (unless)
import           Control.Monad.State.Strict (StateT, lift)
import           Control.ResourceRegistry
import           Control.Tracer (Tracer)
import           Data.Typeable (Typeable)
import           GHC.Generics (Generic)
import           GHC.Stack (HasCallStack)
import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Storage.ImmutableDB.API
import           Ouroboros.Consensus.Storage.ImmutableDB.Chunks
import           Ouroboros.Consensus.Storage.ImmutableDB.Impl.Index (Index)
import qualified Ouroboros.Consensus.Storage.ImmutableDB.Impl.Index as Index
import           Ouroboros.Consensus.Storage.ImmutableDB.Impl.Index.Secondary
                     (BlockOffset (..))
import           Ouroboros.Consensus.Storage.ImmutableDB.Impl.Types
import           Ouroboros.Consensus.Storage.ImmutableDB.Impl.Util
import           Ouroboros.Consensus.Util (SomePair (..))
import           Ouroboros.Consensus.Util.IOLike
import           System.FS.API

{------------------------------------------------------------------------------
  Main types
------------------------------------------------------------------------------}

-- | The environment used by the immutable database.
data ImmutableDBEnv m blk = forall h. Eq h => ImmutableDBEnv {
      ()
hasFS            :: !(HasFS m h)
    , ()
varInternalState :: !(StrictSVar m (InternalState m blk h))
    , forall (m :: * -> *) blk. ImmutableDBEnv m blk -> blk -> Bool
checkIntegrity   :: !(blk -> Bool)
    , forall (m :: * -> *) blk. ImmutableDBEnv m blk -> ChunkInfo
chunkInfo        :: !ChunkInfo
    , forall (m :: * -> *) blk.
ImmutableDBEnv m blk -> Tracer m (TraceEvent blk)
tracer           :: !(Tracer m (TraceEvent blk))
    , forall (m :: * -> *) blk. ImmutableDBEnv m blk -> CacheConfig
cacheConfig      :: !Index.CacheConfig
    , forall (m :: * -> *) blk. ImmutableDBEnv m blk -> CodecConfig blk
codecConfig      :: !(CodecConfig blk)
    }

data InternalState m blk h =
    DbClosed
  | DbOpen !(OpenState m blk h)
  deriving ((forall x. InternalState m blk h -> Rep (InternalState m blk h) x)
-> (forall x.
    Rep (InternalState m blk h) x -> InternalState m blk h)
-> Generic (InternalState m blk h)
forall x. Rep (InternalState m blk h) x -> InternalState m blk h
forall x. InternalState m blk h -> Rep (InternalState m blk h) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (m :: * -> *) blk h x.
Rep (InternalState m blk h) x -> InternalState m blk h
forall (m :: * -> *) blk h x.
InternalState m blk h -> Rep (InternalState m blk h) x
$cfrom :: forall (m :: * -> *) blk h x.
InternalState m blk h -> Rep (InternalState m blk h) x
from :: forall x. InternalState m blk h -> Rep (InternalState m blk h) x
$cto :: forall (m :: * -> *) blk h x.
Rep (InternalState m blk h) x -> InternalState m blk h
to :: forall x. Rep (InternalState m blk h) x -> InternalState m blk h
Generic, Context -> InternalState m blk h -> IO (Maybe ThunkInfo)
Proxy (InternalState m blk h) -> String
(Context -> InternalState m blk h -> IO (Maybe ThunkInfo))
-> (Context -> InternalState m blk h -> IO (Maybe ThunkInfo))
-> (Proxy (InternalState m blk h) -> String)
-> NoThunks (InternalState m blk h)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall (m :: * -> *) blk h.
StandardHash blk =>
Context -> InternalState m blk h -> IO (Maybe ThunkInfo)
forall (m :: * -> *) blk h.
StandardHash blk =>
Proxy (InternalState m blk h) -> String
$cnoThunks :: forall (m :: * -> *) blk h.
StandardHash blk =>
Context -> InternalState m blk h -> IO (Maybe ThunkInfo)
noThunks :: Context -> InternalState m blk h -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (m :: * -> *) blk h.
StandardHash blk =>
Context -> InternalState m blk h -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> InternalState m blk h -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall (m :: * -> *) blk h.
StandardHash blk =>
Proxy (InternalState m blk h) -> String
showTypeOf :: Proxy (InternalState m blk h) -> String
NoThunks)

dbIsOpen :: InternalState m blk h -> Bool
dbIsOpen :: forall (m :: * -> *) blk h. InternalState m blk h -> Bool
dbIsOpen InternalState m blk h
DbClosed   = Bool
False
dbIsOpen (DbOpen OpenState m blk h
_) = Bool
True

-- | Internal state when the database is open.
data OpenState m blk h = OpenState {
      forall (m :: * -> *) blk h. OpenState m blk h -> ChunkNo
currentChunk           :: !ChunkNo
      -- ^ The current 'ChunkNo' the immutable store is writing to.
    , forall (m :: * -> *) blk h. OpenState m blk h -> BlockOffset
currentChunkOffset     :: !BlockOffset
      -- ^ The offset at which the next block will be written in the current
      -- chunk file.
    , forall (m :: * -> *) blk h. OpenState m blk h -> SecondaryOffset
currentSecondaryOffset :: !SecondaryOffset
      -- ^ The offset at which the next index entry will be written in the
      -- current secondary index.
    , forall (m :: * -> *) blk h. OpenState m blk h -> Handle h
currentChunkHandle     :: !(Handle h)
      -- ^ The write handle for the current chunk file.
    , forall (m :: * -> *) blk h. OpenState m blk h -> Handle h
currentPrimaryHandle   :: !(Handle h)
      -- ^ The write handle for the current primary index file.
    , forall (m :: * -> *) blk h. OpenState m blk h -> Handle h
currentSecondaryHandle :: !(Handle h)
      -- ^ The write handle for the current secondary index file.
    , forall (m :: * -> *) blk h.
OpenState m blk h -> WithOrigin (Tip blk)
currentTip             :: !(WithOrigin (Tip blk))
      -- ^ The current tip of the database.
    , forall (m :: * -> *) blk h. OpenState m blk h -> Index m blk h
currentIndex           :: !(Index m blk h)
      -- ^ An abstraction layer on top of the indices to allow for caching.
    }
  deriving ((forall x. OpenState m blk h -> Rep (OpenState m blk h) x)
-> (forall x. Rep (OpenState m blk h) x -> OpenState m blk h)
-> Generic (OpenState m blk h)
forall x. Rep (OpenState m blk h) x -> OpenState m blk h
forall x. OpenState m blk h -> Rep (OpenState m blk h) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (m :: * -> *) blk h x.
Rep (OpenState m blk h) x -> OpenState m blk h
forall (m :: * -> *) blk h x.
OpenState m blk h -> Rep (OpenState m blk h) x
$cfrom :: forall (m :: * -> *) blk h x.
OpenState m blk h -> Rep (OpenState m blk h) x
from :: forall x. OpenState m blk h -> Rep (OpenState m blk h) x
$cto :: forall (m :: * -> *) blk h x.
Rep (OpenState m blk h) x -> OpenState m blk h
to :: forall x. Rep (OpenState m blk h) x -> OpenState m blk h
Generic, Context -> OpenState m blk h -> IO (Maybe ThunkInfo)
Proxy (OpenState m blk h) -> String
(Context -> OpenState m blk h -> IO (Maybe ThunkInfo))
-> (Context -> OpenState m blk h -> IO (Maybe ThunkInfo))
-> (Proxy (OpenState m blk h) -> String)
-> NoThunks (OpenState m blk h)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall (m :: * -> *) blk h.
StandardHash blk =>
Context -> OpenState m blk h -> IO (Maybe ThunkInfo)
forall (m :: * -> *) blk h.
StandardHash blk =>
Proxy (OpenState m blk h) -> String
$cnoThunks :: forall (m :: * -> *) blk h.
StandardHash blk =>
Context -> OpenState m blk h -> IO (Maybe ThunkInfo)
noThunks :: Context -> OpenState m blk h -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (m :: * -> *) blk h.
StandardHash blk =>
Context -> OpenState m blk h -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> OpenState m blk h -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall (m :: * -> *) blk h.
StandardHash blk =>
Proxy (OpenState m blk h) -> String
showTypeOf :: Proxy (OpenState m blk h) -> String
NoThunks)

{------------------------------------------------------------------------------
  State helpers
------------------------------------------------------------------------------}

-- | Create the internal open state for the given chunk.
mkOpenState ::
     forall m blk h. (HasCallStack, IOLike m, Eq h)
  => HasFS m h
  -> Index m blk h
  -> ChunkNo
  -> WithOrigin (Tip blk)
  -> AllowExisting
  -> WithTempRegistry (OpenState m blk h) m (OpenState m blk h)
mkOpenState :: forall (m :: * -> *) blk h.
(HasCallStack, IOLike m, Eq h) =>
HasFS m h
-> Index m blk h
-> ChunkNo
-> WithOrigin (Tip blk)
-> AllowExisting
-> WithTempRegistry (OpenState m blk h) m (OpenState m blk h)
mkOpenState hasFS :: HasFS m h
hasFS@HasFS{m String
HasCallStack => Bool -> FsPath -> m ()
HasCallStack => Handle h -> m Bool
HasCallStack => Handle h -> m Word64
HasCallStack => Handle h -> m ()
HasCallStack => Handle h -> Word64 -> m ()
HasCallStack => Handle h -> Word64 -> m ByteString
HasCallStack => Handle h -> Word64 -> AbsOffset -> m ByteString
HasCallStack => Handle h -> ByteString -> m Word64
HasCallStack => Handle h -> SeekMode -> Int64 -> m ()
HasCallStack =>
Handle h
-> MutableByteArray (PrimState m)
-> BufferOffset
-> ByteCount
-> m ByteCount
HasCallStack =>
Handle h
-> MutableByteArray (PrimState m)
-> BufferOffset
-> ByteCount
-> AbsOffset
-> m ByteCount
HasCallStack => FsPath -> m Bool
HasCallStack => FsPath -> m ()
HasCallStack => FsPath -> m (Set String)
HasCallStack => FsPath -> FsPath -> m ()
HasCallStack => FsPath -> OpenMode -> m (Handle h)
FsPath -> m String
FsPath -> FsErrorPath
dumpState :: m String
hOpen :: HasCallStack => FsPath -> OpenMode -> m (Handle h)
hClose :: HasCallStack => Handle h -> m ()
hIsOpen :: HasCallStack => Handle h -> m Bool
hSeek :: HasCallStack => Handle h -> SeekMode -> Int64 -> m ()
hGetSome :: HasCallStack => Handle h -> Word64 -> m ByteString
hGetSomeAt :: HasCallStack => Handle h -> Word64 -> AbsOffset -> m ByteString
hPutSome :: HasCallStack => Handle h -> ByteString -> m Word64
hTruncate :: HasCallStack => Handle h -> Word64 -> m ()
hGetSize :: HasCallStack => Handle h -> m Word64
createDirectory :: HasCallStack => FsPath -> m ()
createDirectoryIfMissing :: HasCallStack => Bool -> FsPath -> m ()
listDirectory :: HasCallStack => FsPath -> m (Set String)
doesDirectoryExist :: HasCallStack => FsPath -> m Bool
doesFileExist :: HasCallStack => FsPath -> m Bool
removeDirectoryRecursive :: HasCallStack => FsPath -> m ()
removeFile :: HasCallStack => FsPath -> m ()
renameFile :: HasCallStack => FsPath -> FsPath -> m ()
mkFsErrorPath :: FsPath -> FsErrorPath
unsafeToFilePath :: FsPath -> m String
hGetBufSome :: HasCallStack =>
Handle h
-> MutableByteArray (PrimState m)
-> BufferOffset
-> ByteCount
-> m ByteCount
hGetBufSomeAt :: HasCallStack =>
Handle h
-> MutableByteArray (PrimState m)
-> BufferOffset
-> ByteCount
-> AbsOffset
-> m ByteCount
hPutBufSome :: HasCallStack =>
Handle h
-> MutableByteArray (PrimState m)
-> BufferOffset
-> ByteCount
-> m ByteCount
hPutBufSomeAt :: HasCallStack =>
Handle h
-> MutableByteArray (PrimState m)
-> BufferOffset
-> ByteCount
-> AbsOffset
-> m ByteCount
dumpState :: forall (m :: * -> *) h. HasFS m h -> m String
hOpen :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> OpenMode -> m (Handle h)
hClose :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> m ()
hIsOpen :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> m Bool
hSeek :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> SeekMode -> Int64 -> m ()
hGetSome :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> Word64 -> m ByteString
hGetSomeAt :: forall (m :: * -> *) h.
HasFS m h
-> HasCallStack => Handle h -> Word64 -> AbsOffset -> m ByteString
hPutSome :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> ByteString -> m Word64
hTruncate :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> Word64 -> m ()
hGetSize :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> m Word64
createDirectory :: forall (m :: * -> *) h. HasFS m h -> HasCallStack => FsPath -> m ()
createDirectoryIfMissing :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Bool -> FsPath -> m ()
listDirectory :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> m (Set String)
doesDirectoryExist :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> m Bool
doesFileExist :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> m Bool
removeDirectoryRecursive :: forall (m :: * -> *) h. HasFS m h -> HasCallStack => FsPath -> m ()
removeFile :: forall (m :: * -> *) h. HasFS m h -> HasCallStack => FsPath -> m ()
renameFile :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> FsPath -> m ()
mkFsErrorPath :: forall (m :: * -> *) h. HasFS m h -> FsPath -> FsErrorPath
unsafeToFilePath :: forall (m :: * -> *) h. HasFS m h -> FsPath -> m String
hGetBufSome :: forall (m :: * -> *) h.
HasFS m h
-> HasCallStack =>
   Handle h
   -> MutableByteArray (PrimState m)
   -> BufferOffset
   -> ByteCount
   -> m ByteCount
hGetBufSomeAt :: forall (m :: * -> *) h.
HasFS m h
-> HasCallStack =>
   Handle h
   -> MutableByteArray (PrimState m)
   -> BufferOffset
   -> ByteCount
   -> AbsOffset
   -> m ByteCount
hPutBufSome :: forall (m :: * -> *) h.
HasFS m h
-> HasCallStack =>
   Handle h
   -> MutableByteArray (PrimState m)
   -> BufferOffset
   -> ByteCount
   -> m ByteCount
hPutBufSomeAt :: forall (m :: * -> *) h.
HasFS m h
-> HasCallStack =>
   Handle h
   -> MutableByteArray (PrimState m)
   -> BufferOffset
   -> ByteCount
   -> AbsOffset
   -> m ByteCount
..} Index m blk h
index ChunkNo
chunk WithOrigin (Tip blk)
tip AllowExisting
existing = do
    Handle h
eHnd <- (OpenState m blk h -> Handle h)
-> m (Handle h)
-> WithTempRegistry (OpenState m blk h) m (Handle h)
allocateHandle OpenState m blk h -> Handle h
forall (m :: * -> *) blk h. OpenState m blk h -> Handle h
currentChunkHandle     (m (Handle h) -> WithTempRegistry (OpenState m blk h) m (Handle h))
-> m (Handle h)
-> WithTempRegistry (OpenState m blk h) m (Handle h)
forall a b. (a -> b) -> a -> b
$ HasCallStack => FsPath -> OpenMode -> m (Handle h)
FsPath -> OpenMode -> m (Handle h)
hOpen (ChunkNo -> FsPath
fsPathChunkFile          ChunkNo
chunk) OpenMode
appendMode
    Handle h
pHnd <- (OpenState m blk h -> Handle h)
-> m (Handle h)
-> WithTempRegistry (OpenState m blk h) m (Handle h)
allocateHandle OpenState m blk h -> Handle h
forall (m :: * -> *) blk h. OpenState m blk h -> Handle h
currentPrimaryHandle   (m (Handle h) -> WithTempRegistry (OpenState m blk h) m (Handle h))
-> m (Handle h)
-> WithTempRegistry (OpenState m blk h) m (Handle h)
forall a b. (a -> b) -> a -> b
$ Index m blk h
-> HasCallStack => ChunkNo -> AllowExisting -> m (Handle h)
forall (m :: * -> *) blk h.
Index m blk h
-> HasCallStack => ChunkNo -> AllowExisting -> m (Handle h)
Index.openPrimaryIndex Index m blk h
index    ChunkNo
chunk  AllowExisting
existing
    Handle h
sHnd <- (OpenState m blk h -> Handle h)
-> m (Handle h)
-> WithTempRegistry (OpenState m blk h) m (Handle h)
allocateHandle OpenState m blk h -> Handle h
forall (m :: * -> *) blk h. OpenState m blk h -> Handle h
currentSecondaryHandle (m (Handle h) -> WithTempRegistry (OpenState m blk h) m (Handle h))
-> m (Handle h)
-> WithTempRegistry (OpenState m blk h) m (Handle h)
forall a b. (a -> b) -> a -> b
$ HasCallStack => FsPath -> OpenMode -> m (Handle h)
FsPath -> OpenMode -> m (Handle h)
hOpen (ChunkNo -> FsPath
fsPathSecondaryIndexFile ChunkNo
chunk) OpenMode
appendMode
    Word64
chunkOffset     <- m Word64 -> WithTempRegistry (OpenState m blk h) m Word64
forall (m :: * -> *) a.
Monad m =>
m a -> WithTempRegistry (OpenState m blk h) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Word64 -> WithTempRegistry (OpenState m blk h) m Word64)
-> m Word64 -> WithTempRegistry (OpenState m blk h) m Word64
forall a b. (a -> b) -> a -> b
$ HasCallStack => Handle h -> m Word64
Handle h -> m Word64
hGetSize Handle h
eHnd
    Word64
secondaryOffset <- m Word64 -> WithTempRegistry (OpenState m blk h) m Word64
forall (m :: * -> *) a.
Monad m =>
m a -> WithTempRegistry (OpenState m blk h) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Word64 -> WithTempRegistry (OpenState m blk h) m Word64)
-> m Word64 -> WithTempRegistry (OpenState m blk h) m Word64
forall a b. (a -> b) -> a -> b
$ HasCallStack => Handle h -> m Word64
Handle h -> m Word64
hGetSize Handle h
sHnd
    OpenState m blk h
-> WithTempRegistry (OpenState m blk h) m (OpenState m blk h)
forall a. a -> WithTempRegistry (OpenState m blk h) m a
forall (m :: * -> *) a. Monad m => a -> m a
return OpenState
      { currentChunk :: ChunkNo
currentChunk           = ChunkNo
chunk
      , currentChunkOffset :: BlockOffset
currentChunkOffset     = Word64 -> BlockOffset
BlockOffset Word64
chunkOffset
      , currentSecondaryOffset :: SecondaryOffset
currentSecondaryOffset = Word64 -> SecondaryOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
secondaryOffset
      , currentChunkHandle :: Handle h
currentChunkHandle     = Handle h
eHnd
      , currentPrimaryHandle :: Handle h
currentPrimaryHandle   = Handle h
pHnd
      , currentSecondaryHandle :: Handle h
currentSecondaryHandle = Handle h
sHnd
      , currentTip :: WithOrigin (Tip blk)
currentTip             = WithOrigin (Tip blk)
tip
      , currentIndex :: Index m blk h
currentIndex           = Index m blk h
index
      }
  where
    appendMode :: OpenMode
appendMode = AllowExisting -> OpenMode
AppendMode AllowExisting
existing

    allocateHandle
      :: (OpenState m blk h -> Handle h)
      -> m (Handle h)
      -> WithTempRegistry (OpenState m blk h) m (Handle h)
    allocateHandle :: (OpenState m blk h -> Handle h)
-> m (Handle h)
-> WithTempRegistry (OpenState m blk h) m (Handle h)
allocateHandle OpenState m blk h -> Handle h
getHandle m (Handle h)
open =
      -- To check whether the handle made it in the final state, we check for
      -- equality.
      m (Handle h)
-> (Handle h -> m Bool)
-> (OpenState m blk h -> Handle h -> Bool)
-> WithTempRegistry (OpenState m blk h) m (Handle h)
forall (m :: * -> *) a st.
(MonadSTM m, MonadMask m, MonadThread m, HasCallStack) =>
m a
-> (a -> m Bool) -> (st -> a -> Bool) -> WithTempRegistry st m a
allocateTemp m (Handle h)
open (HasFS m h -> Handle h -> m Bool
forall (m :: * -> *) h.
(HasCallStack, Monad m) =>
HasFS m h -> Handle h -> m Bool
hClose' HasFS m h
hasFS) (Handle h -> Handle h -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Handle h -> Handle h -> Bool)
-> (OpenState m blk h -> Handle h)
-> OpenState m blk h
-> Handle h
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpenState m blk h -> Handle h
getHandle)

-- | Get the 'OpenState' of the given database, throw a 'ClosedDBError' in
-- case it is closed.
--
-- NOTE: Since the 'OpenState' is parameterized over a type parameter @h@ of
-- handles, which is not visible from the type of the @ImmutableDBEnv@,
-- we return a @SomePair@ here that returns the open state along with a 'HasFS'
-- instance for the /same/ type parameter @h@. Note that it would be impossible
-- to use an existing 'HasFS' instance already in scope otherwise, since the
-- @h@ parameters would not be known to match.
getOpenState ::
     forall m blk. (HasCallStack, IOLike m, StandardHash blk, Typeable blk)
  => ImmutableDBEnv m blk
  -> STM m (SomePair (HasFS m) (OpenState m blk))
getOpenState :: forall (m :: * -> *) blk.
(HasCallStack, IOLike m, StandardHash blk, Typeable blk) =>
ImmutableDBEnv m blk
-> STM m (SomePair (HasFS m) (OpenState m blk))
getOpenState ImmutableDBEnv {Tracer m (TraceEvent blk)
HasFS m h
CodecConfig blk
StrictSVar m (InternalState m blk h)
ChunkInfo
CacheConfig
blk -> Bool
hasFS :: ()
varInternalState :: ()
checkIntegrity :: forall (m :: * -> *) blk. ImmutableDBEnv m blk -> blk -> Bool
chunkInfo :: forall (m :: * -> *) blk. ImmutableDBEnv m blk -> ChunkInfo
tracer :: forall (m :: * -> *) blk.
ImmutableDBEnv m blk -> Tracer m (TraceEvent blk)
cacheConfig :: forall (m :: * -> *) blk. ImmutableDBEnv m blk -> CacheConfig
codecConfig :: forall (m :: * -> *) blk. ImmutableDBEnv m blk -> CodecConfig blk
hasFS :: HasFS m h
varInternalState :: StrictSVar m (InternalState m blk h)
checkIntegrity :: blk -> Bool
chunkInfo :: ChunkInfo
tracer :: Tracer m (TraceEvent blk)
cacheConfig :: CacheConfig
codecConfig :: CodecConfig blk
..} = do
    -- We use 'readSVarSTM' to read a potentially stale internal state if
    -- somebody's appending to the ImmutableDB at the same time.
    InternalState m blk h
internalState <- StrictSVar m (InternalState m blk h)
-> STM m (InternalState m blk h)
forall (m :: * -> *) a. MonadSTM m => StrictSVar m a -> STM m a
readSVarSTM StrictSVar m (InternalState m blk h)
varInternalState
    case InternalState m blk h
internalState of
       InternalState m blk h
DbClosed         -> ApiMisuse blk -> STM m (SomePair (HasFS m) (OpenState m blk))
forall (m :: * -> *) blk a.
(MonadThrow m, HasCallStack, StandardHash blk, Typeable blk) =>
ApiMisuse blk -> m a
throwApiMisuse (ApiMisuse blk -> STM m (SomePair (HasFS m) (OpenState m blk)))
-> ApiMisuse blk -> STM m (SomePair (HasFS m) (OpenState m blk))
forall a b. (a -> b) -> a -> b
$ forall blk. ApiMisuse blk
ClosedDBError @blk
       DbOpen OpenState m blk h
openState -> SomePair (HasFS m) (OpenState m blk)
-> STM m (SomePair (HasFS m) (OpenState m blk))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (HasFS m h
-> OpenState m blk h -> SomePair (HasFS m) (OpenState m blk)
forall {k} (f :: k -> *) (a :: k) (g :: k -> *).
f a -> g a -> SomePair f g
SomePair HasFS m h
hasFS OpenState m blk h
openState)

-- | Shorthand
type ModifyOpenState m blk h =
  StateT (OpenState m blk h) (WithTempRegistry (OpenState m blk h) m)

-- | Modify the internal state of an open database.
--
-- In case the database is closed, a 'ClosedDBError' is thrown.
--
-- In case an 'UnexpectedFailure' is thrown, the database is closed to prevent
-- further appending to a database in a potentially inconsistent state.
--
-- The action is run in the 'ModifyOpenState' monad, which is a 'StateT'
-- transformer (of the 'OpenState') over the 'WithTempRegistry' monad. This
-- monad can be used to allocate resources in that will be transferred to the
-- returned 'OpenState' that is safely stored in the 'ImmutableDBEnv'. This
-- approach makes sure that no resources are leaked when an exception is
-- thrown while running the action modifying the state.
--
-- TODO: update this comment
-- __Note__: This /takes/ the 'TMVar', /then/ runs the action (which might be
-- in 'IO'), and then puts the 'TMVar' back, just like
-- 'Control.Concurrent.MVar.modifyMVar' does. Consequently, it has the same
-- gotchas that @modifyMVar@ does; the effects are observable and it is
-- susceptible to deadlock.
modifyOpenState ::
     forall m blk a. (HasCallStack, IOLike m, StandardHash blk, Typeable blk)
  => ImmutableDBEnv m blk
  -> (forall h. Eq h => HasFS m h -> ModifyOpenState m blk h a)
  -> m a
modifyOpenState :: forall (m :: * -> *) blk a.
(HasCallStack, IOLike m, StandardHash blk, Typeable blk) =>
ImmutableDBEnv m blk
-> (forall h. Eq h => HasFS m h -> ModifyOpenState m blk h a)
-> m a
modifyOpenState ImmutableDBEnv { hasFS :: ()
hasFS = HasFS m h
hasFS :: HasFS m h, Tracer m (TraceEvent blk)
CodecConfig blk
StrictSVar m (InternalState m blk h)
ChunkInfo
CacheConfig
blk -> Bool
varInternalState :: ()
checkIntegrity :: forall (m :: * -> *) blk. ImmutableDBEnv m blk -> blk -> Bool
chunkInfo :: forall (m :: * -> *) blk. ImmutableDBEnv m blk -> ChunkInfo
tracer :: forall (m :: * -> *) blk.
ImmutableDBEnv m blk -> Tracer m (TraceEvent blk)
cacheConfig :: forall (m :: * -> *) blk. ImmutableDBEnv m blk -> CacheConfig
codecConfig :: forall (m :: * -> *) blk. ImmutableDBEnv m blk -> CodecConfig blk
varInternalState :: StrictSVar m (InternalState m blk h)
checkIntegrity :: blk -> Bool
chunkInfo :: ChunkInfo
tracer :: Tracer m (TraceEvent blk)
cacheConfig :: CacheConfig
codecConfig :: CodecConfig blk
.. } forall h. Eq h => HasFS m h -> ModifyOpenState m blk h a
modSt =
    Proxy blk -> m a -> m a
forall blk (m :: * -> *) a.
(MonadCatch m, StandardHash blk, Typeable blk) =>
Proxy blk -> m a -> m a
wrapFsError (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk) (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ m (OpenState m blk h)
-> (OpenState m blk h -> ExitCase (OpenState m blk h) -> m ())
-> StateT
     (OpenState m blk h) (WithTempRegistry (OpenState m blk h) m) a
-> m a
forall (m :: * -> *) st a.
(MonadSTM m, MonadMask m, MonadThread m) =>
m st
-> (st -> ExitCase st -> m ())
-> StateT st (WithTempRegistry st m) a
-> m a
modifyWithTempRegistry m (OpenState m blk h)
getSt OpenState m blk h -> ExitCase (OpenState m blk h) -> m ()
putSt (HasFS m h
-> StateT
     (OpenState m blk h) (WithTempRegistry (OpenState m blk h) m) a
forall h. Eq h => HasFS m h -> ModifyOpenState m blk h a
modSt HasFS m h
hasFS)
  where
    getSt :: m (OpenState m blk h)
    getSt :: m (OpenState m blk h)
getSt = m (OpenState m blk h) -> m (OpenState m blk h)
forall a. m a -> m a
forall (m :: * -> *) a. MonadMask m => m a -> m a
mask_ (m (OpenState m blk h) -> m (OpenState m blk h))
-> m (OpenState m blk h) -> m (OpenState m blk h)
forall a b. (a -> b) -> a -> b
$ StrictSVar m (InternalState m blk h) -> m (InternalState m blk h)
forall (m :: * -> *) a. MonadSTM m => StrictSVar m a -> m a
takeSVar StrictSVar m (InternalState m blk h)
varInternalState m (InternalState m blk h)
-> (InternalState m blk h -> m (OpenState m blk h))
-> m (OpenState m blk h)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      DbOpen OpenState m blk h
ost -> OpenState m blk h -> m (OpenState m blk h)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return OpenState m blk h
ost
      InternalState m blk h
DbClosed   -> do
        StrictSVar m (InternalState m blk h)
-> InternalState m blk h -> m ()
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
StrictSVar m a -> a -> m ()
putSVar StrictSVar m (InternalState m blk h)
varInternalState InternalState m blk h
forall (m :: * -> *) blk h. InternalState m blk h
DbClosed
        ApiMisuse blk -> m (OpenState m blk h)
forall (m :: * -> *) blk a.
(MonadThrow m, HasCallStack, StandardHash blk, Typeable blk) =>
ApiMisuse blk -> m a
throwApiMisuse (ApiMisuse blk -> m (OpenState m blk h))
-> ApiMisuse blk -> m (OpenState m blk h)
forall a b. (a -> b) -> a -> b
$ forall blk. ApiMisuse blk
ClosedDBError @blk

    putSt :: OpenState m blk h -> ExitCase (OpenState m blk h) -> m ()
    putSt :: OpenState m blk h -> ExitCase (OpenState m blk h) -> m ()
putSt OpenState m blk h
ost ExitCase (OpenState m blk h)
ec = do
        -- It is crucial to replace the SVar.
        StrictSVar m (InternalState m blk h)
-> InternalState m blk h -> m ()
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
StrictSVar m a -> a -> m ()
putSVar StrictSVar m (InternalState m blk h)
varInternalState InternalState m blk h
st'
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (InternalState m blk h -> Bool
forall (m :: * -> *) blk h. InternalState m blk h -> Bool
dbIsOpen InternalState m blk h
st') (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ HasFS m h -> OpenState m blk h -> m ()
forall (m :: * -> *) h blk.
Monad m =>
HasFS m h -> OpenState m blk h -> m ()
cleanUp HasFS m h
hasFS OpenState m blk h
ost
      where
        st' :: InternalState m blk h
st' = case ExitCase (OpenState m blk h)
ec of
          ExitCaseSuccess OpenState m blk h
ost'  -> OpenState m blk h -> InternalState m blk h
forall (m :: * -> *) blk h.
OpenState m blk h -> InternalState m blk h
DbOpen OpenState m blk h
ost'

          -- When something goes wrong, close the ImmutableDB for safety.
          -- Except for user errors, because they stem from incorrect use of
          -- the ImmutableDB.
          --
          -- NOTE: we only modify the ImmutableDB in a background thread of
          -- the ChainDB, not in per-connection threads that could be killed
          -- at any point. When an exception is encountered while modifying
          -- the ImmutableDB in the background thread, or that background
          -- thread itself is killed with an async exception, we will shut
          -- down the node anway, so it is safe to close the ImmutableDB here.
          ExitCase (OpenState m blk h)
ExitCaseAbort         -> InternalState m blk h
forall (m :: * -> *) blk h. InternalState m blk h
DbClosed
          ExitCaseException SomeException
ex
            | Just (ApiMisuse {} :: ImmutableDBError blk) <- SomeException -> Maybe (ImmutableDBError blk)
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
ex
            -> OpenState m blk h -> InternalState m blk h
forall (m :: * -> *) blk h.
OpenState m blk h -> InternalState m blk h
DbOpen OpenState m blk h
ost
            | Bool
otherwise
            -> InternalState m blk h
forall (m :: * -> *) blk h. InternalState m blk h
DbClosed

-- | Perform an action that accesses the internal state of an open database.
--
-- In case the database is closed, a 'ClosedDBError' is thrown.
--
-- In case an 'UnexpectedFailure' is thrown while the action is being run, the
-- database is closed to prevent further appending to a database in a
-- potentially inconsistent state.
withOpenState ::
     forall m blk r. (HasCallStack, IOLike m, StandardHash blk, Typeable blk)
  => ImmutableDBEnv m blk
  -> (forall h. HasFS m h -> OpenState m blk h -> m r)
  -> m r
withOpenState :: forall (m :: * -> *) blk r.
(HasCallStack, IOLike m, StandardHash blk, Typeable blk) =>
ImmutableDBEnv m blk
-> (forall h. HasFS m h -> OpenState m blk h -> m r) -> m r
withOpenState ImmutableDBEnv { hasFS :: ()
hasFS = HasFS m h
hasFS :: HasFS m h, Tracer m (TraceEvent blk)
CodecConfig blk
StrictSVar m (InternalState m blk h)
ChunkInfo
CacheConfig
blk -> Bool
varInternalState :: ()
checkIntegrity :: forall (m :: * -> *) blk. ImmutableDBEnv m blk -> blk -> Bool
chunkInfo :: forall (m :: * -> *) blk. ImmutableDBEnv m blk -> ChunkInfo
tracer :: forall (m :: * -> *) blk.
ImmutableDBEnv m blk -> Tracer m (TraceEvent blk)
cacheConfig :: forall (m :: * -> *) blk. ImmutableDBEnv m blk -> CacheConfig
codecConfig :: forall (m :: * -> *) blk. ImmutableDBEnv m blk -> CodecConfig blk
varInternalState :: StrictSVar m (InternalState m blk h)
checkIntegrity :: blk -> Bool
chunkInfo :: ChunkInfo
tracer :: Tracer m (TraceEvent blk)
cacheConfig :: CacheConfig
codecConfig :: CodecConfig blk
.. } forall h. HasFS m h -> OpenState m blk h -> m r
action = do
    (Either (ImmutableDBError blk) r
mr, ()) <-
      m (OpenState m blk h)
-> (OpenState m blk h
    -> ExitCase (Either (ImmutableDBError blk) r) -> m ())
-> (OpenState m blk h -> m (Either (ImmutableDBError blk) r))
-> m (Either (ImmutableDBError blk) r, ())
forall a b c.
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
forall (m :: * -> *) a b c.
MonadCatch m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalBracket m (OpenState m blk h)
open ((ExitCase (Either (ImmutableDBError blk) r) -> m ())
-> OpenState m blk h
-> ExitCase (Either (ImmutableDBError blk) r)
-> m ()
forall a b. a -> b -> a
const ExitCase (Either (ImmutableDBError blk) r) -> m ()
close) (Proxy blk -> m r -> m (Either (ImmutableDBError blk) r)
forall (m :: * -> *) blk a.
(MonadCatch m, StandardHash blk, Typeable blk) =>
Proxy blk -> m a -> m (Either (ImmutableDBError blk) a)
tryImmutableDB (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk) (m r -> m (Either (ImmutableDBError blk) r))
-> (OpenState m blk h -> m r)
-> OpenState m blk h
-> m (Either (ImmutableDBError blk) r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpenState m blk h -> m r
access)
    case Either (ImmutableDBError blk) r
mr of
      Left  ImmutableDBError blk
e -> ImmutableDBError blk -> m r
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO ImmutableDBError blk
e
      Right r
r -> r -> m r
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return r
r
  where
    -- We use 'readSVarSTM' to read a potentially stale internal state if
    -- somebody's appending to the ImmutableDB at the same time. Reads can
    -- safely happen concurrently with appends, so this is fine and allows for
    -- some extra concurrency.
    open :: m (OpenState m blk h)
    open :: m (OpenState m blk h)
open = STM m (InternalState m blk h) -> m (InternalState m blk h)
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (StrictSVar m (InternalState m blk h)
-> STM m (InternalState m blk h)
forall (m :: * -> *) a. MonadSTM m => StrictSVar m a -> STM m a
readSVarSTM StrictSVar m (InternalState m blk h)
varInternalState) m (InternalState m blk h)
-> (InternalState m blk h -> m (OpenState m blk h))
-> m (OpenState m blk h)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      DbOpen OpenState m blk h
ost -> OpenState m blk h -> m (OpenState m blk h)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return OpenState m blk h
ost
      InternalState m blk h
DbClosed   -> ApiMisuse blk -> m (OpenState m blk h)
forall (m :: * -> *) blk a.
(MonadThrow m, HasCallStack, StandardHash blk, Typeable blk) =>
ApiMisuse blk -> m a
throwApiMisuse (ApiMisuse blk -> m (OpenState m blk h))
-> ApiMisuse blk -> m (OpenState m blk h)
forall a b. (a -> b) -> a -> b
$ forall blk. ApiMisuse blk
ClosedDBError @blk

    -- close doesn't take the state that @open@ returned, because the state
    -- may have been updated by someone else since we got it (remember we're
    -- using 'readSVarSTM' here, not 'takeSVar'). So we need to get the most
    -- recent state anyway.
    close :: ExitCase (Either (ImmutableDBError blk) r)
          -> m ()
    close :: ExitCase (Either (ImmutableDBError blk) r) -> m ()
close ExitCase (Either (ImmutableDBError blk) r)
ec = case ExitCase (Either (ImmutableDBError blk) r)
ec of
      ExitCase (Either (ImmutableDBError blk) r)
ExitCaseAbort                                 -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      ExitCaseException SomeException
_ex                         -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      ExitCaseSuccess (Right r
_)                     -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      -- In case of an ImmutableDBError, close when unexpected
      ExitCaseSuccess (Left (UnexpectedFailure {})) -> m ()
shutDown
      ExitCaseSuccess (Left (ApiMisuse {}))         -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    shutDown :: m ()
    shutDown :: m ()
shutDown = StrictSVar m (InternalState m blk h)
-> InternalState m blk h -> m (InternalState m blk h)
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
StrictSVar m a -> a -> m a
swapSVar StrictSVar m (InternalState m blk h)
varInternalState InternalState m blk h
forall (m :: * -> *) blk h. InternalState m blk h
DbClosed m (InternalState m blk h)
-> (InternalState m blk h -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      DbOpen OpenState m blk h
ost -> Proxy blk -> m () -> m ()
forall blk (m :: * -> *) a.
(MonadCatch m, StandardHash blk, Typeable blk) =>
Proxy blk -> m a -> m a
wrapFsError (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ HasFS m h -> OpenState m blk h -> m ()
forall (m :: * -> *) h blk.
Monad m =>
HasFS m h -> OpenState m blk h -> m ()
cleanUp HasFS m h
hasFS OpenState m blk h
ost
      InternalState m blk h
DbClosed   -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    access :: OpenState m blk h -> m r
    access :: OpenState m blk h -> m r
access = HasFS m h -> OpenState m blk h -> m r
forall h. HasFS m h -> OpenState m blk h -> m r
action HasFS m h
hasFS

-- | Close the handles in the 'OpenState'.
--
-- Idempotent, as closing a handle is idempotent.
closeOpenHandles :: Monad m => HasFS m h -> OpenState m blk h -> m ()
closeOpenHandles :: forall (m :: * -> *) h blk.
Monad m =>
HasFS m h -> OpenState m blk h -> m ()
closeOpenHandles HasFS { HasCallStack => Handle h -> m ()
hClose :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> m ()
hClose :: HasCallStack => Handle h -> m ()
hClose } OpenState {SecondaryOffset
WithOrigin (Tip blk)
Handle h
ChunkNo
BlockOffset
Index m blk h
currentChunk :: forall (m :: * -> *) blk h. OpenState m blk h -> ChunkNo
currentChunkOffset :: forall (m :: * -> *) blk h. OpenState m blk h -> BlockOffset
currentSecondaryOffset :: forall (m :: * -> *) blk h. OpenState m blk h -> SecondaryOffset
currentChunkHandle :: forall (m :: * -> *) blk h. OpenState m blk h -> Handle h
currentPrimaryHandle :: forall (m :: * -> *) blk h. OpenState m blk h -> Handle h
currentSecondaryHandle :: forall (m :: * -> *) blk h. OpenState m blk h -> Handle h
currentTip :: forall (m :: * -> *) blk h.
OpenState m blk h -> WithOrigin (Tip blk)
currentIndex :: forall (m :: * -> *) blk h. OpenState m blk h -> Index m blk h
currentChunk :: ChunkNo
currentChunkOffset :: BlockOffset
currentSecondaryOffset :: SecondaryOffset
currentChunkHandle :: Handle h
currentPrimaryHandle :: Handle h
currentSecondaryHandle :: Handle h
currentTip :: WithOrigin (Tip blk)
currentIndex :: Index m blk h
..}  = do
    HasCallStack => Handle h -> m ()
Handle h -> m ()
hClose Handle h
currentChunkHandle
    HasCallStack => Handle h -> m ()
Handle h -> m ()
hClose Handle h
currentPrimaryHandle
    HasCallStack => Handle h -> m ()
Handle h -> m ()
hClose Handle h
currentSecondaryHandle

-- | Clean up the 'OpenState': 'closeOpenHandles' + close the index (i.e.,
-- shut down its background thread)
cleanUp :: Monad m => HasFS m h -> OpenState m blk h -> m ()
cleanUp :: forall (m :: * -> *) h blk.
Monad m =>
HasFS m h -> OpenState m blk h -> m ()
cleanUp HasFS m h
hasFS ost :: OpenState m blk h
ost@OpenState {SecondaryOffset
WithOrigin (Tip blk)
Handle h
ChunkNo
BlockOffset
Index m blk h
currentChunk :: forall (m :: * -> *) blk h. OpenState m blk h -> ChunkNo
currentChunkOffset :: forall (m :: * -> *) blk h. OpenState m blk h -> BlockOffset
currentSecondaryOffset :: forall (m :: * -> *) blk h. OpenState m blk h -> SecondaryOffset
currentChunkHandle :: forall (m :: * -> *) blk h. OpenState m blk h -> Handle h
currentPrimaryHandle :: forall (m :: * -> *) blk h. OpenState m blk h -> Handle h
currentSecondaryHandle :: forall (m :: * -> *) blk h. OpenState m blk h -> Handle h
currentTip :: forall (m :: * -> *) blk h.
OpenState m blk h -> WithOrigin (Tip blk)
currentIndex :: forall (m :: * -> *) blk h. OpenState m blk h -> Index m blk h
currentChunk :: ChunkNo
currentChunkOffset :: BlockOffset
currentSecondaryOffset :: SecondaryOffset
currentChunkHandle :: Handle h
currentPrimaryHandle :: Handle h
currentSecondaryHandle :: Handle h
currentTip :: WithOrigin (Tip blk)
currentIndex :: Index m blk h
..}  = do
    Index m blk h -> HasCallStack => m ()
forall (m :: * -> *) blk h. Index m blk h -> HasCallStack => m ()
Index.close Index m blk h
currentIndex
    HasFS m h -> OpenState m blk h -> m ()
forall (m :: * -> *) h blk.
Monad m =>
HasFS m h -> OpenState m blk h -> m ()
closeOpenHandles HasFS m h
hasFS OpenState m blk h
ost