{-# 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.CodeDeploy.Types.RevisionLocation
-- 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.CodeDeploy.Types.RevisionLocation where

import Amazonka.CodeDeploy.Types.AppSpecContent
import Amazonka.CodeDeploy.Types.GitHubLocation
import Amazonka.CodeDeploy.Types.RawString
import Amazonka.CodeDeploy.Types.RevisionLocationType
import Amazonka.CodeDeploy.Types.S3Location
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

-- | Information about the location of an application revision.
--
-- /See:/ 'newRevisionLocation' smart constructor.
data RevisionLocation = RevisionLocation'
  { -- | The content of an AppSpec file for an Lambda or Amazon ECS deployment.
    -- The content is formatted as JSON or YAML and stored as a RawString.
    RevisionLocation -> Maybe AppSpecContent
appSpecContent :: Prelude.Maybe AppSpecContent,
    -- | Information about the location of application artifacts stored in
    -- GitHub.
    RevisionLocation -> Maybe GitHubLocation
gitHubLocation :: Prelude.Maybe GitHubLocation,
    -- | The type of application revision:
    --
    -- -   S3: An application revision stored in Amazon S3.
    --
    -- -   GitHub: An application revision stored in GitHub (EC2\/On-premises
    --     deployments only).
    --
    -- -   String: A YAML-formatted or JSON-formatted string (Lambda
    --     deployments only).
    --
    -- -   AppSpecContent: An @AppSpecContent@ object that contains the
    --     contents of an AppSpec file for an Lambda or Amazon ECS deployment.
    --     The content is formatted as JSON or YAML stored as a RawString.
    RevisionLocation -> Maybe RevisionLocationType
revisionType :: Prelude.Maybe RevisionLocationType,
    -- | Information about the location of a revision stored in Amazon S3.
    RevisionLocation -> Maybe S3Location
s3Location :: Prelude.Maybe S3Location,
    -- | Information about the location of an Lambda deployment revision stored
    -- as a RawString.
    RevisionLocation -> Maybe RawString
string :: Prelude.Maybe RawString
  }
  deriving (RevisionLocation -> RevisionLocation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RevisionLocation -> RevisionLocation -> Bool
$c/= :: RevisionLocation -> RevisionLocation -> Bool
== :: RevisionLocation -> RevisionLocation -> Bool
$c== :: RevisionLocation -> RevisionLocation -> Bool
Prelude.Eq, ReadPrec [RevisionLocation]
ReadPrec RevisionLocation
Int -> ReadS RevisionLocation
ReadS [RevisionLocation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RevisionLocation]
$creadListPrec :: ReadPrec [RevisionLocation]
readPrec :: ReadPrec RevisionLocation
$creadPrec :: ReadPrec RevisionLocation
readList :: ReadS [RevisionLocation]
$creadList :: ReadS [RevisionLocation]
readsPrec :: Int -> ReadS RevisionLocation
$creadsPrec :: Int -> ReadS RevisionLocation
Prelude.Read, Int -> RevisionLocation -> ShowS
[RevisionLocation] -> ShowS
RevisionLocation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RevisionLocation] -> ShowS
$cshowList :: [RevisionLocation] -> ShowS
show :: RevisionLocation -> String
$cshow :: RevisionLocation -> String
showsPrec :: Int -> RevisionLocation -> ShowS
$cshowsPrec :: Int -> RevisionLocation -> ShowS
Prelude.Show, forall x. Rep RevisionLocation x -> RevisionLocation
forall x. RevisionLocation -> Rep RevisionLocation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RevisionLocation x -> RevisionLocation
$cfrom :: forall x. RevisionLocation -> Rep RevisionLocation x
Prelude.Generic)

-- |
-- Create a value of 'RevisionLocation' 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:
--
-- 'appSpecContent', 'revisionLocation_appSpecContent' - The content of an AppSpec file for an Lambda or Amazon ECS deployment.
-- The content is formatted as JSON or YAML and stored as a RawString.
--
-- 'gitHubLocation', 'revisionLocation_gitHubLocation' - Information about the location of application artifacts stored in
-- GitHub.
--
-- 'revisionType', 'revisionLocation_revisionType' - The type of application revision:
--
-- -   S3: An application revision stored in Amazon S3.
--
-- -   GitHub: An application revision stored in GitHub (EC2\/On-premises
--     deployments only).
--
-- -   String: A YAML-formatted or JSON-formatted string (Lambda
--     deployments only).
--
-- -   AppSpecContent: An @AppSpecContent@ object that contains the
--     contents of an AppSpec file for an Lambda or Amazon ECS deployment.
--     The content is formatted as JSON or YAML stored as a RawString.
--
-- 's3Location', 'revisionLocation_s3Location' - Information about the location of a revision stored in Amazon S3.
--
-- 'string', 'revisionLocation_string' - Information about the location of an Lambda deployment revision stored
-- as a RawString.
newRevisionLocation ::
  RevisionLocation
