{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.Batch.Types.EksVolume
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.Batch.Types.EksVolume where

import Amazonka.Batch.Types.EksEmptyDir
import Amazonka.Batch.Types.EksHostPath
import Amazonka.Batch.Types.EksSecret
import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude

-- | Specifies an Amazon EKS volume for a job definition.
--
-- /See:/ 'newEksVolume' smart constructor.
data EksVolume = EksVolume'
  { -- | Specifies the configuration of a Kubernetes @emptyDir@ volume. For more
    -- information, see
    -- <https://kubernetes.io/docs/concepts/storage/volumes/#emptydir emptyDir>
    -- in the /Kubernetes documentation/.
    EksVolume -> Maybe EksEmptyDir
emptyDir :: Prelude.Maybe EksEmptyDir,
    -- | Specifies the configuration of a Kubernetes @hostPath@ volume. For more
    -- information, see
    -- <https://kubernetes.io/docs/concepts/storage/volumes/#hostpath hostPath>
    -- in the /Kubernetes documentation/.
    EksVolume -> Maybe EksHostPath
hostPath :: Prelude.Maybe EksHostPath,
    -- | Specifies the configuration of a Kubernetes @secret@ volume. For more
    -- information, see
    -- <https://kubernetes.io/docs/concepts/storage/volumes/#secret secret> in
    -- the /Kubernetes documentation/.
    EksVolume -> Maybe EksSecret
secret :: Prelude.Maybe EksSecret,
    -- | The name of the volume. The name must be allowed as a DNS subdomain
    -- name. For more information, see
    -- <https://kubernetes.io/docs/concepts/overview/working-with-objects/names/#dns-subdomain-names DNS subdomain names>
    -- in the /Kubernetes documentation/.
    EksVolume -> Text
name :: Prelude.Text
  }
  deriving (EksVolume -> EksVolume -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EksVolume -> EksVolume -> Bool
$c/= :: EksVolume -> EksVolume -> Bool
== :: EksVolume -> EksVolume -> Bool
$c== :: EksVolume -> EksVolume -> Bool
Prelude.Eq, ReadPrec [EksVolume]
ReadPrec EksVolume
Int -> ReadS EksVolume
ReadS [EksVolume]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EksVolume]
$creadListPrec :: ReadPrec [EksVolume]
readPrec :: ReadPrec EksVolume
$creadPrec :: ReadPrec EksVolume
readList :: ReadS [EksVolume]
$creadList :: ReadS [EksVolume]
readsPrec :: Int -> ReadS EksVolume
$creadsPrec :: Int -> ReadS EksVolume
Prelude.Read, Int -> EksVolume -> ShowS
[EksVolume] -> ShowS
EksVolume -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EksVolume] -> ShowS
$cshowList :: [EksVolume] -> ShowS
show :: EksVolume -> String
$cshow :: EksVolume -> String
showsPrec :: Int -> EksVolume -> ShowS
$cshowsPrec :: Int -> EksVolume -> ShowS
Prelude.Show, forall x. Rep EksVolume x -> EksVolume
forall x. EksVolume -> Rep EksVolume x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EksVolume x -> EksVolume
$cfrom :: forall x. EksVolume -> Rep EksVolume x
Prelude.Generic)

-- |
-- Create a value of 'EksVolume' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'emptyDir', 'eksVolume_emptyDir' - Specifies the configuration of a Kubernetes @emptyDir@ volume. For more
-- information, see
-- <https://kubernetes.io/docs/concepts/storage/volumes/#emptydir emptyDir>
-- in the /Kubernetes documentation/.
--
-- 'hostPath', 'eksVolume_hostPath' - Specifies the configuration of a Kubernetes @hostPath@ volume. For more
-- information, see
-- <https://kubernetes.io/docs/concepts/storage/volumes/#hostpath hostPath>
-- in the /Kubernetes documentation/.
--
-- 'secret', 'eksVolume_secret' - Specifies the configuration of a Kubernetes @secret@ volume. For more
-- information, see
-- <https://kubernetes.io/docs/concepts/storage/volumes/#secret secret> in
-- the /Kubernetes documentation/.
--
-- 'name', 'eksVolume_name' - The name of the volume. The name must be allowed as a DNS subdomain
-- name. For more information, see
-- <https://kubernetes.io/docs/concepts/overview/working-with-objects/names/#dns-subdomain-names DNS subdomain names>
-- in the /Kubernetes documentation/.
newEksVolume ::
  -- | 'name'
  Prelude.Text ->
  EksVolume
newEksVolume :: Text -> EksVolume
newEksVolume Text
pName_ =
  EksVolume'
    { $sel:emptyDir:EksVolume' :: Maybe EksEmptyDir
emptyDir = forall a. Maybe a
Prelude.Nothing,
      $sel:hostPath:EksVolume' :: Maybe EksHostPath
hostPath = forall a. Maybe a
Prelude.Nothing,
      $sel:secret:EksVolume' :: Maybe EksSecret
secret = forall a. Maybe a
Prelude.Nothing,
      $sel:name:EksVolume' :: Text
name = Text
pName_
    }

-- | Specifies the configuration of a Kubernetes @emptyDir@ volume. For more
-- information, see
-- <https://kubernetes.io/docs/concepts/storage/volumes/#emptydir emptyDir>
-- in the /Kubernetes documentation/.
eksVolume_emptyDir :: Lens.Lens' EksVolume (Prelude.Maybe EksEmptyDir)
eksVolume_emptyDir :: Lens' EksVolume (Maybe EksEmptyDir)
eksVolume_emptyDir = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EksVolume' {Maybe EksEmptyDir
emptyDir :: Maybe EksEmptyDir
$sel:emptyDir:EksVolume' :: EksVolume -> Maybe EksEmptyDir
emptyDir} -> Maybe EksEmptyDir
emptyDir) (\s :: EksVolume
s@EksVolume' {} Maybe EksEmptyDir
a -> EksVolume
s {$sel:emptyDir:EksVolume' :: Maybe EksEmptyDir
emptyDir = Maybe EksEmptyDir
a} :: EksVolume)

