{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE DerivingVia         #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | An abstract view over the filesystem.
module Ouroboros.Consensus.Storage.FS.API (
    Handle (..)
  , HasFS (..)
  , SomeHasFS (..)
  , hClose'
  , hGetAll
  , hGetAllAt
  , hGetExactly
  , hGetExactlyAt
  , hPut
  , hPutAll
  , hPutAllStrict
  , withFile
  ) where

import           Control.Monad (foldM)
import qualified Data.ByteString as BS
import           Data.ByteString.Builder (Builder)
import qualified Data.ByteString.Builder as BS
import qualified Data.ByteString.Lazy as BL
import           Data.Int (Int64)
import           Data.Set (Set)
import           Data.Word
import           NoThunks.Class (NoThunks, OnlyCheckWhnfNamed (..))

import           Control.Monad.Class.MonadThrow

import           Ouroboros.Consensus.Storage.FS.API.Types
import           Ouroboros.Consensus.Util.CallStack

{------------------------------------------------------------------------------
 Typeclass which abstracts over the filesystem
------------------------------------------------------------------------------}

data HasFS m h = HasFS {
    -- | Debugging: human-readable description of file system state
    HasFS m h -> m String
dumpState                :: m String

    -- Operations of files

    -- | Open a file
  , HasFS m h -> HasCallStack => FsPath -> OpenMode -> m (Handle h)
hOpen                    :: HasCallStack => FsPath -> OpenMode -> m (Handle h)

    -- | Close a file
  , HasFS m h -> HasCallStack => Handle h -> m ()
hClose                   :: HasCallStack => Handle h -> m ()

    -- | Is the handle open?
  , HasFS m h -> HasCallStack => Handle h -> m Bool
hIsOpen                  :: HasCallStack => Handle h -> m Bool

    -- | Seek handle
    --
    -- The offset is an 'Int64' rather than a 'Word64' because it may be
    -- negative (for use in relative positioning).
    --
    -- Unlike the Posix @lseek@, 'hSeek' does not return the new seek position
    -- because the value returned by Posix is rather strange and unreliable
    -- and we don't want to emulate it's behaviour.
  , HasFS m h -> HasCallStack => Handle h -> SeekMode -> Int64 -> m ()
hSeek                    :: HasCallStack => Handle h -> SeekMode -> Int64 -> m ()

    -- | Try to read @n@ bytes from a handle
    --
    -- When at the end of the file, an empty bytestring will be returned.
    --
    -- The returned bytestring will typically have length @n@, but may be
    -- shorter in case of a partial read, see #277. However, a partial read
    -- will always return at least 1 byte, as returning 0 bytes would mean
    -- that we have reached EOF.
    --
    -- Postcondition: the length of the returned bytestring <= @n@ and >= 0.
  , HasFS m h -> HasCallStack => Handle h -> Word64 -> m ByteString
hGetSome                 :: HasCallStack => Handle h -> Word64 -> m BS.ByteString

    -- | Same as 'hGetSome', but does not affect the file offset. An additional argument
    -- is used to specify the offset. This allows it to be called concurrently for the
    -- same file handle. However, the actual level of parallelism achieved depends on
    -- the implementation and the operating system: generally on Unix it will be
    -- \"more parallel\" than on Windows.
  , HasFS m h
-> HasCallStack => Handle h -> Word64 -> AbsOffset -> m ByteString
hGetSomeAt               :: HasCallStack
                             => Handle h
                             -> Word64    -- The number of bytes to read.
                             -> AbsOffset -- The offset at which to read.
                             -> m BS.ByteString

    -- | Write to a handle
    --
    -- The return value indicates the number of bytes written and will
    -- typically be equal to @l@, the length of the bytestring, but may be
    -- shorter in case of a partial write, see #277.
    --
    -- If nothing can be written at all, an exception will be thrown.
    --
    -- Postcondition: the return value <= @l@ and > 0, unless the given
    -- bytestring is empty, in which case the return value can be 0.
  , HasFS m h -> HasCallStack => Handle h -> ByteString -> m Word64
hPutSome                 :: HasCallStack => Handle h -> BS.ByteString -> m Word64

    -- | Truncate the file to the specified size
    --
    -- NOTE: Only supported in append mode.
  , HasFS m h -> HasCallStack => Handle h -> Word64 -> m ()
hTruncate                :: HasCallStack => Handle h -> Word64 -> m ()

    -- | Return current file size
    --
    -- NOTE: This is not thread safe (changes made to the file in other threads
    -- may affect this thread).
  , HasFS m h -> HasCallStack => Handle h -> m Word64
hGetSize                 :: HasCallStack => Handle h -> m Word64

    -- Operations of directories

    -- | Create new directory
  , HasFS m h -> HasCallStack => FsPath -> m ()
createDirectory          :: HasCallStack => FsPath -> m ()

    -- | Create new directory if it doesn't exist.
    --
    -- @createDirectoryIfMissing True@ will also try to create all parent dirs.
  , HasFS m h -> HasCallStack => Bool -> FsPath -> m ()
createDirectoryIfMissing :: HasCallStack => Bool -> FsPath -> m ()

    -- | List contents of a directory
  , HasFS m h -> HasCallStack => FsPath -> m (Set String)
listDirectory            :: HasCallStack => FsPath -> m (Set String)

    -- | Check if the path exists and is a directory
  , HasFS m h -> HasCallStack => FsPath -> m Bool
doesDirectoryExist       :: HasCallStack => FsPath -> m Bool

    -- | Check if the path exists and is a file
  , HasFS m h -> HasCallStack => FsPath -> m Bool
doesFileExist            :: HasCallStack => FsPath -> m Bool

    -- | Remove the file (which must exist)
  , HasFS m h -> HasCallStack => FsPath -> m ()
removeFile               :: HasCallStack => FsPath -> m ()

    -- | Rename the file (which must exist) from the first path to the second
    -- path. If there is already a file at the latter path, it is replaced by
    -- the new one.
    --
    -- NOTE: only works for files within the same folder.
  , HasFS m h -> HasCallStack => FsPath -> FsPath -> m ()
renameFile                 :: HasCallStack => FsPath -> FsPath -> m ()

    -- | Useful for better error reporting
  , HasFS m h -> FsPath -> FsErrorPath
mkFsErrorPath            :: FsPath -> FsErrorPath
  }
  deriving Context -> HasFS m h -> IO (Maybe ThunkInfo)
Proxy (HasFS m h) -> String
(Context -> HasFS m h -> IO (Maybe ThunkInfo))
-> (Context -> HasFS m h -> IO (Maybe ThunkInfo))
-> (Proxy (HasFS m h) -> String)
-> NoThunks (HasFS m h)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall (m :: * -> *) h.
Context -> HasFS m h -> IO (Maybe ThunkInfo)
forall (m :: * -> *) h. Proxy (HasFS m h) -> String
showTypeOf :: Proxy (HasFS m h) -> String
$cshowTypeOf :: forall (m :: * -> *) h. Proxy (HasFS m h) -> String
wNoThunks :: Context -> HasFS m h -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (m :: * -> *) h.
Context -> HasFS m h -> IO (Maybe ThunkInfo)
noThunks :: Context -> HasFS m h -> IO (Maybe ThunkInfo)
$cnoThunks :: forall (m :: * -> *) h.
Context -> HasFS m h -> IO (Maybe ThunkInfo)
NoThunks via OnlyCheckWhnfNamed "HasFS" (HasFS m h)

withFile :: (HasCallStack, MonadThrow m)
         => HasFS m h -> FsPath -> OpenMode -> (Handle h -> m a) -> m a
withFile :: HasFS m h -> FsPath -> OpenMode -> (Handle h -> m a) -> m a
withFile 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 => FsPath -> m Bool
HasCallStack => FsPath -> m ()
HasCallStack => FsPath -> m (Set String)
HasCallStack => FsPath -> FsPath -> m ()
HasCallStack => FsPath -> OpenMode -> m (Handle h)
FsPath -> FsErrorPath
mkFsErrorPath :: FsPath -> FsErrorPath
renameFile :: HasCallStack => FsPath -> FsPath -> m ()
removeFile :: HasCallStack => FsPath -> m ()
doesFileExist :: HasCallStack => FsPath -> m Bool
doesDirectoryExist :: HasCallStack => FsPath -> m Bool
listDirectory :: HasCallStack => FsPath -> m (Set String)
createDirectoryIfMissing :: HasCallStack => Bool -> FsPath -> m ()
createDirectory :: HasCallStack => FsPath -> m ()
hGetSize :: HasCallStack => Handle h -> m Word64
hTruncate :: HasCallStack => Handle h -> Word64 -> m ()
hPutSome :: HasCallStack => Handle h -> ByteString -> m Word64
hGetSomeAt :: HasCallStack => Handle h -> Word64 -> AbsOffset -> m ByteString
hGetSome :: HasCallStack => Handle h -> Word64 -> m ByteString
hSeek :: HasCallStack => Handle h -> SeekMode -> Int64 -> m ()
hIsOpen :: HasCallStack => Handle h -> m Bool
hClose :: HasCallStack => Handle h -> m ()
hOpen :: HasCallStack => FsPath -> OpenMode -> m (Handle h)
dumpState :: m String
mkFsErrorPath :: forall (m :: * -> *) h. HasFS m h -> FsPath -> FsErrorPath
renameFile :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> FsPath -> m ()
removeFile :: forall (m :: * -> *) h. HasFS m h -> HasCallStack => FsPath -> m ()
doesFileExist :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> m Bool
doesDirectoryExist :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> m Bool
listDirectory :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> m (Set String)
createDirectoryIfMissing :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Bool -> FsPath -> m ()
createDirectory :: forall (m :: * -> *) h. HasFS m h -> HasCallStack => FsPath -> m ()
hGetSize :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> m Word64
hTruncate :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> Word64 -> m ()
hPutSome :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> ByteString -> m Word64
hGetSomeAt :: forall (m :: * -> *) h.
HasFS m h
-> HasCallStack => Handle h -> Word64 -> AbsOffset -> m ByteString
hGetSome :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> Word64 -> m ByteString
hSeek :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> SeekMode -> Int64 -> m ()
hIsOpen :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> m Bool
hClose :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> m ()
hOpen :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> OpenMode -> m (Handle h)
dumpState :: forall (m :: * -> *) h. HasFS m h -> m String
..} FsPath
fp OpenMode
openMode = m (Handle h) -> (Handle h -> m ()) -> (Handle h -> m a) -> m a
forall (m :: * -> *) a b c.
MonadThrow m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (HasCallStack => FsPath -> OpenMode -> m (Handle h)
FsPath -> OpenMode -> m (Handle h)
hOpen FsPath
fp OpenMode
openMode) HasCallStack => Handle h -> m ()
Handle h -> m ()
hClose

