{-# LANGUAGE LambdaCase #-}

-- | This is meant to be used for the implementation of HasFS
-- instances and not directly by client code.
module Ouroboros.Consensus.Storage.FS.Handle (
    HandleOS (..)
  , closeHandleOS
  , isHandleClosedException
  , isOpenHandleOS
  , withOpenHandle
  ) where

import           Control.Concurrent.MVar
import           Control.Exception hiding (handle)
import           Data.Maybe (isJust)
import           System.IO.Error as IO

-- | File handlers for the IO instance for HasFS.
-- This is parametric on the os.
--
-- The 'FilePath' is used to improve error messages.
-- The 'MVar' is used to implement 'close'.
-- osHandle is Fd for unix and HANDLE for Windows.
data HandleOS osHandle = HandleOS {
      HandleOS osHandle -> FilePath
filePath :: FilePath
    , HandleOS osHandle -> MVar (Maybe osHandle)
handle   :: MVar (Maybe osHandle)
    }

instance Eq (HandleOS a) where
  HandleOS a
h1 == :: HandleOS a -> HandleOS a -> Bool
== HandleOS a
h2 = HandleOS a -> MVar (Maybe a)
forall osHandle. HandleOS osHandle -> MVar (Maybe osHandle)
handle HandleOS a
h1 MVar (Maybe a) -> MVar (Maybe a) -> Bool
forall a. Eq a => a -> a -> Bool
== HandleOS a -> MVar (Maybe a)
forall osHandle. HandleOS osHandle -> MVar (Maybe osHandle)
handle HandleOS a
h2

instance Show (HandleOS a) where
  show :: HandleOS a -> FilePath
show HandleOS a
h = FilePath
"<Handle " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ HandleOS a -> FilePath
forall a. HandleOS a -> FilePath
filePath HandleOS a
h FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
">"

isOpenHandleOS :: HandleOS osHandle -> IO Bool
isOpenHandleOS :: HandleOS osHandle -> IO Bool
isOpenHandleOS = (Maybe osHandle -> Bool) -> IO (Maybe osHandle) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe osHandle -> Bool
forall a. Maybe a -> Bool
isJust (IO (Maybe osHandle) -> IO Bool)
-> (HandleOS osHandle -> IO (Maybe osHandle))
-> HandleOS osHandle
-> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar (Maybe osHandle) -> IO (Maybe osHandle)
forall a. MVar a -> IO a
readMVar (MVar (Maybe osHandle) -> IO (Maybe osHandle))
-> (HandleOS osHandle -> MVar (Maybe osHandle))
-> HandleOS osHandle
-> IO (Maybe osHandle)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HandleOS osHandle -> MVar (Maybe osHandle)
forall osHandle. HandleOS osHandle -> MVar (Maybe osHandle)
handle

-- | This is a no-op when the handle is already closed.
closeHandleOS :: HandleOS osHandle -> (osHandle -> IO ()) -> IO ()
closeHandleOS :: HandleOS osHandle -> (osHandle -> IO ()) -> IO ()
closeHandleOS (HandleOS FilePath
_ MVar (Maybe osHandle)
hVar) osHandle -> IO ()
close =
  MVar (Maybe osHandle)
-> (Maybe osHandle -> IO (Maybe osHandle, ())) -> IO ()
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar (Maybe osHandle)
hVar ((Maybe osHandle -> IO (Maybe osHandle, ())) -> IO ())
-> (Maybe osHandle -> IO (Maybe osHandle, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \case
    Maybe osHandle
Nothing -> (Maybe osHandle, ()) -> IO (Maybe osHandle, ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe osHandle
forall a. Maybe a
Nothing, ())
    Just osHandle
h  -> osHandle -> IO ()
close osHandle
h IO () -> IO (Maybe osHandle, ()) -> IO (Maybe osHandle, ())
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Maybe osHandle, ()) -> IO (Maybe osHandle, ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe osHandle
forall a. Maybe a
Nothing, ())

{-------------------------------------------------------------------------------
  Exceptions
-------------------------------------------------------------------------------}

-- | This is meant to be used for the implementation of individual file system commands.
-- Using it for larger scopes woud not be correct, since we would not notice if the
-- handle is closed.
withOpenHandle :: String -> HandleOS osHandle -> (osHandle -> IO a) -> IO a
withOpenHandle :: FilePath -> HandleOS osHandle -> (osHandle -> IO a) -> IO a
withOpenHandle FilePath
label (HandleOS FilePath
fp MVar (Maybe osHandle)
hVar) osHandle -> IO a
k =
    MVar (Maybe osHandle) -> (Maybe osHandle -> IO a) -> IO a
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar (Maybe osHandle)
hVar ((Maybe osHandle -> IO a) -> IO a)
-> (Maybe osHandle -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \case
        Maybe osHandle
Nothing -> IOException -> IO a
forall e a. Exception e => e -> IO a
throwIO (FilePath -> FilePath -> IOException
handleClosedException FilePath
fp FilePath
label)
        Just osHandle
fd -> osHandle -> IO a
k osHandle
fd

handleClosedException :: FilePath -> String -> IOException
handleClosedException :: FilePath -> FilePath -> IOException
handleClosedException FilePath
fp FilePath
label =
      (IOException -> IOErrorType -> IOException)
-> IOErrorType -> IOException -> IOException
forall a b c. (a -> b -> c) -> b -> a -> c
flip IOException -> IOErrorType -> IOException
IO.ioeSetErrorType IOErrorType
IO.illegalOperationErrorType
    (IOException -> IOException) -> IOException -> IOException
forall a b. (a -> b) -> a -> b
$ (IOException -> FilePath -> IOException)
-> FilePath -> IOException -> IOException
forall a b c. (a -> b -> c) -> b -> a -> c
flip IOException -> FilePath -> IOException
IO.ioeSetFileName FilePath
fp
    (IOException -> IOException) -> IOException -> IOException
forall a b. (a -> b) -> a -> b
$ FilePath -> IOException
userError (FilePath
label FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
": FHandle closed")

{-------------------------------------------------------------------------------
  Internal auxiliary
-------------------------------------------------------------------------------}

isHandleClosedException :: IOException -> Bool
isHandleClosedException :: IOException -> Bool
isHandleClosedException IOException
ioErr =
    IOErrorType -> Bool
IO.isUserErrorType (IOException -> IOErrorType
IO.ioeGetErrorType IOException
ioErr)