{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Cardano.Api.IO
  ( readByteStringFile
  , readLazyByteStringFile
  , readTextFile
  , readFileBlocking
  , writeByteStringFileWithOwnerPermissions
  , writeByteStringFile
  , writeByteStringOutput
  , writeLazyByteStringFileWithOwnerPermissions
  , writeLazyByteStringFile
  , writeLazyByteStringOutput
  , writeTextFileWithOwnerPermissions
  , writeTextFile
  , writeTextOutput
  , File (..)
  , FileDirection (..)
  , SocketPath
  , mapFile
  , onlyIn
  , onlyOut
  , intoFile
  , checkVrfFilePermissions
  , writeSecrets
  )
where

import Cardano.Api.Error (FileError (..), fileIOExceptT)
import Cardano.Api.IO.Internal.Base
import Cardano.Api.IO.Internal.Compat

import Control.Exception (bracket)
import Control.Monad.Except (runExceptT)
import Control.Monad.IO.Class (MonadIO (..))
import Control.Monad.Trans.Except.Extra (handleIOExceptT)
import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Data.ByteString.Builder qualified as Builder
import Data.ByteString.Char8 qualified as BSC
import Data.ByteString.Lazy qualified as LBS
import Data.ByteString.Lazy qualified as LBSC
import Data.Text (Text)
import Data.Text.IO qualified as Text
import GHC.IO.Handle.FD (openFileBlocking)
import System.IO (IOMode (ReadMode), hClose)

readByteStringFile
  :: ()
  => MonadIO m
  => File content In
  -> m (Either (FileError e) ByteString)
readByteStringFile :: forall (m :: * -> *) content e.
MonadIO m =>
File content 'In -> m (Either (FileError e) ByteString)
readByteStringFile File content 'In
fp =
  ExceptT (FileError e) m ByteString
-> m (Either (FileError e) ByteString)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (FileError e) m ByteString
 -> m (Either (FileError e) ByteString))
-> ExceptT (FileError e) m ByteString
-> m (Either (FileError e) ByteString)
forall a b. (a -> b) -> a -> b
$
    FilePath
-> (FilePath -> IO ByteString)
-> ExceptT (FileError e) m ByteString
forall (m :: * -> *) s e.
MonadIO m =>
FilePath -> (FilePath -> IO s) -> ExceptT (FileError e) m s
fileIOExceptT (File content 'In -> FilePath
forall content (direction :: FileDirection).
File content direction -> FilePath
unFile File content 'In
fp) FilePath -> IO ByteString
BS.readFile

readLazyByteStringFile
  :: ()
  => MonadIO m
  => File content In
  -> m (Either (FileError e) LBS.ByteString)
readLazyByteStringFile :: forall (m :: * -> *) content e.
MonadIO m =>
File content 'In -> m (Either (FileError e) ByteString)
readLazyByteStringFile File content 'In
fp =
  ExceptT (FileError e) m ByteString
-> m (Either (FileError e) ByteString)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (FileError e) m ByteString
 -> m (Either (FileError e) ByteString))
-> ExceptT (FileError e) m ByteString
-> m (Either (FileError e) ByteString)
forall a b. (a -> b) -> a -> b
$
    FilePath
-> (FilePath -> IO ByteString)
-> ExceptT (FileError e) m ByteString
forall (m :: * -> *) s e.
MonadIO m =>
FilePath -> (FilePath -> IO s) -> ExceptT (FileError e) m s
fileIOExceptT (File content 'In -> FilePath
forall content (direction :: FileDirection).
File content direction -> FilePath
unFile File content 'In
fp) FilePath -> IO ByteString
LBS.readFile

readTextFile
  :: ()
  => MonadIO m
  => File content In
  -> m (Either (FileError e) Text)
readTextFile :: forall (m :: * -> *) content e.
MonadIO m =>
File content 'In -> m (Either (FileError e) Text)
readTextFile File content 'In
fp =
  ExceptT (FileError e) m Text -> m (Either (FileError e) Text)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (FileError e) m Text -> m (Either (FileError e) Text))