-- | Returns 'True' when the handle was still open.
hClose' :: (HasCallStack, Monad m) => HasFS m h -> Handle h -> m Bool
hClose' :: HasFS m h -> Handle h -> m Bool
hClose' HasFS { HasCallStack => Handle h -> m ()
hClose :: HasCallStack => Handle h -> m ()
hClose :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> m ()
hClose, HasCallStack => Handle h -> m Bool
hIsOpen :: HasCallStack => Handle h -> m Bool
hIsOpen :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> m Bool
hIsOpen } Handle h
h = do
    Bool
isOpen <- HasCallStack => Handle h -> m Bool
Handle h -> m Bool
hIsOpen Handle h
h
    if Bool
isOpen then do
      HasCallStack => Handle h -> m ()
Handle h -> m ()
hClose Handle h
h
      Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    else
      Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

-- | Makes sure it reads all requested bytes.
-- If eof is found before all bytes are read, it throws an exception.
hGetExactly :: forall m h. (HasCallStack, MonadThrow m)
            => HasFS m h
            -> Handle h
            -> Word64
            -> m BL.ByteString
hGetExactly :: HasFS m h -> Handle h -> Word64 -> m ByteString
hGetExactly HasFS m h
hasFS Handle h
h Word64
n = Word64 -> [ByteString] -> m ByteString
go Word64
n []
  where
    go :: Word64 -> [BS.ByteString] -> m BL.ByteString
    go :: Word64 -> [ByteString] -> m ByteString