newRevisionLocation :: RevisionLocation
newRevisionLocation =
  RevisionLocation'
    { $sel:appSpecContent:RevisionLocation' :: Maybe AppSpecContent
appSpecContent = forall a. Maybe a
Prelude.Nothing,
      $sel:gitHubLocation:RevisionLocation' :: Maybe GitHubLocation
gitHubLocation = forall a. Maybe a
Prelude.Nothing,
      $sel:revisionType:RevisionLocation' :: Maybe RevisionLocationType
revisionType = forall a. Maybe a
Prelude.Nothing,
      $sel:s3Location:RevisionLocation' :: Maybe S3Location
s3Location = forall a. Maybe a
Prelude.Nothing,
      $sel:string:RevisionLocation' :: Maybe RawString
string = forall a. Maybe a
Prelude.Nothing
    }

-- | The content of an AppSpec file for an Lambda or Amazon ECS deployment.
-- The content is formatted as JSON or YAML and stored as a RawString.
revisionLocation_appSpecContent :: Lens.Lens' RevisionLocation (Prelude.Maybe AppSpecContent)
revisionLocation_appSpecContent :: Lens' RevisionLocation (Maybe AppSpecContent)
revisionLocation_appSpecContent = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RevisionLocation' {Maybe AppSpecContent
appSpecContent :: Maybe AppSpecContent
$sel:appSpecContent:RevisionLocation' :: RevisionLocation -> Maybe AppSpecContent
appSpecContent} -> Maybe AppSpecContent
appSpecContent) (\s :: RevisionLocation
s@RevisionLocation' {} Maybe AppSpecContent
a -> RevisionLocation
s {$sel:appSpecContent:RevisionLocation' :: Maybe AppSpecContent
appSpecContent = Maybe AppSpecContent
a} :: RevisionLocation)

-- | Information about the location of application artifacts stored in
-- GitHub.
revisionLocation_gitHubLocation :: Lens.Lens' RevisionLocation (Prelude.Maybe GitHubLocation)
revisionLocation_gitHubLocation :: Lens' RevisionLocation (Maybe GitHubLocation)
revisionLocation_gitHubLocation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RevisionLocation' {Maybe GitHubLocation
gitHubLocation :: Maybe GitHubLocation
$sel:gitHubLocation:RevisionLocation' :: RevisionLocation -> Maybe GitHubLocation
gitHubLocation} -> Maybe GitHubLocation
gitHubLocation) (\s :: RevisionLocation
s@RevisionLocation' {} Maybe GitHubLocation
a -> RevisionLocation
s {$sel:gitHubLocation:RevisionLocation' :: Maybe GitHubLocation
gitHubLocation = Maybe GitHubLocation
a} :: RevisionLocation)

-- | The type of application revision:
--
-- -   S3: An application revision stored in Amazon S3.
--
-- -   GitHub: An application revision stored in GitHub (EC2\/On-premises
--     deployments only).
--
-- -   String: A YAML-formatted or JSON-formatted string (Lambda
--     deployments only).
--
-- -   AppSpecContent: An @AppSpecContent@ object that contains the
--     contents of an AppSpec file for an Lambda or Amazon ECS deployment.
--     The content is formatted as JSON or YAML stored as a RawString.
revisionLocation_revisionType :: Lens.Lens' RevisionLocation (Prelude.Maybe RevisionLocationType)
revisionLocation_revisionType :: Lens' RevisionLocation (Maybe RevisionLocationType)
revisionLocation_revisionType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RevisionLocation' {Maybe RevisionLocationType
revisionType :: Maybe RevisionLocationType
$sel:revisionType:RevisionLocation' :: RevisionLocation -> Maybe RevisionLocationType
revisionType} -> Maybe RevisionLocationType
revisionType) (\s :: RevisionLocation
s@RevisionLocation' {} Maybe RevisionLocationType
a -> RevisionLocation
s {$sel:revisionType:RevisionLocation' :: Maybe RevisionLocationType
revisionType = Maybe RevisionLocationType
a} :: RevisionLocation)

-- | Information about the location of a revision stored in Amazon S3.
revisionLocation_s3Location :: Lens.Lens' RevisionLocation (Prelude.Maybe S3Location)
revisionLocation_s3Location :: Lens' RevisionLocation (Maybe S3Location)
revisionLocation_s3Location = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RevisionLocation' {Maybe S3Location
s3Location :: Maybe S3Location
$sel:s3Location:RevisionLocation' :: RevisionLocation -> Maybe S3Location
s3Location} -> Maybe S3Location
s3Location) (\s :: RevisionLocation
s@RevisionLocation' {} Maybe S3Location
a -> RevisionLocation
s {$sel:s3Location:RevisionLocation' :: Maybe S3Location
s3Location = Maybe S3Location
a} :: RevisionLocation)