-> ExceptT (FileError e) m Text -> m (Either (FileError e) Text)
forall a b. (a -> b) -> a -> b
$
    FilePath -> (FilePath -> IO Text) -> ExceptT (FileError e) m Text
forall (m :: * -> *) s e.
MonadIO m =>
FilePath -> (FilePath -> IO s) -> ExceptT (FileError e) m s
fileIOExceptT (File content 'In -> FilePath
forall content (direction :: FileDirection).
File content direction -> FilePath
unFile File content 'In
fp) FilePath -> IO Text
Text.readFile

readFileBlocking :: FilePath -> IO BS.ByteString
readFileBlocking :: FilePath -> IO ByteString
readFileBlocking FilePath
path =
  IO Handle
-> (Handle -> IO ()) -> (Handle -> IO ByteString) -> IO ByteString
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
    (FilePath -> IOMode -> IO Handle
openFileBlocking FilePath
path IOMode
ReadMode)
    Handle -> IO ()
hClose
    ( \Handle
fp -> do
        -- An arbitrary block size.
        let blockSize :: Int
blockSize = Int
4096
        let go :: Builder -> IO Builder
go Builder
acc = do
              ByteString
next <- Handle -> Int -> IO ByteString
BS.hGet Handle
fp Int
blockSize
              if ByteString -> Bool
BS.null ByteString
next
                then Builder -> IO Builder
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Builder
acc
                else Builder -> IO Builder
go (Builder
acc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
Builder.byteString ByteString
next)
        Builder
contents <- Builder -> IO Builder
go Builder
forall a. Monoid a => a
mempty
        ByteString -> IO ByteString
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
Builder.toLazyByteString Builder
contents
    )

writeByteStringFile
  :: ()
  => MonadIO m
  => File content Out
  -> ByteString
  -> m (Either (FileError e) ())
writeByteStringFile :: forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeByteStringFile File content 'Out
fp ByteString
bs =
  ExceptT (FileError e) m () -> m (Either (FileError e) ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (FileError e) m () -> m (Either (FileError e) ()))
-> ExceptT (FileError e) m () -> m (Either (FileError e) ())
forall a b. (a -> b) -> a -> b
$
    (IOException -> FileError e) -> IO () -> ExceptT (FileError e) m ()
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FilePath -> IOException -> FileError e
forall e. FilePath -> IOException -> FileError e
FileIOError (File content 'Out -> FilePath
forall content (direction :: FileDirection).
File content direction -> FilePath
unFile File content 'Out
fp)) (IO () -> ExceptT (FileError e) m ())
-> IO () -> ExceptT (FileError e) m ()
forall a b. (a -> b) -> a -> b
$
      FilePath -> ByteString -> IO ()
BS.writeFile (File content 'Out -> FilePath
forall content (direction :: FileDirection).
File content direction -> FilePath
unFile File content 'Out
fp) ByteString
bs

writeByteStringFileWithOwnerPermissions
  :: FilePath
  -> BS.ByteString
  -> IO (Either (FileError e) ())
writeByteStringFileWithOwnerPermissions :: forall e. FilePath -> ByteString -> IO (Either (FileError e) ())
writeByteStringFileWithOwnerPermissions FilePath
fp ByteString
bs =
  FilePath -> (Handle -> IO ()) -> IO (Either (FileError e) ())
forall e.
FilePath -> (Handle -> IO ()) -> IO (Either (FileError e) ())
handleFileForWritingWithOwnerPermission FilePath
fp ((Handle -> IO ()) -> IO (Either (FileError e) ()))
-> (Handle -> IO ()) -> IO (Either (FileError e) ())
forall a b. (a -> b) -> a -> b
$ \Handle
h ->
    Handle -> ByteString -> IO ()
BS.hPut Handle
h ByteString
bs

