{-# LANGUAGE PackageImports #-}

module Ouroboros.Consensus.Storage.IO (
    FHandle
  , close
  , getSize
  , open
  , pread
  , read
  , sameError
  , seek
  , truncate
  , write
  ) where

import           Prelude hiding (read, truncate)

import           Control.Monad (void)
import           Data.ByteString (ByteString)
import qualified Data.ByteString.Internal as Internal
import           Data.Int (Int64)
import           Data.Word (Word32, Word64, Word8)
import           Foreign (Ptr)
import           System.Posix (Fd)
import qualified System.Posix as Posix

-- Package 'unix' exports the same module.
import           "unix-bytestring" System.Posix.IO.ByteString (fdPreadBuf)

import           Ouroboros.Consensus.Storage.FS.API.Types (AllowExisting (..),
                     FsError, OpenMode (..), SeekMode (..), sameFsError)
import           Ouroboros.Consensus.Storage.FS.Handle

type FHandle = HandleOS Fd

-- | Some sensible defaults for the 'OpenFileFlags'.
--
-- NOTE: the 'unix' package /already/ exports a smart constructor called
-- @defaultFileFlags@ already, but we define our own to not be depedent by
-- whichever default choice unix's library authors made, and to be able to
-- change our minds later if necessary. In particular, we are interested in the
-- 'append' and 'exclusive' flags, which were largely the reason why we
-- introduced this low-level module.
defaultFileFlags :: Posix.OpenFileFlags
defaultFileFlags :: OpenFileFlags
defaultFileFlags = OpenFileFlags :: Bool -> Bool -> Bool -> Bool -> Bool -> OpenFileFlags
Posix.OpenFileFlags {
      append :: Bool
Posix.append    = Bool
False
    , exclusive :: Bool
Posix.exclusive = Bool
False
    , noctty :: Bool
Posix.noctty    = Bool
False
    , nonBlock :: Bool
Posix.nonBlock  = Bool
False
    , trunc :: Bool
Posix.trunc     = Bool
False
    }

-- | Opens a file from disk.
open :: FilePath -> OpenMode -> IO Fd
open :: FilePath -> OpenMode -> IO Fd
open FilePath
fp OpenMode
openMode = FilePath -> OpenMode -> Maybe FileMode -> OpenFileFlags -> IO Fd
Posix.openFd FilePath
fp OpenMode
posixOpenMode Maybe FileMode
fileMode OpenFileFlags
fileFlags
  where
    (OpenMode
posixOpenMode, Maybe FileMode
fileMode, OpenFileFlags
fileFlags) = case OpenMode
openMode of
      OpenMode
ReadMode         -> ( OpenMode
Posix.ReadOnly
                          , Maybe FileMode
forall a. Maybe a
Nothing
                          , OpenFileFlags
defaultFileFlags
                          )
      AppendMode    AllowExisting
ex -> ( OpenMode
Posix.WriteOnly
                          , FileMode -> Maybe FileMode
forall a. a -> Maybe a
Just FileMode
Posix.stdFileMode
                          , OpenFileFlags
defaultFileFlags { append :: Bool
Posix.append = Bool
True
                                             , exclusive :: Bool
Posix.exclusive = AllowExisting -> Bool
isExcl AllowExisting
ex }
                          )
      ReadWriteMode AllowExisting
ex -> ( OpenMode
Posix.ReadWrite
                          , FileMode -> Maybe FileMode
forall a. a -> Maybe a
Just FileMode
Posix.stdFileMode
                          , OpenFileFlags
defaultFileFlags { exclusive :: Bool
Posix.exclusive = AllowExisting -> Bool
isExcl AllowExisting
ex }
                          )
      WriteMode     AllowExisting
ex -> ( OpenMode
Posix.ReadWrite
                          , FileMode -> Maybe FileMode
forall a. a -> Maybe a
Just FileMode
Posix.stdFileMode
                          , OpenFileFlags
defaultFileFlags { exclusive :: Bool
Posix.exclusive = AllowExisting -> Bool
isExcl AllowExisting
ex }
                          )

    isExcl :: AllowExisting -> Bool
isExcl AllowExisting
AllowExisting = Bool
False
    isExcl AllowExisting
MustBeNew     = Bool
True


-- | Writes the data pointed by the input 'Ptr Word8' into the input 'FHandle'.
write :: FHandle -> Ptr Word8 -> Int64 -> IO Word32
write :: FHandle -> Ptr Word8 -> Int64 -> IO Word32
write FHandle
h Ptr Word8
data' Int64
bytes = FilePath -> FHandle -> (Fd -> IO Word32) -> IO Word32
forall osHandle a.
FilePath -> HandleOS osHandle -> (osHandle -> IO a) -> IO a
withOpenHandle FilePath
"write" FHandle
h ((Fd -> IO Word32) -> IO Word32) -> (Fd -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \Fd
fd ->
    ByteCount -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteCount -> Word32) -> IO ByteCount -> IO Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fd -> Ptr Word8 -> ByteCount -> IO ByteCount
Posix.fdWriteBuf Fd
fd Ptr Word8
data' (Int64 -> ByteCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
bytes)