go Word64
remainingBytes [ByteString]
acc
      | Word64
remainingBytes Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 = ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BL.fromChunks ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse [ByteString]
acc
      | Bool
otherwise           = do
        ByteString
bs <- HasFS m h -> Handle h -> Word64 -> m ByteString
forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> Word64 -> m ByteString
hGetSome HasFS m h
hasFS Handle h
h Word64
remainingBytes
        if ByteString -> Bool
BS.null ByteString
bs then
          FsError -> m ByteString
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO FsError :: FsErrorType
-> FsErrorPath
-> String
-> Maybe Errno
-> PrettyCallStack
-> Bool
-> FsError
FsError {
              fsErrorType :: FsErrorType
fsErrorType   = FsErrorType
FsReachedEOF
            , fsErrorPath :: FsErrorPath
fsErrorPath   = HasFS m h -> FsPath -> FsErrorPath
forall (m :: * -> *) h. HasFS m h -> FsPath -> FsErrorPath
mkFsErrorPath HasFS m h
hasFS (FsPath -> FsErrorPath) -> FsPath -> FsErrorPath
forall a b. (a -> b) -> a -> b
$ Handle h -> FsPath
forall h. Handle h -> FsPath
handlePath Handle h
h
            , fsErrorString :: String
fsErrorString = String
"hGetExactly found eof before reading " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. Show a => a -> String
show Word64
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" bytes"
            , fsErrorNo :: Maybe Errno
fsErrorNo     = Maybe Errno
forall a. Maybe a
Nothing
            , fsErrorStack :: PrettyCallStack
fsErrorStack  = PrettyCallStack
HasCallStack => PrettyCallStack
prettyCallStack
            , fsLimitation :: Bool
fsLimitation  = Bool
False
            }
        -- We know the length <= remainingBytes, so this can't underflow
        else Word64 -> [ByteString] -> m ByteString
