{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Ouroboros.Consensus.Node.Exit (
    -- * ExitFailure
    ExitFailure
  , exitReasontoExitFailure
    -- * ExitReason
  , ExitReason (..)
  , toExitReason
  ) where

import           Control.Exception (AsyncException (..), SomeException,
                     fromException)
import           Control.Monad.Class.MonadAsync (ExceptionInLinkedThread (..))
import           Data.Proxy (Proxy)
import           Data.Typeable (Typeable)
import           Ouroboros.Consensus.Block (StandardHash)
import           Ouroboros.Consensus.Node.DbMarker (DbMarkerError)
import           Ouroboros.Consensus.Storage.ChainDB.API (ChainDbFailure (..))
import           Ouroboros.Consensus.Storage.ImmutableDB.API (ImmutableDBError)
import qualified Ouroboros.Consensus.Storage.ImmutableDB.API as ImmutableDB
import           Ouroboros.Consensus.Storage.VolatileDB (VolatileDBError)
import qualified Ouroboros.Consensus.Storage.VolatileDB as VolatileDB
import           System.FS.API.Types (FsError (..), FsErrorType (..))

{-------------------------------------------------------------------------------
  ExitFailure
-------------------------------------------------------------------------------}

-- | The exit code to return when terminating with an exception.
--
-- To be used in the @ExitFailure@ constructor of 'System.Exit.ExitCode'.
--
-- Note that a node will never turn shut down itself, it is meant to run
-- forever, so it will always terminate with an 'ExitFailure'.
type ExitFailure = Int

-- | Convert an 'ExitReason' to an 'ExitFailure'.
exitReasontoExitFailure :: ExitReason -> ExitFailure
exitReasontoExitFailure :: ExitReason -> ExitFailure
exitReasontoExitFailure = \case
    -- Some action should be taken before restarting in the cases below.
    ExitReason
ConfigurationError      -> ExitFailure
3
    ExitReason
WrongDatabase           -> ExitFailure
4
    ExitReason
DiskFull                -> ExitFailure
5
    ExitReason
InsufficientPermissions -> ExitFailure
6
    ExitReason
NoNetwork               -> ExitFailure
7

    -- The node can simply be restarted in the cases below.
    --
    -- NOTE: Database corruption is handled automically: when the node is
    -- restarted, it will do a full validation pass.
    ExitReason
Killed                  -> ExitFailure
1
    ExitReason
DatabaseCorruption      -> ExitFailure
2
    ExitReason
Other                   -> ExitFailure
2

{-------------------------------------------------------------------------------
  ExitReason
-------------------------------------------------------------------------------}

-- | The reason of shutting down
data ExitReason =
    -- | The node process was killed, by the @kill@ command, @CTRL-C@ or some
    -- other means. This is normal way for a user to terminate the node
    -- process. The node can simply be restarted.
    Killed

    -- | Something is wrong with the node configuration, the user should check it.
    --
    -- For example, for PBFT, it could be that the block signing key and the
    -- delegation certificate do not match.
  | ConfigurationError

    -- | We were unable to open the database, probably the user is using the
    -- wrong directory. See 'DbMarkerError' for details.
  | WrongDatabase

    -- | The disk is full, make some space before restarting the node.
  | DiskFull

    -- | The database folder doesn't have the right permissions.
  | InsufficientPermissions

    -- | There is a problem with the network connection, the user should
    -- investigate.
    --
    -- TODO We're not yet returning this.
  | NoNetwork

    -- | Something went wrong with the database, restart the node with
    -- recovery enabled.
  | DatabaseCorruption

    -- | Some exception was thrown. The node should just be restarted.
  | Other

-- | Return the 'ExitReason' for the given 'SomeException'. Defaults to
-- 'Other'.
toExitReason ::
     forall blk. (Typeable blk, StandardHash blk)
  => Proxy blk
  -> SomeException
  -> ExitReason
toExitReason :: forall blk.
(Typeable blk, StandardHash blk) =>
Proxy blk -> SomeException -> ExitReason
toExitReason Proxy blk
pb SomeException
e
    | Just (AsyncException
e' :: AsyncException) <- SomeException -> Maybe AsyncException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e
    = case AsyncException
e' of
        AsyncException
ThreadKilled  -> ExitReason
Killed
        AsyncException
UserInterrupt -> ExitReason
Killed
        AsyncException
_             -> ExitReason
Other

    | Just (ExceptionInLinkedThread String
_ SomeException
e') <- SomeException -> Maybe ExceptionInLinkedThread
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e
    = Proxy blk -> SomeException -> ExitReason
forall blk.
(Typeable blk, StandardHash blk) =>
Proxy blk -> SomeException -> ExitReason
toExitReason Proxy blk
pb SomeException
e'
    | Just (DbMarkerError
_ :: DbMarkerError) <- SomeException -> Maybe DbMarkerError
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e
    = ExitReason
WrongDatabase
    | Just (ChainDbFailure blk
e' :: ChainDbFailure blk) <- SomeException -> Maybe (ChainDbFailure blk)
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e
    = case ChainDbFailure blk
e' of
        LgrDbFailure FsError
fe -> FsError -> ExitReason
fsError FsError
fe
        ChainDbFailure blk
_               -> ExitReason
DatabaseCorruption

    | Just (VolatileDBError blk
e' :: VolatileDBError blk) <- SomeException -> Maybe (VolatileDBError blk)
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e
    = case VolatileDBError blk
e' of
        VolatileDB.UnexpectedFailure UnexpectedFailure blk
uf -> UnexpectedFailure blk -> ExitReason
volatileDbUnexpectedFailure UnexpectedFailure blk
uf
        VolatileDBError blk
_                               -> ExitReason
Other
    -- The two exceptions below will always be wrapped in a
    -- 'ChainDbFailure', but we include them just in case.
    | Just (ImmutableDBError blk
e' :: ImmutableDBError blk) <- SomeException -> Maybe (ImmutableDBError blk)
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e
    = case ImmutableDBError blk
e' of
        ImmutableDB.UnexpectedFailure UnexpectedFailure blk
uf -> UnexpectedFailure blk -> ExitReason
immutableDbUnexpectedFailure UnexpectedFailure blk
uf
        ImmutableDBError blk
_                                -> ExitReason
Other
    | Just (FsError
e' :: FsError) <- SomeException -> Maybe FsError
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e
    = FsError -> ExitReason
fsError FsError
e'

    | Bool
otherwise
    = ExitReason
Other
  where
    immutableDbUnexpectedFailure :: ImmutableDB.UnexpectedFailure blk -> ExitReason
    immutableDbUnexpectedFailure :: UnexpectedFailure blk -> ExitReason
immutableDbUnexpectedFailure = \case
      ImmutableDB.FileSystemError FsError
fe -> FsError -> ExitReason
fsError FsError
fe
      UnexpectedFailure blk
_                              -> ExitReason
DatabaseCorruption

    volatileDbUnexpectedFailure :: VolatileDB.UnexpectedFailure blk -> ExitReason
    volatileDbUnexpectedFailure :: UnexpectedFailure blk -> ExitReason
volatileDbUnexpectedFailure = \case
      VolatileDB.FileSystemError FsError
fe -> FsError -> ExitReason
fsError FsError
fe
      UnexpectedFailure blk
_                             -> ExitReason
DatabaseCorruption

    fsError :: FsError -> ExitReason
    fsError :: FsError -> ExitReason
fsError FsError { FsErrorType
fsErrorType :: FsErrorType
fsErrorType :: FsError -> FsErrorType
fsErrorType } = case FsErrorType
fsErrorType of
      FsErrorType
FsDeviceFull              -> ExitReason
DiskFull
      FsErrorType
FsInsufficientPermissions -> ExitReason
InsufficientPermissions
      FsErrorType
_                         -> ExitReason
DatabaseCorruption