{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE RecordWildCards    #-}

{-# OPTIONS_GHC -fno-warn-unused-imports #-}

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

-- |
-- Module      : Network.AWS.KMS.Types.Product
-- Copyright   : (c) 2013-2015 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
module Network.AWS.KMS.Types.Product where

import           Network.AWS.KMS.Types.Sum
import           Network.AWS.Prelude

-- | Contains information about an alias.
--
-- /See:/ 'aliasListEntry' smart constructor.
data AliasListEntry = AliasListEntry'
    { _aleTargetKeyId :: !(Maybe Text)
    , _aleAliasName   :: !(Maybe Text)
    , _aleAliasARN    :: !(Maybe Text)
    } deriving (Eq,Read,Show,Data,Typeable,Generic)

-- | Creates a value of 'AliasListEntry' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'aleTargetKeyId'
--
-- * 'aleAliasName'
--
-- * 'aleAliasARN'
aliasListEntry
    :: AliasListEntry
aliasListEntry =
    AliasListEntry'
    { _aleTargetKeyId = Nothing
    , _aleAliasName = Nothing
    , _aleAliasARN = Nothing
    }

-- | String that contains the key identifier pointed to by the alias.
aleTargetKeyId :: Lens' AliasListEntry (Maybe Text)
aleTargetKeyId = lens _aleTargetKeyId (\ s a -> s{_aleTargetKeyId = a});

-- | String that contains the alias.
aleAliasName :: Lens' AliasListEntry (Maybe Text)
aleAliasName = lens _aleAliasName (\ s a -> s{_aleAliasName = a});

-- | String that contains the key ARN.
aleAliasARN :: Lens' AliasListEntry (Maybe Text)
aleAliasARN = lens _aleAliasARN (\ s a -> s{_aleAliasARN = a});

instance FromJSON AliasListEntry where
        parseJSON
          = withObject "AliasListEntry"
              (\ x ->
                 AliasListEntry' <$>
                   (x .:? "TargetKeyId") <*> (x .:? "AliasName") <*>
                     (x .:? "AliasArn"))

-- | Contains constraints on the grant.
--
-- /See:/ 'grantConstraints' smart constructor.
data GrantConstraints = GrantConstraints'
    { _gcEncryptionContextEquals :: !(Maybe (Map Text Text))
    , _gcEncryptionContextSubset :: !(Maybe (Map Text Text))
    } deriving (Eq,Read,Show,Data,Typeable,Generic)

-- | Creates a value of 'GrantConstraints' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'gcEncryptionContextEquals'
--
-- * 'gcEncryptionContextSubset'
grantConstraints
    :: GrantConstraints
grantConstraints =
    GrantConstraints'
    { _gcEncryptionContextEquals = Nothing
    , _gcEncryptionContextSubset = Nothing
    }

-- | The constraint contains additional key\/value pairs that serve to
-- further limit the grant.
gcEncryptionContextEquals :: Lens' GrantConstraints (HashMap Text Text)
gcEncryptionContextEquals = lens _gcEncryptionContextEquals (\ s a -> s{_gcEncryptionContextEquals = a}) . _Default . _Map;

-- | The constraint equals the full encryption context.
gcEncryptionContextSubset :: Lens' GrantConstraints (HashMap Text Text)
gcEncryptionContextSubset = lens _gcEncryptionContextSubset (\ s a -> s{_gcEncryptionContextSubset = a}) . _Default . _Map;

instance FromJSON GrantConstraints where
        parseJSON
          = withObject "GrantConstraints"
              (\ x ->
                 GrantConstraints' <$>
                   (x .:? "EncryptionContextEquals" .!= mempty) <*>
                     (x .:? "EncryptionContextSubset" .!= mempty))

instance ToJSON GrantConstraints where
        toJSON GrantConstraints'{..}
          = object
              (catMaybes
                 [("EncryptionContextEquals" .=) <$>
                    _gcEncryptionContextEquals,
                  ("EncryptionContextSubset" .=) <$>
                    _gcEncryptionContextSubset])

-- | Contains information about each entry in the grant list.
--
-- /See:/ 'grantListEntry' smart constructor.
data GrantListEntry = GrantListEntry'
    { _gleRetiringPrincipal :: !(Maybe Text)
    , _gleIssuingAccount    :: !(Maybe Text)
    , _gleGrantId           :: !(Maybe Text)
    , _gleConstraints       :: !(Maybe GrantConstraints)
    , _gleGranteePrincipal  :: !(Maybe Text)
    , _gleOperations        :: !(Maybe [GrantOperation])
    } deriving (Eq,Read,Show,Data,Typeable,Generic)

-- | Creates a value of 'GrantListEntry' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'gleRetiringPrincipal'
--
-- * 'gleIssuingAccount'
--
-- * 'gleGrantId'
--
-- * 'gleConstraints'
--
-- * 'gleGranteePrincipal'
--
-- * 'gleOperations'
grantListEntry
    :: GrantListEntry
grantListEntry =
    GrantListEntry'
    { _gleRetiringPrincipal = Nothing
    , _gleIssuingAccount = Nothing
    , _gleGrantId = Nothing
    , _gleConstraints = Nothing
    , _gleGranteePrincipal = Nothing
    , _gleOperations = Nothing
    }

-- | The principal that can retire the account.
gleRetiringPrincipal :: Lens' GrantListEntry (Maybe Text)
gleRetiringPrincipal = lens _gleRetiringPrincipal (\ s a -> s{_gleRetiringPrincipal = a});

-- | The account under which the grant was issued.
gleIssuingAccount :: Lens' GrantListEntry (Maybe Text)
gleIssuingAccount = lens _gleIssuingAccount (\ s a -> s{_gleIssuingAccount = a});

-- | Unique grant identifier.
gleGrantId :: Lens' GrantListEntry (Maybe Text)
gleGrantId = lens _gleGrantId (\ s a -> s{_gleGrantId = a});

-- | Specifies the conditions under which the actions specified by the
-- 'Operations' parameter are allowed.
gleConstraints :: Lens' GrantListEntry (Maybe GrantConstraints)
gleConstraints = lens _gleConstraints (\ s a -> s{_gleConstraints = a});

-- | The principal that receives the grant permission.
gleGranteePrincipal :: Lens' GrantListEntry (Maybe Text)
gleGranteePrincipal = lens _gleGranteePrincipal (\ s a -> s{_gleGranteePrincipal = a});

-- | List of operations permitted by the grant. This can be any combination
-- of one or more of the following values:
--
-- 1.  Decrypt
-- 2.  Encrypt
-- 3.  GenerateDataKey
-- 4.  GenerateDataKeyWithoutPlaintext
-- 5.  ReEncryptFrom
-- 6.  ReEncryptTo
-- 7.  CreateGrant
gleOperations :: Lens' GrantListEntry [GrantOperation]
gleOperations = lens _gleOperations (\ s a -> s{_gleOperations = a}) . _Default . _Coerce;

instance FromJSON GrantListEntry where
        parseJSON
          = withObject "GrantListEntry"
              (\ x ->
                 GrantListEntry' <$>
                   (x .:? "RetiringPrincipal") <*>
                     (x .:? "IssuingAccount")
                     <*> (x .:? "GrantId")
                     <*> (x .:? "Constraints")
                     <*> (x .:? "GranteePrincipal")
                     <*> (x .:? "Operations" .!= mempty))

-- | Contains information about each entry in the key list.
--
-- /See:/ 'keyListEntry' smart constructor.
data KeyListEntry = KeyListEntry'
    { _kleKeyId  :: !(Maybe Text)
    , _kleKeyARN :: !(Maybe Text)
    } deriving (Eq,Read,Show,Data,Typeable,Generic)

-- | Creates a value of 'KeyListEntry' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'kleKeyId'
--
-- * 'kleKeyARN'
keyListEntry
    :: KeyListEntry
keyListEntry =
    KeyListEntry'
    { _kleKeyId = Nothing
    , _kleKeyARN = Nothing
    }

-- | Unique identifier of the key.
kleKeyId :: Lens' KeyListEntry (Maybe Text)
kleKeyId = lens _kleKeyId (\ s a -> s{_kleKeyId = a});

-- | ARN of the key.
kleKeyARN :: Lens' KeyListEntry (Maybe Text)
kleKeyARN = lens _kleKeyARN (\ s a -> s{_kleKeyARN = a});

instance FromJSON KeyListEntry where
        parseJSON
          = withObject "KeyListEntry"
              (\ x ->
                 KeyListEntry' <$>
                   (x .:? "KeyId") <*> (x .:? "KeyArn"))

-- | Contains metadata associated with a specific key.
--
-- /See:/ 'keyMetadata' smart constructor.
data KeyMetadata = KeyMetadata'
    { _kmEnabled      :: !(Maybe Bool)
    , _kmARN          :: !(Maybe Text)
    , _kmAWSAccountId :: !(Maybe Text)
    , _kmKeyUsage     :: !(Maybe KeyUsageType)
    , _kmCreationDate :: !(Maybe POSIX)
    , _kmDescription  :: !(Maybe Text)
    , _kmKeyId        :: !Text
    } deriving (Eq,Read,Show,Data,Typeable,Generic)

-- | Creates a value of 'KeyMetadata' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'kmEnabled'
--
-- * 'kmARN'
--
-- * 'kmAWSAccountId'
--
-- * 'kmKeyUsage'
--
-- * 'kmCreationDate'
--
-- * 'kmDescription'
--
-- * 'kmKeyId'
keyMetadata
    :: Text -- ^ 'kmKeyId'
    -> KeyMetadata
keyMetadata pKeyId_ =
    KeyMetadata'
    { _kmEnabled = Nothing
    , _kmARN = Nothing
    , _kmAWSAccountId = Nothing
    , _kmKeyUsage = Nothing
    , _kmCreationDate = Nothing
    , _kmDescription = Nothing
    , _kmKeyId = pKeyId_
    }

-- | Value that specifies whether the key is enabled.
kmEnabled :: Lens' KeyMetadata (Maybe Bool)
kmEnabled = lens _kmEnabled (\ s a -> s{_kmEnabled = a});

-- | Key ARN (Amazon Resource Name).
kmARN :: Lens' KeyMetadata (Maybe Text)
kmARN = lens _kmARN (\ s a -> s{_kmARN = a});

-- | Account ID number.
kmAWSAccountId :: Lens' KeyMetadata (Maybe Text)
kmAWSAccountId = lens _kmAWSAccountId (\ s a -> s{_kmAWSAccountId = a});

-- | A value that specifies what operation(s) the key can perform.
kmKeyUsage :: Lens' KeyMetadata (Maybe KeyUsageType)
kmKeyUsage = lens _kmKeyUsage (\ s a -> s{_kmKeyUsage = a});

-- | Date the key was created.
kmCreationDate :: Lens' KeyMetadata (Maybe UTCTime)
kmCreationDate = lens _kmCreationDate (\ s a -> s{_kmCreationDate = a}) . mapping _Time;

-- | The description of the key.
kmDescription :: Lens' KeyMetadata (Maybe Text)
kmDescription = lens _kmDescription (\ s a -> s{_kmDescription = a});

-- | Unique identifier for the key.
kmKeyId :: Lens' KeyMetadata Text
kmKeyId = lens _kmKeyId (\ s a -> s{_kmKeyId = a});

instance FromJSON KeyMetadata where
        parseJSON
          = withObject "KeyMetadata"
              (\ x ->
                 KeyMetadata' <$>
                   (x .:? "Enabled") <*> (x .:? "Arn") <*>
                     (x .:? "AWSAccountId")
                     <*> (x .:? "KeyUsage")
                     <*> (x .:? "CreationDate")
                     <*> (x .:? "Description")
                     <*> (x .: "KeyId"))