go (Word64
remainingBytes Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
bs)) (ByteString
bs ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
acc)

-- | Like 'hGetExactly', but is thread safe since it does not change or depend
-- on the file offset. @pread@ syscall is used internally.
hGetExactlyAt :: forall m h. (HasCallStack, MonadThrow m)
              => HasFS m h
              -> Handle h
              -> Word64    -- ^ The number of bytes to read.
              -> AbsOffset -- ^ The offset at which to read.
              -> m BL.ByteString
hGetExactlyAt :: HasFS m h -> Handle h -> Word64 -> AbsOffset -> m ByteString
hGetExactlyAt HasFS m h
hasFS Handle h
h Word64
n AbsOffset
offset = Word64 -> AbsOffset -> [ByteString] -> m ByteString
go Word64
n AbsOffset
offset []
  where
    go :: Word64 -> AbsOffset -> [BS.ByteString] -> m BL.ByteString
    go :: Word64 -> AbsOffset -> [ByteString] -> m ByteString
go Word64
remainingBytes AbsOffset
currentOffset [ByteString]
acc
      | Word64
remainingBytes Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 = ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BL.fromChunks ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse [ByteString]
acc
      | Bool
otherwise           = do
        ByteString
bs <- HasFS m h -> Handle h -> Word64 -> AbsOffset -> m ByteString
forall (m :: * -> *) h.
HasFS m h
-> HasCallStack => Handle h -> Word64 -> AbsOffset -> m ByteString
hGetSomeAt HasFS m h
hasFS Handle h
h Word64
remainingBytes AbsOffset
currentOffset
        let readBytes :: Int
readBytes = ByteString -> Int
BS.length ByteString
bs
        if ByteString -> Bool
BS.null ByteString
bs then
          FsError -> m ByteString
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO FsError :: FsErrorType
-> FsErrorPath
-> String
-> Maybe Errno
-> PrettyCallStack
-> Bool
-> FsError
FsError {
              fsErrorType :: FsErrorType
fsErrorType   = FsErrorType
FsReachedEOF
            , fsErrorPath :: FsErrorPath
fsErrorPath   = HasFS m h -> FsPath -> FsErrorPath
forall (m :: * -> *) h. HasFS m h -> FsPath -> FsErrorPath
mkFsErrorPath HasFS m h
hasFS (FsPath -> FsErrorPath) -> FsPath -> FsErrorPath
forall a b. (a -> b) -> a -> b
$ Handle h -> FsPath
forall h. Handle h -> FsPath
handlePath Handle h
h
            , fsErrorString :: String
fsErrorString = String
"hGetExactlyAt found eof before reading " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. Show a => a -> String
show Word64
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" bytes"
            , fsErrorNo :: Maybe Errno
fsErrorNo     = Maybe Errno
forall a. Maybe a
Nothing
            , fsErrorStack :: PrettyCallStack
fsErrorStack  = PrettyCallStack
HasCallStack => PrettyCallStack
prettyCallStack
            , fsLimitation :: Bool
fsLimitation  = Bool
False
            }
        -- We know the length <= remainingBytes, so this can't underflow.
        else Word64 -> AbsOffset -> [ByteString] -> m ByteString