-- | Information about the location of an Lambda deployment revision stored
-- as a RawString.
revisionLocation_string :: Lens.Lens' RevisionLocation (Prelude.Maybe RawString)
revisionLocation_string :: Lens' RevisionLocation (Maybe RawString)
revisionLocation_string = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RevisionLocation' {Maybe RawString
string :: Maybe RawString
$sel:string:RevisionLocation' :: RevisionLocation -> Maybe RawString
string} -> Maybe RawString
string) (\s :: RevisionLocation
s@RevisionLocation' {} Maybe RawString
a -> RevisionLocation
s {$sel:string:RevisionLocation' :: Maybe RawString
string = Maybe RawString
a} :: RevisionLocation)

instance Data.FromJSON RevisionLocation where
  parseJSON :: Value -> Parser RevisionLocation
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"RevisionLocation"
      ( \Object
x ->
          Maybe AppSpecContent
-> Maybe GitHubLocation
-> Maybe RevisionLocationType
-> Maybe S3Location
-> Maybe RawString
-> RevisionLocation
RevisionLocation'
            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
"appSpecContent")
            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
"gitHubLocation")
            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
"revisionType")
            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
"s3Location")
            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
"string")
      )

instance Prelude.Hashable RevisionLocation where
  hashWithSalt :: Int -> RevisionLocation -> Int
hashWithSalt Int
_salt RevisionLocation' {Maybe AppSpecContent
Maybe GitHubLocation
Maybe RawString
Maybe RevisionLocationType
Maybe S3Location
string :: Maybe RawString
s3Location :: Maybe S3Location
revisionType :: Maybe RevisionLocationType
gitHubLocation :: Maybe GitHubLocation
appSpecContent :: Maybe AppSpecContent
$sel:string:RevisionLocation' :: RevisionLocation -> Maybe RawString
$sel:s3Location:RevisionLocation' :: RevisionLocation -> Maybe S3Location
$sel:revisionType:RevisionLocation' :: RevisionLocation -> Maybe RevisionLocationType
$sel:gitHubLocation:RevisionLocation' :: RevisionLocation -> Maybe GitHubLocation
$sel:appSpecContent:RevisionLocation' :: RevisionLocation -> Maybe AppSpecContent
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AppSpecContent
appSpecContent
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe GitHubLocation
gitHubLocation
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RevisionLocationType
revisionType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe S3Location
s3Location
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RawString
string

instance Prelude.NFData RevisionLocation where
  rnf :: RevisionLocation -> ()
rnf RevisionLocation' {Maybe AppSpecContent
Maybe GitHubLocation
Maybe RawString
Maybe RevisionLocationType
Maybe S3Location
string :: Maybe RawString
s3Location :: Maybe S3Location
revisionType :: Maybe RevisionLocationType
gitHubLocation :: Maybe GitHubLocation
appSpecContent :: Maybe AppSpecContent
$sel:string:RevisionLocation' :: RevisionLocation -> Maybe RawString
$sel:s3Location:RevisionLocation' :: RevisionLocation -> Maybe S3Location
$sel:revisionType:RevisionLocation' :: RevisionLocation -> Maybe RevisionLocationType
$sel:gitHubLocation:RevisionLocation' :: RevisionLocation -> Maybe GitHubLocation
$sel:appSpecContent:RevisionLocation' :: RevisionLocation -> Maybe AppSpecContent
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AppSpecContent
appSpecContent
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe GitHubLocation
gitHubLocation
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RevisionLocationType
revisionType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe S3Location
s3Location
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RawString
string

instance Data.ToJSON RevisionLocation where
  toJSON :: RevisionLocation -> Value
toJSON RevisionLocation' {Maybe AppSpecContent
Maybe GitHubLocation
Maybe RawString
Maybe RevisionLocationType
Maybe S3Location
string :: Maybe RawString
s3Location :: Maybe S3Location
revisionType :: Maybe RevisionLocationType
gitHubLocation :: Maybe GitHubLocation
appSpecContent :: Maybe AppSpecContent
$sel:string:RevisionLocation' :: RevisionLocation -> Maybe RawString
$sel:s3Location:RevisionLocation' :: RevisionLocation -> Maybe S3Location
$sel:revisionType:RevisionLocation' :: RevisionLocation -> Maybe RevisionLocationType
$sel:gitHubLocation:RevisionLocation' :: RevisionLocation -> Maybe GitHubLocation
$sel:appSpecContent:RevisionLocation' :: RevisionLocation -> Maybe AppSpecContent
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"appSpecContent" 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 AppSpecContent
appSpecContent,
            (Key
"gitHubLocation" 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 GitHubLocation
gitHubLocation,
            (Key
"revisionType" 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 RevisionLocationType
revisionType,
            (Key
"s3Location" 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 S3Location
s3Location,
            (Key
"string" 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 RawString
string
          ]
      )