writeByteStringOutput
  :: ()
  => MonadIO m
  => Maybe (File content Out)
  -> ByteString
  -> m (Either (FileError e) ())
writeByteStringOutput :: forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out)
-> ByteString -> m (Either (FileError e) ())
writeByteStringOutput Maybe (File content 'Out)
mOutput ByteString
bs = ExceptT (FileError e) m () -> m (Either (FileError e) ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (FileError e) m () -> m (Either (FileError e) ()))
-> ExceptT (FileError e) m () -> m (Either (FileError e) ())
forall a b. (a -> b) -> a -> b
$
  case Maybe (File content 'Out)
mOutput of
    Just File content 'Out
fp -> (IOException -> FileError e) -> IO () -> ExceptT (FileError e) m ()
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FilePath -> IOException -> FileError e
forall e. FilePath -> IOException -> FileError e
FileIOError (File content 'Out -> FilePath
forall content (direction :: FileDirection).
File content direction -> FilePath
unFile File content 'Out
fp)) (IO () -> ExceptT (FileError e) m ())
-> IO () -> ExceptT (FileError e) m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString -> IO ()
BS.writeFile (File content 'Out -> FilePath
forall content (direction :: FileDirection).
File content direction -> FilePath
unFile File content 'Out
fp) ByteString
bs
    Maybe (File content 'Out)
Nothing -> IO () -> ExceptT (FileError e) m ()
forall a. IO a -> ExceptT (FileError e) m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT (FileError e) m ())
-> IO () -> ExceptT (FileError e) m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
BSC.putStr ByteString
bs

writeLazyByteStringFile
  :: ()
  => MonadIO m
  => File content Out
  -> LBS.ByteString
  -> m (Either (FileError e) ())
writeLazyByteStringFile :: forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile File content 'Out
fp ByteString
bs =
  ExceptT (FileError e) m () -> m (Either (FileError e) ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (FileError e) m () -> m (Either (FileError e) ()))
-> ExceptT (FileError e) m () -> m (Either (FileError e) ())
forall a b. (a -> b) -> a -> b
$
    (IOException -> FileError e) -> IO () -> ExceptT (FileError e) m ()
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FilePath -> IOException -> FileError e
forall e. FilePath -> IOException -> FileError e
FileIOError (File content 'Out -> FilePath
forall content (direction :: FileDirection).
File content direction -> FilePath
unFile File content 'Out
fp)) (IO () -> ExceptT (FileError e) m ())
-> IO () -> ExceptT (FileError e) m ()
forall a b. (a -> b) -> a -> b
$
      FilePath -> ByteString -> IO ()
LBS.writeFile (File content 'Out -> FilePath
forall content (direction :: FileDirection).
File content direction -> FilePath
unFile File content 'Out
fp) ByteString
bs

writeLazyByteStringFileWithOwnerPermissions
  :: File content Out
  -> LBS.ByteString
  -> IO (Either (FileError e) ())
writeLazyByteStringFileWithOwnerPermissions :: forall content e.
File content 'Out -> ByteString -> IO (Either (FileError e) ())
writeLazyByteStringFileWithOwnerPermissions File content 'Out
fp ByteString
lbs =
  FilePath -> (Handle -> IO ()) -> IO (Either (FileError e) ())
forall e.
FilePath -> (Handle -> IO ()) -> IO (Either (FileError e) ())
handleFileForWritingWithOwnerPermission (File content 'Out -> FilePath
forall content (direction :: FileDirection).
File content direction -> FilePath
unFile File content 'Out
fp) ((Handle -> IO ()) -> IO (Either (FileError e) ()))
-> (Handle -> IO ()) -> IO (Either (FileError e) ())
forall a b. (a -> b) -> a -> b
$ \Handle
h ->
    Handle -> ByteString -> IO ()
LBS.hPut Handle
h ByteString
lbs

