{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings #-}

module TestContainers.Docker.State
  ( State,
    containerState,

    -- * Container status
    Status (..),
    stateStatus,
    stateOOMKilled,
    statePid,
    stateExitCode,
    stateError,
    stateStartedAt,
    stateFinishedAt,
  )
where

import Control.Exception (Exception, throw)
import Data.Aeson (Value)
import qualified Data.Aeson.Optics as Optics
import Data.Text (Text)
import Optics.Operators ((^?))
import Optics.Optic ((%))
import TestContainers.Docker.Internal (InspectOutput)

-- | An exception thrown in case the State object is invalid and couldn't be parsed.
--
-- @since 0.5.0.0
data StateInvalidException = StateInvalidException
  deriving stock (StateInvalidException -> StateInvalidException -> Bool
(StateInvalidException -> StateInvalidException -> Bool)
-> (StateInvalidException -> StateInvalidException -> Bool)
-> Eq StateInvalidException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StateInvalidException -> StateInvalidException -> Bool
== :: StateInvalidException -> StateInvalidException -> Bool
$c/= :: StateInvalidException -> StateInvalidException -> Bool
/= :: StateInvalidException -> StateInvalidException -> Bool
Eq, Int -> StateInvalidException -> ShowS
[StateInvalidException] -> ShowS
StateInvalidException -> String
(Int -> StateInvalidException -> ShowS)
-> (StateInvalidException -> String)
-> ([StateInvalidException] -> ShowS)
-> Show StateInvalidException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StateInvalidException -> ShowS
showsPrec :: Int -> StateInvalidException -> ShowS
$cshow :: StateInvalidException -> String
show :: StateInvalidException -> String
$cshowList :: [StateInvalidException] -> ShowS
showList :: [StateInvalidException] -> ShowS
Show)

instance Exception StateInvalidException

-- | Status of a Docker container.
--
-- @since 0.5.0.0
data Status
  = Created
  | Running
  | Paused
  | Restarting
  | Removing
  | Exited
  | Dead
  | Other Text
  deriving (Status -> Status -> Bool
(Status -> Status -> Bool)
-> (Status -> Status -> Bool) -> Eq Status
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Status -> Status -> Bool
== :: Status -> Status -> Bool
$c/= :: Status -> Status -> Bool
/= :: Status -> Status -> Bool
Eq, Int -> Status -> ShowS
[Status] -> ShowS
Status -> String
(Int -> Status -> ShowS)
-> (Status -> String) -> ([Status] -> ShowS) -> Show Status
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Status -> ShowS
showsPrec :: Int -> Status -> ShowS
$cshow :: Status -> String
show :: Status -> String
$cshowList :: [Status] -> ShowS
showList :: [Status] -> ShowS
Show)

-- | State of a Docker container.
--
-- @since 0.5.0.0
newtype State = State Value

-- | Extract the 'State' of a Docker container from an 'InspectOutput'.
--
-- @since 0.5.0.0
containerState :: InspectOutput -> State
containerState :: Value -> State
containerState Value
inspectOutput =
  case Value
inspectOutput Value -> Optic' An_AffineTraversal NoIx Value Value -> Maybe Value
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
Optics.key Key
"State" of
    Just Value
state -> Value -> State
State Value
state
    Maybe Value
Nothing -> Value -> State
State Value
"dummy"

-- | Returns the 'Status' of container.
--
-- @since 0.5.0.0
stateStatus :: State -> Status
stateStatus :: State -> Status
stateStatus (State Value
value) =
  case Value
value
    Value -> Optic' An_AffineTraversal NoIx Value Text -> Maybe Text
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
Optics.key Key
"Status"
      Optic' An_AffineTraversal NoIx Value Value
-> Optic A_Prism NoIx Value Value Text Text
-> Optic' An_AffineTraversal NoIx Value Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Text Text
forall t. AsValue t => Prism' t Text
Optics._String of
    Just Text
"created" -> Status
Created
    Just Text
"running" -> Status
Running
    Just Text
"paused" -> Status
Paused
    Just Text
"restarting" -> Status
Restarting
    Just Text
"removing" -> Status
Removing
    Just Text
"exited" -> Status
Exited
    Just Text
"dead" -> Status
Dead
    Just Text
other -> Text -> Status
Other Text
other
    Maybe Text
Nothing -> StateInvalidException -> Status
forall a e. Exception e => e -> a
throw StateInvalidException
StateInvalidException

-- | Whether a container was killed by the OOM killer.
--
-- @since 0.5.0.0
stateOOMKilled :: State -> Bool
stateOOMKilled :: State -> Bool
stateOOMKilled (State Value
value) =
  case Value
value
    Value -> Optic' An_AffineTraversal NoIx Value Bool -> Maybe Bool
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
Optics.key Key
"OOMKilled"
      Optic' An_AffineTraversal NoIx Value Value
-> Optic A_Prism NoIx Value Value Bool Bool
-> Optic' An_AffineTraversal NoIx Value Bool
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Bool Bool
forall t. AsValue t => Prism' t Bool
Optics._Bool of
    Just Bool
True -> Bool
True
    Maybe Bool
_ -> Bool
False

-- |
--
-- @since 0.5.0.0
statePid :: State -> Maybe Int
statePid :: State -> Maybe Int
statePid (State Value
value) =
  case Value
value
    Value
-> Optic' An_AffineTraversal NoIx Value Integer -> Maybe Integer
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
Optics.key Key
"Pid"
      Optic' An_AffineTraversal NoIx Value Value
-> Optic A_Prism NoIx Value Value Integer Integer
-> Optic' An_AffineTraversal NoIx Value Integer
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Integer Integer
forall t. AsNumber t => Prism' t Integer
Optics._Integer of
    Just Integer
pid -> Int -> Maybe Int
forall a. a -> Maybe a
Just (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
pid)
    Maybe Integer
_ -> Maybe Int
forall a. Maybe a
Nothing

-- |
--
-- @since 0.5.0.0
stateExitCode :: State -> Maybe Int
stateExitCode :: State -> Maybe Int
stateExitCode (State Value
value) =
  case Value
value
    Value
-> Optic' An_AffineTraversal NoIx Value Integer -> Maybe Integer
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
Optics.key Key
"ExitCode"
      Optic' An_AffineTraversal NoIx Value Value
-> Optic A_Prism NoIx Value Value Integer Integer
-> Optic' An_AffineTraversal NoIx Value Integer
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Integer Integer
forall t. AsNumber t => Prism' t Integer
Optics._Integer of
    Just Integer
exitCode -> Int -> Maybe Int
forall a. a -> Maybe a
Just (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
exitCode)
    Maybe Integer
_ -> Maybe Int
forall a. Maybe a
Nothing

-- |
--
-- @since 0.5.0.0
stateError :: State -> Maybe Text
stateError :: State -> Maybe Text
stateError (State Value
value) =
  case Value
value
    Value -> Optic' An_AffineTraversal NoIx Value Text -> Maybe Text
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
Optics.key Key
"Error"
      Optic' An_AffineTraversal NoIx Value Value
-> Optic A_Prism NoIx Value Value Text Text
-> Optic' An_AffineTraversal NoIx Value Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Text Text
forall t. AsValue t => Prism' t Text
Optics._String of
    Just Text
err -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
err
    Maybe Text
_ -> Maybe Text
forall a. Maybe a
Nothing

-- |
--
-- @since 0.5.0.0
stateStartedAt :: State -> Maybe Text
stateStartedAt :: State -> Maybe Text
stateStartedAt (State Value
value) =
  case Value
value
    Value -> Optic' An_AffineTraversal NoIx Value Text -> Maybe Text
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
Optics.key Key
"StartedAt"
      Optic' An_AffineTraversal NoIx Value Value
-> Optic A_Prism NoIx Value Value Text Text
-> Optic' An_AffineTraversal NoIx Value Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Text Text
forall t. AsValue t => Prism' t Text
Optics._String of
    Just Text
err -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
err
    Maybe Text
_ -> Maybe Text
forall a. Maybe a
Nothing

-- |
--
-- @since 0.5.0.0
stateFinishedAt :: State -> Maybe Text
stateFinishedAt :: State -> Maybe Text
stateFinishedAt (State Value
value) =
  case Value
value
    Value -> Optic' An_AffineTraversal NoIx Value Text -> Maybe Text
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Key -> Optic' An_AffineTraversal NoIx Value Value
forall t. AsValue t => Key -> AffineTraversal' t Value
Optics.key Key
"FinishedAt"
      Optic' An_AffineTraversal NoIx Value Value
-> Optic A_Prism NoIx Value Value Text Text
-> Optic' An_AffineTraversal NoIx Value Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Text Text
forall t. AsValue t => Prism' t Text
Optics._String of
    Just Text
err -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
err
    Maybe Text
_ -> Maybe Text
forall a. Maybe a
Nothing