go (Word64
remainingBytes Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
readBytes)
                (AbsOffset
currentOffset AbsOffset -> AbsOffset -> AbsOffset
forall a. Num a => a -> a -> a
+ Int -> AbsOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
readBytes)
                (ByteString
bs ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
acc)

-- | Read all the data from the given file handle 64kB at a time.
--
-- Stops when EOF is reached.
hGetAll :: Monad m => HasFS m h -> Handle h -> m BL.ByteString
hGetAll :: HasFS m h -> Handle h -> m ByteString
hGetAll 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 => FsPath -> m Bool
HasCallStack => FsPath -> m ()
HasCallStack => FsPath -> m (Set String)
HasCallStack => FsPath -> FsPath -> m ()
HasCallStack => FsPath -> OpenMode -> m (Handle h)
FsPath -> FsErrorPath
mkFsErrorPath :: FsPath -> FsErrorPath
renameFile :: HasCallStack => FsPath -> FsPath -> m ()
removeFile :: HasCallStack => FsPath -> m ()
doesFileExist :: HasCallStack => FsPath -> m Bool
doesDirectoryExist :: HasCallStack => FsPath -> m Bool
listDirectory :: HasCallStack => FsPath -> m (Set String)
createDirectoryIfMissing :: HasCallStack => Bool -> FsPath -> m ()
createDirectory :: HasCallStack => FsPath -> m ()
hGetSize :: HasCallStack => Handle h -> m Word64
hTruncate :: HasCallStack => Handle h -> Word64 -> m ()
hPutSome :: HasCallStack => Handle h -> ByteString -> m Word64
hGetSomeAt :: HasCallStack => Handle h -> Word64 -> AbsOffset -> m ByteString
hGetSome :: HasCallStack => Handle h -> Word64 -> m ByteString
hSeek :: HasCallStack => Handle h -> SeekMode -> Int64 -> m ()
hIsOpen :: HasCallStack => Handle h -> m Bool
hClose :: HasCallStack => Handle h -> m ()
hOpen :: HasCallStack => FsPath -> OpenMode -> m (Handle h)
dumpState :: m String
mkFsErrorPath :: forall (m :: * -> *) h. HasFS m h -> FsPath -> FsErrorPath
renameFile :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> FsPath -> m ()
removeFile :: forall (m :: * -> *) h. HasFS m h -> HasCallStack => FsPath -> m ()
doesFileExist :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> m Bool
doesDirectoryExist :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> m Bool
listDirectory :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> m (Set String)
createDirectoryIfMissing :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Bool -> FsPath -> m ()
createDirectory :: forall (m :: * -> *) h. HasFS m h -> HasCallStack => FsPath -> m ()
hGetSize :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> m Word64
hTruncate :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> Word64 -> m ()
hPutSome :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> ByteString -> m Word64
hGetSomeAt :: forall (m :: * -> *) h.
HasFS m h
-> HasCallStack => Handle h -> Word64 -> AbsOffset -> m ByteString
hGetSome :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> Word64 -> m ByteString
hSeek :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> SeekMode -> Int64 -> m ()
hIsOpen :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> m Bool
hClose :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> m ()
hOpen :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> OpenMode -> m (Handle h)
dumpState :: forall (m :: * -> *) h. HasFS m h -> m String
..} Handle h
hnd = [ByteString] -> m ByteString
go [ByteString]
forall a. Monoid a => a
mempty
  where
    bufferSize :: Word64
bufferSize = Word64
64 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
1024
    go :: [ByteString] -> m ByteString
go [ByteString]
acc = do
      ByteString
chunk <- HasCallStack => Handle h -> Word64 -> m ByteString
Handle h -> Word64 -> m ByteString
hGetSome Handle h
hnd Word64
bufferSize
      let acc' :: [ByteString]
acc' = ByteString
chunk ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
acc
      if ByteString -> Bool
BS.null ByteString
chunk
        then ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BL.fromChunks ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse [ByteString]
acc'
        else [ByteString] -> m ByteString
go [ByteString]
acc'

-- | Like 'hGetAll', but is thread safe since it does not change or depend
-- on the file offset. @pread@ syscall is used internally.
hGetAllAt :: Monad m
          => HasFS m h
          -> Handle h
          -> AbsOffset -- ^ The offset at which to read.
          -> m BL.ByteString