writeLazyByteStringOutput
  :: ()
  => MonadIO m
  => Maybe (File content Out)
  -> LBS.ByteString
  -> m (Either (FileError e) ())
writeLazyByteStringOutput :: forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out)
-> ByteString -> m (Either (FileError e) ())
writeLazyByteStringOutput Maybe (File content 'Out)
mOutput ByteString
bs = ExceptT (FileError e) m () -> m (Either (FileError e) ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (FileError e) m () -> m (Either (FileError e) ()))
-> ExceptT (FileError e) m () -> m (Either (FileError e) ())
forall a b. (a -> b) -> a -> b
$
  case Maybe (File content 'Out)
mOutput of
    Just File content 'Out
fp -> (IOException -> FileError e) -> IO () -> ExceptT (FileError e) m ()
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FilePath -> IOException -> FileError e
forall e. FilePath -> IOException -> FileError e
FileIOError (File content 'Out -> FilePath
forall content (direction :: FileDirection).
File content direction -> FilePath
unFile File content 'Out
fp)) (IO () -> ExceptT (FileError e) m ())
-> IO () -> ExceptT (FileError e) m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString -> IO ()
LBS.writeFile (File content 'Out -> FilePath
forall content (direction :: FileDirection).
File content direction -> FilePath
unFile File content 'Out
fp) ByteString
bs
    Maybe (File content 'Out)
Nothing -> IO () -> ExceptT (FileError e) m ()
forall a. IO a -> ExceptT (FileError e) m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT (FileError e) m ())
-> IO () -> ExceptT (FileError e) m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
LBSC.putStr ByteString
bs

writeTextFile
  :: ()
  => MonadIO m
  => File content Out
  -> Text
  -> m (Either (FileError e) ())
writeTextFile :: forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> Text -> m (Either (FileError e) ())
writeTextFile File content 'Out
fp Text
t =
  ExceptT (FileError e) m () -> m (Either (FileError e) ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (FileError e) m () -> m (Either (FileError e) ()))
-> ExceptT (FileError e) m () -> m (Either (FileError e) ())
forall a b. (a -> b) -> a -> b
$
    (IOException -> FileError e) -> IO () -> ExceptT (FileError e) m ()
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FilePath -> IOException -> FileError e
forall e. FilePath -> IOException -> FileError e
FileIOError (File content 'Out -> FilePath
forall content (direction :: FileDirection).
File content direction -> FilePath
unFile File content 'Out
fp)) (IO () -> ExceptT (FileError e) m ())
-> IO () -> ExceptT (FileError e) m ()
forall a b. (a -> b) -> a -> b
$
      FilePath -> Text -> IO ()
Text.writeFile (File content 'Out -> FilePath
forall content (direction :: FileDirection).
File content direction -> FilePath
unFile File content 'Out
fp) Text
t

writeTextFileWithOwnerPermissions
  :: File content Out
  -> Text
  -> IO (Either (FileError e) ())
writeTextFileWithOwnerPermissions :: forall content e.
File content 'Out -> Text -> IO (Either (FileError e) ())
writeTextFileWithOwnerPermissions File content 'Out
fp Text
t =
  FilePath -> (Handle -> IO ()) -> IO (Either (FileError e) ())
forall e.
FilePath -> (Handle -> IO ()) -> IO (Either (FileError e) ())
handleFileForWritingWithOwnerPermission (File content 'Out -> FilePath
forall content (direction :: FileDirection).
File content direction -> FilePath
unFile File content 'Out
fp) ((Handle -> IO ()) -> IO (Either (FileError e) ()))
-> (Handle -> IO ()) -> IO (Either (FileError e) ())
forall a b. (a -> b) -> a -> b
$ \Handle
h ->
    Handle -> Text -> IO ()
Text.hPutStr Handle
h Text
t

writeTextOutput
  :: ()
  => MonadIO m
  => Maybe (File content Out)
  -> Text
  -> m (Either (FileError e) ())
