{-# 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           Ouroboros.Consensus.Storage.ChainDB.API (ChainDbFailure (..))
import           Ouroboros.Consensus.Storage.FS.API.Types (FsError (..),
                     FsErrorType (..))
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           Ouroboros.Consensus.Node.DbMarker (DbMarkerError)

{-------------------------------------------------------------------------------
  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 :: SomeException -> ExitReason
toExitReason :: SomeException -> ExitReason
toExitReason 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
    = SomeException -> ExitReason
toExitReason SomeException
e'
    | Just (DbMarkerError
_ :: DbMarkerError) <- SomeException -> Maybe DbMarkerError
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e
    = ExitReason
WrongDatabase
    | Just (ChainDbFailure
e' :: ChainDbFailure) <- SomeException -> Maybe ChainDbFailure
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e
    = case ChainDbFailure
e' of
        LgrDbFailure FsError
fe -> FsError -> ExitReason
fsError FsError
fe
        ChainDbFailure
_               -> ExitReason
DatabaseCorruption

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

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

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