hGetAllAt :: HasFS m h -> Handle h -> AbsOffset -> m ByteString
hGetAllAt 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 => FsPath -> m Bool
HasCallStack => FsPath -> m ()
HasCallStack => FsPath -> m (Set String)
HasCallStack => FsPath -> FsPath -> m ()
HasCallStack => FsPath -> OpenMode -> m (Handle h)
FsPath -> FsErrorPath
mkFsErrorPath :: FsPath -> FsErrorPath
renameFile :: HasCallStack => FsPath -> FsPath -> m ()
removeFile :: HasCallStack => FsPath -> m ()
doesFileExist :: HasCallStack => FsPath -> m Bool
doesDirectoryExist :: HasCallStack => FsPath -> m Bool
listDirectory :: HasCallStack => FsPath -> m (Set String)
createDirectoryIfMissing :: HasCallStack => Bool -> FsPath -> m ()
createDirectory :: HasCallStack => FsPath -> m ()
hGetSize :: HasCallStack => Handle h -> m Word64
hTruncate :: HasCallStack => Handle h -> Word64 -> m ()
hPutSome :: HasCallStack => Handle h -> ByteString -> m Word64
hGetSomeAt :: HasCallStack => Handle h -> Word64 -> AbsOffset -> m ByteString
hGetSome :: HasCallStack => Handle h -> Word64 -> m ByteString
hSeek :: HasCallStack => Handle h -> SeekMode -> Int64 -> m ()
hIsOpen :: HasCallStack => Handle h -> m Bool
hClose :: HasCallStack => Handle h -> m ()
hOpen :: HasCallStack => FsPath -> OpenMode -> m (Handle h)
dumpState :: m String
mkFsErrorPath :: forall (m :: * -> *) h. HasFS m h -> FsPath -> FsErrorPath
renameFile :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> FsPath -> m ()
removeFile :: forall (m :: * -> *) h. HasFS m h -> HasCallStack => FsPath -> m ()
doesFileExist :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> m Bool
doesDirectoryExist :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> m Bool
listDirectory :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> m (Set String)
createDirectoryIfMissing :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Bool -> FsPath -> m ()
createDirectory :: forall (m :: * -> *) h. HasFS m h -> HasCallStack => FsPath -> m ()
hGetSize :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> m Word64
hTruncate :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> Word64 -> m ()
hPutSome :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> ByteString -> m Word64
hGetSomeAt :: forall (m :: * -> *) h.
HasFS m h
-> HasCallStack => Handle h -> Word64 -> AbsOffset -> m ByteString
hGetSome :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> Word64 -> m ByteString
hSeek :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> SeekMode -> Int64 -> m ()
hIsOpen :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> m Bool
hClose :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> m ()
hOpen :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> OpenMode -> m (Handle h)
dumpState :: forall (m :: * -> *) h. HasFS m h -> m String
..} Handle h
hnd = [ByteString] -> AbsOffset -> m ByteString
go [ByteString]
forall a. Monoid a => a
mempty
  where
    bufferSize :: Word64
bufferSize = Word64
64 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
1024
    go :: [ByteString] -> AbsOffset -> m ByteString
go [ByteString]
acc AbsOffset
offset = do
      ByteString
chunk <- HasCallStack => Handle h -> Word64 -> AbsOffset -> m ByteString
Handle h -> Word64 -> AbsOffset -> m ByteString
hGetSomeAt Handle h
hnd Word64
bufferSize AbsOffset
offset
      let acc' :: [ByteString]
acc' = ByteString
chunk ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
acc
      if ByteString -> Bool
BS.null ByteString
chunk
        then ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BL.fromChunks ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse [ByteString]
acc'
        else [ByteString] -> AbsOffset -> m ByteString
go [ByteString]
acc' (AbsOffset
offset AbsOffset -> AbsOffset -> AbsOffset
forall a. Num a => a -> a -> a
+ Int -> AbsOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
chunk))

-- | This function makes sure that the whole 'BS.ByteString' is written.
hPutAllStrict :: forall m h
              .  (HasCallStack, Monad m)
              => HasFS m h
              -> Handle h
              -> BS.ByteString
              -> m Word64
hPutAllStrict :: HasFS m h -> Handle h -> ByteString -> m Word64
hPutAllStrict HasFS m h
hasFS Handle h
h = Word64 -> ByteString -> m Word64
go Word64
0
  where
    go :: Word64 -> BS.ByteString -> m Word64
    go :: Word64 -> ByteString -> m Word64