-- | Specifies the configuration of a Kubernetes @hostPath@ volume. For more
-- information, see
-- <https://kubernetes.io/docs/concepts/storage/volumes/#hostpath hostPath>
-- in the /Kubernetes documentation/.
eksVolume_hostPath :: Lens.Lens' EksVolume (Prelude.Maybe EksHostPath)
eksVolume_hostPath :: Lens' EksVolume (Maybe EksHostPath)
eksVolume_hostPath = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EksVolume' {Maybe EksHostPath
hostPath :: Maybe EksHostPath
$sel:hostPath:EksVolume' :: EksVolume -> Maybe EksHostPath
hostPath} -> Maybe EksHostPath
hostPath) (\s :: EksVolume
s@EksVolume' {} Maybe EksHostPath
a -> EksVolume
s {$sel:hostPath:EksVolume' :: Maybe EksHostPath
hostPath = Maybe EksHostPath
a} :: EksVolume)

-- | Specifies the configuration of a Kubernetes @secret@ volume. For more
-- information, see
-- <https://kubernetes.io/docs/concepts/storage/volumes/#secret secret> in
-- the /Kubernetes documentation/.
eksVolume_secret :: Lens.Lens' EksVolume (Prelude.Maybe EksSecret)
eksVolume_secret :: Lens' EksVolume (Maybe EksSecret)
eksVolume_secret = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EksVolume' {Maybe EksSecret
secret :: Maybe EksSecret
$sel:secret:EksVolume' :: EksVolume -> Maybe EksSecret
secret} -> Maybe EksSecret
secret) (\s :: EksVolume
s@EksVolume' {} Maybe EksSecret
a -> EksVolume
s {$sel:secret:EksVolume' :: Maybe EksSecret
secret = Maybe EksSecret
a} :: EksVolume)

-- | The name of the volume. The name must be allowed as a DNS subdomain
-- name. For more information, see
-- <https://kubernetes.io/docs/concepts/overview/working-with-objects/names/#dns-subdomain-names DNS subdomain names>
-- in the /Kubernetes documentation/.
eksVolume_name :: Lens.Lens' EksVolume Prelude.Text
eksVolume_name :: Lens' EksVolume Text
eksVolume_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EksVolume' {Text
name :: Text
$sel:name:EksVolume' :: EksVolume -> Text
name} -> Text
name) (\s :: EksVolume
s@EksVolume' {} Text
a -> EksVolume
s {$sel:name:EksVolume' :: Text
name = Text
a} :: EksVolume)

instance Data.FromJSON EksVolume where
  parseJSON :: Value -> Parser EksVolume
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"EksVolume"
      ( \Object
x ->
          Maybe EksEmptyDir
-> Maybe EksHostPath -> Maybe EksSecret -> Text -> EksVolume
EksVolume'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"emptyDir")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"hostPath")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"secret")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"name")
      )

instance Prelude.Hashable EksVolume where
  hashWithSalt :: Int -> EksVolume -> Int
hashWithSalt Int
_salt EksVolume' {Maybe EksEmptyDir
Maybe EksHostPath
Maybe EksSecret
Text
name :: Text
secret :: Maybe EksSecret
hostPath :: Maybe EksHostPath
emptyDir :: Maybe EksEmptyDir
$sel:name:EksVolume' :: EksVolume -> Text
$sel:secret:EksVolume' :: EksVolume -> Maybe EksSecret
$sel:hostPath:EksVolume' :: EksVolume -> Maybe EksHostPath
$sel:emptyDir:EksVolume' :: EksVolume -> Maybe EksEmptyDir
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EksEmptyDir
emptyDir
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EksHostPath
hostPath
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EksSecret
secret
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData EksVolume where
  rnf :: EksVolume -> ()
rnf EksVolume' {Maybe EksEmptyDir
Maybe EksHostPath
Maybe EksSecret
Text
name :: Text
secret :: Maybe EksSecret
hostPath :: Maybe EksHostPath
emptyDir :: Maybe EksEmptyDir
$sel:name:EksVolume' :: EksVolume -> Text
$sel:secret:EksVolume' :: EksVolume -> Maybe EksSecret
$sel:hostPath:EksVolume' :: EksVolume -> Maybe EksHostPath
$sel:emptyDir:EksVolume' :: EksVolume -> Maybe EksEmptyDir
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe EksEmptyDir
emptyDir
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EksHostPath
hostPath
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EksSecret
secret
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name

instance Data.ToJSON EksVolume where
  toJSON :: EksVolume -> Value
toJSON EksVolume' {Maybe EksEmptyDir
Maybe EksHostPath
Maybe EksSecret
Text
name :: Text
secret :: Maybe EksSecret
hostPath :: Maybe EksHostPath
emptyDir :: Maybe EksEmptyDir
$sel:name:EksVolume' :: EksVolume -> Text
$sel:secret:EksVolume' :: EksVolume -> Maybe EksSecret
$sel:hostPath:EksVolume' :: EksVolume -> Maybe EksHostPath
$sel:emptyDir:EksVolume' :: EksVolume -> Maybe EksEmptyDir
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"emptyDir" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe EksEmptyDir
emptyDir,
            (Key
"hostPath" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe EksHostPath
hostPath,
            (Key
"secret" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe EksSecret
secret,
            forall a. a -> Maybe a
Prelude.Just (Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name)
          ]
      )