writeTextOutput :: forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out) -> Text -> m (Either (FileError e) ())
writeTextOutput Maybe (File content 'Out)
mOutput Text
t = ExceptT (FileError e) m () -> m (Either (FileError e) ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (FileError e) m () -> m (Either (FileError e) ()))
-> ExceptT (FileError e) m () -> m (Either (FileError e) ())
forall a b. (a -> b) -> a -> b
$
  case Maybe (File content 'Out)
mOutput of
    Just File content 'Out
fp -> (IOException -> FileError e) -> IO () -> ExceptT (FileError e) m ()
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FilePath -> IOException -> FileError e
forall e. FilePath -> IOException -> FileError e
FileIOError (File content 'Out -> FilePath
forall content (direction :: FileDirection).
File content direction -> FilePath
unFile File content 'Out
fp)) (IO () -> ExceptT (FileError e) m ())
-> IO () -> ExceptT (FileError e) m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> IO ()
Text.writeFile (File content 'Out -> FilePath
forall content (direction :: FileDirection).
File content direction -> FilePath
unFile File content 'Out
fp) Text
t
    Maybe (File content 'Out)
Nothing -> IO () -> ExceptT (FileError e) m ()
forall a. IO a -> ExceptT (FileError e) m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT (FileError e) m ())
-> IO () -> ExceptT (FileError e) m ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
Text.putStr Text
t

mapFile :: (FilePath -> FilePath) -> File content direction -> File content direction
mapFile :: forall content (direction :: FileDirection).
(FilePath -> FilePath)
-> File content direction -> File content direction
mapFile FilePath -> FilePath
f = FilePath -> File content direction
forall content (direction :: FileDirection).
FilePath -> File content direction
File (FilePath -> File content direction)
-> (File content direction -> FilePath)
-> File content direction
-> File content direction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
f (FilePath -> FilePath)
-> (File content direction -> FilePath)
-> File content direction
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. File content direction -> FilePath
forall content (direction :: FileDirection).
File content direction -> FilePath
unFile

onlyIn :: File content InOut -> File content In
onlyIn :: forall content. File content 'InOut -> File content 'In
onlyIn = FilePath -> File content 'In
forall content (direction :: FileDirection).
FilePath -> File content direction
File (FilePath -> File content 'In)
-> (File content 'InOut -> FilePath)
-> File content 'InOut
-> File content 'In
forall b c a. (b -> c) -> (a -> b) -> a -> c
. File content 'InOut -> FilePath
forall content (direction :: FileDirection).
File content direction -> FilePath
unFile

onlyOut :: File content InOut -> File content Out
onlyOut :: forall content. File content 'InOut -> File content 'Out
onlyOut = FilePath -> File content 'Out
forall content (direction :: FileDirection).
FilePath -> File content direction
File (FilePath -> File content 'Out)
-> (File content 'InOut -> FilePath)
-> File content 'InOut
-> File content 'Out
forall b c a. (b -> c) -> (a -> b) -> a -> c
. File content 'InOut -> FilePath
forall content (direction :: FileDirection).
File content direction -> FilePath
unFile

-- | Given a way to serialise a value and a way to write the stream to a file, serialise
-- a value into a stream, and write it to a file.
--
-- Whilst it is possible to call the serialisation and writing functions separately,
-- doing so means the compiler is unable to match the content type of the file with
-- the type of the content being serialised.
--
-- Using this function ensures that the content type of the file always matches with the
-- content value and prevents any type mismatches.
intoFile
  :: ()
  => File content 'Out
  -> content
  -> (File content 'Out -> stream -> result)
  -> (content -> stream)
  -> result
intoFile :: forall content stream result.
File content 'Out
-> content
-> (File content 'Out -> stream -> result)
-> (content -> stream)
-> result
intoFile File content 'Out
fp content
content File content 'Out -> stream -> result
write content -> stream
serialise = File content 'Out -> stream -> result
write File content 'Out
fp (content -> stream
serialise content
content)