-- | Seek within the file.
--
-- The offset may be negative.
--
-- We don't return the new offset since the behaviour of lseek is rather odd
-- (e.g., the file pointer may not actually be moved until a subsequent write)
seek :: FHandle -> SeekMode -> Int64 -> IO ()
seek :: FHandle -> SeekMode -> Int64 -> IO ()
seek FHandle
h SeekMode
seekMode Int64
offset = FilePath -> FHandle -> (Fd -> IO ()) -> IO ()
forall osHandle a.
FilePath -> HandleOS osHandle -> (osHandle -> IO a) -> IO a
withOpenHandle FilePath
"seek" FHandle
h ((Fd -> IO ()) -> IO ()) -> (Fd -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Fd
fd ->
    IO FileOffset -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO FileOffset -> IO ()) -> IO FileOffset -> IO ()
forall a b. (a -> b) -> a -> b
$ Fd -> SeekMode -> FileOffset -> IO FileOffset
Posix.fdSeek Fd
fd SeekMode
seekMode (Int64 -> FileOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
offset)

-- | Reads a given number of bytes from the input 'FHandle'.
read :: FHandle -> Word64 -> IO ByteString
read :: FHandle -> Word64 -> IO ByteString
read FHandle
h Word64
bytes = FilePath -> FHandle -> (Fd -> IO ByteString) -> IO ByteString
forall osHandle a.
FilePath -> HandleOS osHandle -> (osHandle -> IO a) -> IO a
withOpenHandle FilePath
"read" FHandle
h ((Fd -> IO ByteString) -> IO ByteString)
-> (Fd -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Fd
fd ->
    Int -> (Ptr Word8 -> IO Int) -> IO ByteString
Internal.createUptoN (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
bytes) ((Ptr Word8 -> IO Int) -> IO ByteString)
-> (Ptr Word8 -> IO Int) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
      ByteCount -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteCount -> Int) -> IO ByteCount -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fd -> Ptr Word8 -> ByteCount -> IO ByteCount
Posix.fdReadBuf Fd
fd Ptr Word8
ptr (Word64 -> ByteCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
bytes)

pread :: FHandle -> Word64 -> Word64 -> IO ByteString
pread :: FHandle -> Word64 -> Word64 -> IO ByteString
pread FHandle
h Word64
bytes Word64
offset = FilePath -> FHandle -> (Fd -> IO ByteString) -> IO ByteString
forall osHandle a.
FilePath -> HandleOS osHandle -> (osHandle -> IO a) -> IO a
withOpenHandle FilePath
"pread" FHandle
h ((Fd -> IO ByteString) -> IO ByteString)
-> (Fd -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Fd
fd ->
    Int -> (Ptr Word8 -> IO Int) -> IO ByteString
Internal.createUptoN (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
bytes) ((Ptr Word8 -> IO Int) -> IO ByteString)
-> (Ptr Word8 -> IO Int) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
      ByteCount -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteCount -> Int) -> IO ByteCount -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fd -> Ptr Word8 -> ByteCount -> FileOffset -> IO ByteCount
fdPreadBuf Fd
fd Ptr Word8
ptr (Word64 -> ByteCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
bytes) (Word64 -> FileOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
offset)

-- | Truncates the file managed by the input 'FHandle' to the input size.
truncate :: FHandle -> Word64 -> IO ()
truncate :: FHandle -> Word64 -> IO ()
truncate FHandle
h Word64
sz = FilePath -> FHandle -> (Fd -> IO ()) -> IO ()
forall osHandle a.
FilePath -> HandleOS osHandle -> (osHandle -> IO a) -> IO a
withOpenHandle FilePath
"truncate" FHandle
h ((Fd -> IO ()) -> IO ()) -> (Fd -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Fd
fd ->
    Fd -> FileOffset -> IO ()
Posix.setFdSize Fd
fd (Word64 -> FileOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
sz)

-- | Close handle
--
-- This is a no-op when the handle is already closed.
close :: FHandle -> IO ()
close :: FHandle -> IO ()
close FHandle
h = FHandle -> (Fd -> IO ()) -> IO ()
forall osHandle. HandleOS osHandle -> (osHandle -> IO ()) -> IO ()
closeHandleOS FHandle
h Fd -> IO ()
Posix.closeFd

-- | File size of the given file pointer
--
-- NOTE: This is not thread safe (changes made to the file in other threads
-- may affect this thread).
getSize :: FHandle -> IO Word64
getSize :: FHandle -> IO Word64
getSize FHandle
h = FilePath -> FHandle -> (Fd -> IO Word64) -> IO Word64
forall osHandle a.
FilePath -> HandleOS osHandle -> (osHandle -> IO a) -> IO a
withOpenHandle FilePath
"getSize" FHandle
h ((Fd -> IO Word64) -> IO Word64) -> (Fd -> IO Word64) -> IO Word64
forall a b. (a -> b) -> a -> b
$ \Fd
fd ->
     FileOffset -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FileOffset -> Word64)
-> (FileStatus -> FileOffset) -> FileStatus -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> FileOffset
Posix.fileSize (FileStatus -> Word64) -> IO FileStatus -> IO Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fd -> IO FileStatus
Posix.getFdStatus Fd
fd

sameError :: FsError -> FsError -> Bool
sameError :: FsError -> FsError -> Bool
sameError = FsError -> FsError -> Bool
sameFsError