go !Word64
written ByteString
bs = do
      Word64
n <- HasFS m h -> Handle h -> ByteString -> m Word64
forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> ByteString -> m Word64
hPutSome HasFS m h
hasFS Handle h
h ByteString
bs
      let bs' :: ByteString
bs'      = Int -> ByteString -> ByteString
BS.drop (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n) ByteString
bs
          written' :: Word64
written' = Word64
written Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
n
      if ByteString -> Bool
BS.null ByteString
bs'
        then Word64 -> m Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
written'
        else Word64 -> ByteString -> m Word64
go Word64
written' ByteString
bs'

-- | This function makes sure that the whole 'BL.ByteString' is written.
hPutAll :: forall m h
        .  (HasCallStack, Monad m)
        => HasFS m h
        -> Handle h
        -> BL.ByteString
        -> m Word64
hPutAll :: HasFS m h -> Handle h -> ByteString -> m Word64
hPutAll HasFS m h
hasFS Handle h
h = (Word64 -> ByteString -> m Word64)
-> Word64 -> [ByteString] -> m Word64
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Word64 -> ByteString -> m Word64
putChunk Word64
0 ([ByteString] -> m Word64)
-> (ByteString -> [ByteString]) -> ByteString -> m Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BL.toChunks
  where
    putChunk :: Word64 -> BS.ByteString -> m Word64
    putChunk :: Word64 -> ByteString -> m Word64
putChunk Word64
written ByteString
chunk = do
      Word64
written' <- HasFS m h -> Handle h -> ByteString -> m Word64
forall (m :: * -> *) h.
(HasCallStack, Monad m) =>
HasFS m h -> Handle h -> ByteString -> m Word64
hPutAllStrict HasFS m h
hasFS Handle h
h ByteString
chunk
      Word64 -> m Word64
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> m Word64) -> Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$! Word64
written Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
written'

-- | This function makes sure that the whole 'Builder' is written.
--
-- The chunk size of the resulting 'BL.ByteString' determines how much memory
-- will be used while writing to the handle.
hPut :: forall m h
     .  (HasCallStack, Monad m)
     => HasFS m h
     -> Handle h
     -> Builder
     -> m Word64
hPut :: HasFS m h -> Handle h -> Builder -> m Word64
hPut HasFS m h
hasFS Handle h
g = HasFS m h -> Handle h -> ByteString -> m Word64
forall (m :: * -> *) h.
(HasCallStack, Monad m) =>
HasFS m h -> Handle h -> ByteString -> m Word64
hPutAll HasFS m h
hasFS Handle h
g (ByteString -> m Word64)
-> (Builder -> ByteString) -> Builder -> m Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BS.toLazyByteString

{-------------------------------------------------------------------------------
  SomeHasFS
-------------------------------------------------------------------------------}

-- | It is often inconvenient to have to parameterise over @h@. One often makes
-- it existential, losing the ability to use derive 'Generic' and 'NoThunks'.
-- This data type hides an existential @h@ parameter of a 'HasFS' and provides a
-- 'NoThunks' thunks instance.
data SomeHasFS m where
  SomeHasFS :: Eq h => HasFS m h -> SomeHasFS m

  deriving Context -> SomeHasFS m -> IO (Maybe ThunkInfo)
Proxy (SomeHasFS m) -> String
(Context -> SomeHasFS m -> IO (Maybe ThunkInfo))
-> (Context -> SomeHasFS m -> IO (Maybe ThunkInfo))
-> (Proxy (SomeHasFS m) -> String)
-> NoThunks (SomeHasFS m)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall (m :: * -> *).
Context -> SomeHasFS m -> IO (Maybe ThunkInfo)
forall (m :: * -> *). Proxy (SomeHasFS m) -> String
showTypeOf :: Proxy (SomeHasFS m) -> String
$cshowTypeOf :: forall (m :: * -> *). Proxy (SomeHasFS m) -> String
wNoThunks :: Context -> SomeHasFS m -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (m :: * -> *).
Context -> SomeHasFS m -> IO (Maybe ThunkInfo)
noThunks :: Context -> SomeHasFS m -> IO (Maybe ThunkInfo)
$cnoThunks :: forall (m :: * -> *).
Context -> SomeHasFS m -> IO (Maybe ThunkInfo)
NoThunks via OnlyCheckWhnfNamed "SomeHasFS" (SomeHasFS m)