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

module Cardano.Api.IO
  ( readByteStringFile
  , readLazyByteStringFile
  , readTextFile
  , 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.Base
import           Cardano.Api.IO.Compat

import           Control.Monad.Except (runExceptT)
import           Control.Monad.IO.Class (MonadIO (..))
import           Control.Monad.Trans.Except.Extra (handleIOExceptT)
import           Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Char8 as BSC
import qualified Data.ByteString.Lazy as LBS
import qualified Data.ByteString.Lazy as LBSC
import           Data.Text (Text)
import qualified Data.Text.IO as Text

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

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)