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

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

-- |
-- Module      : Network.Google.Directory.Types.Product
-- Copyright   : (c) 2015-2016 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.Google.Directory.Types.Product where

import           Network.Google.Directory.Types.Sum
import           Network.Google.Prelude

-- | JSON template for a location entry.
--
-- /See:/ 'userLocation' smart constructor.
data UserLocation = UserLocation'
    { _ulArea         :: !(Maybe Text)
    , _ulBuildingId   :: !(Maybe Text)
    , _ulDeskCode     :: !(Maybe Text)
    , _ulFloorName    :: !(Maybe Text)
    , _ulType         :: !(Maybe Text)
    , _ulCustomType   :: !(Maybe Text)
    , _ulFloorSection :: !(Maybe Text)
    } deriving (Eq,Show,Data,Typeable,Generic)

-- | Creates a value of 'UserLocation' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'ulArea'
--
-- * 'ulBuildingId'
--
-- * 'ulDeskCode'
--
-- * 'ulFloorName'
--
-- * 'ulType'
--
-- * 'ulCustomType'
--
-- * 'ulFloorSection'
userLocation
    :: UserLocation
userLocation =
    UserLocation'
    { _ulArea = Nothing
    , _ulBuildingId = Nothing
    , _ulDeskCode = Nothing
    , _ulFloorName = Nothing
    , _ulType = Nothing
    , _ulCustomType = Nothing
    , _ulFloorSection = Nothing
    }

-- | Textual location. This is most useful for display purposes to concisely
-- describe the location. For example, \"Mountain View, CA\", \"Near
-- Seattle\", \"US-NYC-9TH 9A209A\".
ulArea :: Lens' UserLocation (Maybe Text)
ulArea = lens _ulArea (\ s a -> s{_ulArea = a})

-- | Building Identifier.
ulBuildingId :: Lens' UserLocation (Maybe Text)
ulBuildingId
  = lens _ulBuildingId (\ s a -> s{_ulBuildingId = a})

-- | Most specific textual code of individual desk location.
ulDeskCode :: Lens' UserLocation (Maybe Text)
ulDeskCode
  = lens _ulDeskCode (\ s a -> s{_ulDeskCode = a})

-- | Floor name\/number.
ulFloorName :: Lens' UserLocation (Maybe Text)
ulFloorName
  = lens _ulFloorName (\ s a -> s{_ulFloorName = a})

-- | Each entry can have a type which indicates standard types of that entry.
-- For example location could be of types default and desk. In addition to
-- standard type, an entry can have a custom type and can give it any name.
-- Such types should have \"custom\" as type and also have a customType
-- value.
ulType :: Lens' UserLocation (Maybe Text)
ulType = lens _ulType (\ s a -> s{_ulType = a})

-- | Custom Type.
ulCustomType :: Lens' UserLocation (Maybe Text)
ulCustomType
  = lens _ulCustomType (\ s a -> s{_ulCustomType = a})

-- | Floor section. More specific location within the floor. For example, if
-- a floor is divided into sections \"A\", \"B\", and \"C\", this field
-- would identify one of those values.
ulFloorSection :: Lens' UserLocation (Maybe Text)
ulFloorSection
  = lens _ulFloorSection
      (\ s a -> s{_ulFloorSection = a})

instance FromJSON UserLocation where
        parseJSON
          = withObject "UserLocation"
              (\ o ->
                 UserLocation' <$>
                   (o .:? "area") <*> (o .:? "buildingId") <*>
                     (o .:? "deskCode")
                     <*> (o .:? "floorName")
                     <*> (o .:? "type")
                     <*> (o .:? "customType")
                     <*> (o .:? "floorSection"))

instance ToJSON UserLocation where
        toJSON UserLocation'{..}
          = object
              (catMaybes
                 [("area" .=) <$> _ulArea,
                  ("buildingId" .=) <$> _ulBuildingId,
                  ("deskCode" .=) <$> _ulDeskCode,
                  ("floorName" .=) <$> _ulFloorName,
                  ("type" .=) <$> _ulType,
                  ("customType" .=) <$> _ulCustomType,
                  ("floorSection" .=) <$> _ulFloorSection])

-- | JSON template for verification codes in Directory API.
--
-- /See:/ 'verificationCode' smart constructor.
data VerificationCode = VerificationCode'
    { _vcVerificationCode :: !(Maybe Text)
    , _vcEtag             :: !(Maybe Text)
    , _vcKind             :: !Text
    , _vcUserId           :: !(Maybe Text)
    } deriving (Eq,Show,Data,Typeable,Generic)

-- | Creates a value of 'VerificationCode' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'vcVerificationCode'
--
-- * 'vcEtag'
--
-- * 'vcKind'
--
-- * 'vcUserId'
verificationCode
    :: VerificationCode
verificationCode =
    VerificationCode'
    { _vcVerificationCode = Nothing
    , _vcEtag = Nothing
    , _vcKind = "admin#directory#verificationCode"
    , _vcUserId = Nothing
    }

-- | A current verification code for the user. Invalidated or used
-- verification codes are not returned as part of the result.
vcVerificationCode :: Lens' VerificationCode (Maybe Text)
vcVerificationCode
  = lens _vcVerificationCode
      (\ s a -> s{_vcVerificationCode = a})

-- | ETag of the resource.
vcEtag :: Lens' VerificationCode (Maybe Text)
vcEtag = lens _vcEtag (\ s a -> s{_vcEtag = a})

-- | The type of the resource. This is always
-- admin#directory#verificationCode.
vcKind :: Lens' VerificationCode Text
vcKind = lens _vcKind (\ s a -> s{_vcKind = a})

-- | The obfuscated unique ID of the user.
vcUserId :: Lens' VerificationCode (Maybe Text)
vcUserId = lens _vcUserId (\ s a -> s{_vcUserId = a})

instance FromJSON VerificationCode where
        parseJSON
          = withObject "VerificationCode"
              (\ o ->
                 VerificationCode' <$>
                   (o .:? "verificationCode") <*> (o .:? "etag") <*>
                     (o .:? "kind" .!= "admin#directory#verificationCode")
                     <*> (o .:? "userId"))

instance ToJSON VerificationCode where
        toJSON VerificationCode'{..}
          = object
              (catMaybes
                 [("verificationCode" .=) <$> _vcVerificationCode,
                  ("etag" .=) <$> _vcEtag, Just ("kind" .= _vcKind),
                  ("userId" .=) <$> _vcUserId])

-- | JSON template for Feature object in Directory API.
--
-- /See:/ 'feature' smart constructor.
data Feature = Feature'
    { _fEtags :: !(Maybe Text)
    , _fKind  :: !Text
    , _fName  :: !(Maybe Text)
    } deriving (Eq,Show,Data,Typeable,Generic)

-- | Creates a value of 'Feature' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'fEtags'
--
-- * 'fKind'
--
-- * 'fName'
feature
    :: Feature
feature =
    Feature'
    { _fEtags = Nothing
    , _fKind = "admin#directory#resources#features#Feature"
    , _fName = Nothing
    }

-- | ETag of the resource.
fEtags :: Lens' Feature (Maybe Text)
fEtags = lens _fEtags (\ s a -> s{_fEtags = a})

-- | Kind of resource this is.
fKind :: Lens' Feature Text
fKind = lens _fKind (\ s a -> s{_fKind = a})

-- | The name of the feature.
fName :: Lens' Feature (Maybe Text)
fName = lens _fName (\ s a -> s{_fName = a})

instance FromJSON Feature where
        parseJSON
          = withObject "Feature"
              (\ o ->
                 Feature' <$>
                   (o .:? "etags") <*>
                     (o .:? "kind" .!=
                        "admin#directory#resources#features#Feature")
                     <*> (o .:? "name"))

instance ToJSON Feature where
        toJSON Feature'{..}
          = object
              (catMaybes
                 [("etags" .=) <$> _fEtags, Just ("kind" .= _fKind),
                  ("name" .=) <$> _fName])

-- | JSON template for Org Unit resource in Directory API.
--
-- /See:/ 'orgUnit' smart constructor.
data OrgUnit = OrgUnit'
    { _ouEtag              :: !(Maybe Text)
    , _ouParentOrgUnitPath :: !(Maybe Text)
    , _ouKind              :: !Text
    , _ouOrgUnitPath       :: !(Maybe Text)
    , _ouName              :: !(Maybe Text)
    , _ouBlockInheritance  :: !(Maybe Bool)
    , _ouParentOrgUnitId   :: !(Maybe Text)
    , _ouDescription       :: !(Maybe Text)
    , _ouOrgUnitId         :: !(Maybe Text)
    } deriving (Eq,Show,Data,Typeable,Generic)

-- | Creates a value of 'OrgUnit' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'ouEtag'
--
-- * 'ouParentOrgUnitPath'
--
-- * 'ouKind'
--
-- * 'ouOrgUnitPath'
--
-- * 'ouName'
--
-- * 'ouBlockInheritance'
--
-- * 'ouParentOrgUnitId'
--
-- * 'ouDescription'
--
-- * 'ouOrgUnitId'
orgUnit
    :: OrgUnit
orgUnit =
    OrgUnit'
    { _ouEtag = Nothing
    , _ouParentOrgUnitPath = Nothing
    , _ouKind = "admin#directory#orgUnit"
    , _ouOrgUnitPath = Nothing
    , _ouName = Nothing
    , _ouBlockInheritance = Nothing
    , _ouParentOrgUnitId = Nothing
    , _ouDescription = Nothing
    , _ouOrgUnitId = Nothing
    }

-- | ETag of the resource.
ouEtag :: Lens' OrgUnit (Maybe Text)
ouEtag = lens _ouEtag (\ s a -> s{_ouEtag = a})

-- | Path of parent OrgUnit
ouParentOrgUnitPath :: Lens' OrgUnit (Maybe Text)
ouParentOrgUnitPath
  = lens _ouParentOrgUnitPath
      (\ s a -> s{_ouParentOrgUnitPath = a})

-- | Kind of resource this is.
ouKind :: Lens' OrgUnit Text
ouKind = lens _ouKind (\ s a -> s{_ouKind = a})

-- | Path of OrgUnit
ouOrgUnitPath :: Lens' OrgUnit (Maybe Text)
ouOrgUnitPath
  = lens _ouOrgUnitPath
      (\ s a -> s{_ouOrgUnitPath = a})

-- | Name of OrgUnit
ouName :: Lens' OrgUnit (Maybe Text)
ouName = lens _ouName (\ s a -> s{_ouName = a})

-- | Should block inheritance
ouBlockInheritance :: Lens' OrgUnit (Maybe Bool)
ouBlockInheritance
  = lens _ouBlockInheritance
      (\ s a -> s{_ouBlockInheritance = a})

-- | Id of parent OrgUnit
ouParentOrgUnitId :: Lens' OrgUnit (Maybe Text)
ouParentOrgUnitId
  = lens _ouParentOrgUnitId
      (\ s a -> s{_ouParentOrgUnitId = a})

-- | Description of OrgUnit
ouDescription :: Lens' OrgUnit (Maybe Text)
ouDescription
  = lens _ouDescription
      (\ s a -> s{_ouDescription = a})

-- | Id of OrgUnit
ouOrgUnitId :: Lens' OrgUnit (Maybe Text)
ouOrgUnitId
  = lens _ouOrgUnitId (\ s a -> s{_ouOrgUnitId = a})

instance FromJSON OrgUnit where
        parseJSON
          = withObject "OrgUnit"
              (\ o ->
                 OrgUnit' <$>
                   (o .:? "etag") <*> (o .:? "parentOrgUnitPath") <*>
                     (o .:? "kind" .!= "admin#directory#orgUnit")
                     <*> (o .:? "orgUnitPath")
                     <*> (o .:? "name")
                     <*> (o .:? "blockInheritance")
                     <*> (o .:? "parentOrgUnitId")
                     <*> (o .:? "description")
                     <*> (o .:? "orgUnitId"))

instance ToJSON OrgUnit where
        toJSON OrgUnit'{..}
          = object
              (catMaybes
                 [("etag" .=) <$> _ouEtag,
                  ("parentOrgUnitPath" .=) <$> _ouParentOrgUnitPath,
                  Just ("kind" .= _ouKind),
                  ("orgUnitPath" .=) <$> _ouOrgUnitPath,
                  ("name" .=) <$> _ouName,
                  ("blockInheritance" .=) <$> _ouBlockInheritance,
                  ("parentOrgUnitId" .=) <$> _ouParentOrgUnitId,
                  ("description" .=) <$> _ouDescription,
                  ("orgUnitId" .=) <$> _ouOrgUnitId])

-- | JSON request template for setting\/revoking admin status of a user in
-- Directory API.
--
-- /See:/ 'userMakeAdmin' smart constructor.
newtype UserMakeAdmin = UserMakeAdmin'
    { _umaStatus :: Maybe Bool
    } deriving (Eq,Show,Data,Typeable,Generic)

-- | Creates a value of 'UserMakeAdmin' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'umaStatus'
userMakeAdmin
    :: UserMakeAdmin
userMakeAdmin =
    UserMakeAdmin'
    { _umaStatus = Nothing
    }

-- | Boolean indicating new admin status of the user
umaStatus :: Lens' UserMakeAdmin (Maybe Bool)
umaStatus
  = lens _umaStatus (\ s a -> s{_umaStatus = a})

instance FromJSON UserMakeAdmin where
        parseJSON
          = withObject "UserMakeAdmin"
              (\ o -> UserMakeAdmin' <$> (o .:? "status"))

instance ToJSON UserMakeAdmin where
        toJSON UserMakeAdmin'{..}
          = object (catMaybes [("status" .=) <$> _umaStatus])

-- | JSON template for About (notes) of a user in Directory API.
--
-- /See:/ 'userAbout' smart constructor.
data UserAbout = UserAbout'
    { _uaValue       :: !(Maybe Text)
    , _uaContentType :: !(Maybe Text)
    } deriving (Eq,Show,Data,Typeable,Generic)

-- | Creates a value of 'UserAbout' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'uaValue'
--
-- * 'uaContentType'
userAbout
    :: UserAbout
userAbout =
    UserAbout'
    { _uaValue = Nothing
    , _uaContentType = Nothing
    }

-- | Actual value of notes.
uaValue :: Lens' UserAbout (Maybe Text)
uaValue = lens _uaValue (\ s a -> s{_uaValue = a})

-- | About entry can have a type which indicates the content type. It can
-- either be plain or html. By default, notes contents are assumed to
-- contain plain text.
uaContentType :: Lens' UserAbout (Maybe Text)
uaContentType
  = lens _uaContentType
      (\ s a -> s{_uaContentType = a})

instance FromJSON UserAbout where
        parseJSON
          = withObject "UserAbout"
              (\ o ->
                 UserAbout' <$>
                   (o .:? "value") <*> (o .:? "contentType"))

instance ToJSON UserAbout where
        toJSON UserAbout'{..}
          = object
              (catMaybes
                 [("value" .=) <$> _uaValue,
                  ("contentType" .=) <$> _uaContentType])

-- | JSON response template for List privileges operation in Directory API.
--
-- /See:/ 'privileges' smart constructor.
data Privileges = Privileges'
    { _pEtag  :: !(Maybe Text)
    , _pKind  :: !Text
    , _pItems :: !(Maybe [Privilege])
    } deriving (Eq,Show,Data,Typeable,Generic)

-- | Creates a value of 'Privileges' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'pEtag'
--
-- * 'pKind'
--
-- * 'pItems'
privileges
    :: Privileges
privileges =
    Privileges'
    { _pEtag = Nothing
    , _pKind = "admin#directory#privileges"
    , _pItems = Nothing
    }

-- | ETag of the resource.
pEtag :: Lens' Privileges (Maybe Text)
pEtag = lens _pEtag (\ s a -> s{_pEtag = a})

-- | The type of the API resource. This is always admin#directory#privileges.
pKind :: Lens' Privileges Text
pKind = lens _pKind (\ s a -> s{_pKind = a})

-- | A list of Privilege resources.
pItems :: Lens' Privileges [Privilege]
pItems
  = lens _pItems (\ s a -> s{_pItems = a}) . _Default .
      _Coerce

instance FromJSON Privileges where
        parseJSON
          = withObject "Privileges"
              (\ o ->
                 Privileges' <$>
                   (o .:? "etag") <*>
                     (o .:? "kind" .!= "admin#directory#privileges")
                     <*> (o .:? "items" .!= mempty))

instance ToJSON Privileges where
        toJSON Privileges'{..}
          = object
              (catMaybes
                 [("etag" .=) <$> _pEtag, Just ("kind" .= _pKind),
                  ("items" .=) <$> _pItems])

-- | JSON response template for List Groups operation in Directory API.
--
-- /See:/ 'groups' smart constructor.
data Groups = Groups'
    { _gGroups        :: !(Maybe [Group])
    , _gEtag          :: !(Maybe Text)
    , _gNextPageToken :: !(Maybe Text)
    , _gKind          :: !Text
    } deriving (Eq,Show,Data,Typeable,Generic)

-- | Creates a value of 'Groups' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'gGroups'
--
-- * 'gEtag'
--
-- * 'gNextPageToken'
--
-- * 'gKind'
groups
    :: Groups
groups =
    Groups'
    { _gGroups = Nothing
    , _gEtag = Nothing
    , _gNextPageToken = Nothing
    , _gKind = "admin#directory#groups"
    }

-- | List of group objects.
gGroups :: Lens' Groups [Group]
gGroups
  = lens _gGroups (\ s a -> s{_gGroups = a}) . _Default
      . _Coerce

-- | ETag of the resource.
gEtag :: Lens' Groups (Maybe Text)
gEtag = lens _gEtag (\ s a -> s{_gEtag = a})

-- | Token used to access next page of this result.
gNextPageToken :: Lens' Groups (Maybe Text)
gNextPageToken
  = lens _gNextPageToken
      (\ s a -> s{_gNextPageToken = a})

-- | Kind of resource this is.
gKind :: Lens' Groups Text
gKind = lens _gKind (\ s a -> s{_gKind = a})

instance FromJSON Groups where
        parseJSON
          = withObject "Groups"
              (\ o ->
                 Groups' <$>
                   (o .:? "groups" .!= mempty) <*> (o .:? "etag") <*>
                     (o .:? "nextPageToken")
                     <*> (o .:? "kind" .!= "admin#directory#groups"))

instance ToJSON Groups where
        toJSON Groups'{..}
          = object
              (catMaybes
                 [("groups" .=) <$> _gGroups, ("etag" .=) <$> _gEtag,
                  ("nextPageToken" .=) <$> _gNextPageToken,
                  Just ("kind" .= _gKind)])

-- | JSON response template for List roleAssignments operation in Directory
-- API.
--
-- /See:/ 'roleAssignments' smart constructor.
data RoleAssignments = RoleAssignments'
    { _raEtag          :: !(Maybe Text)
    , _raNextPageToken :: !(Maybe Text)
    , _raKind          :: !Text
    , _raItems         :: !(Maybe [RoleAssignment])
    } deriving (Eq,Show,Data,Typeable,Generic)

-- | Creates a value of 'RoleAssignments' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'raEtag'
--
-- * 'raNextPageToken'
--
-- * 'raKind'
--
-- * 'raItems'
roleAssignments
    :: RoleAssignments
roleAssignments =
    RoleAssignments'
    { _raEtag = Nothing
    , _raNextPageToken = Nothing
    , _raKind = "admin#directory#roleAssignments"
    , _raItems = Nothing
    }

-- | ETag of the resource.
raEtag :: Lens' RoleAssignments (Maybe Text)
raEtag = lens _raEtag (\ s a -> s{_raEtag = a})

raNextPageToken :: Lens' RoleAssignments (Maybe Text)
raNextPageToken
  = lens _raNextPageToken
      (\ s a -> s{_raNextPageToken = a})

-- | The type of the API resource. This is always
-- admin#directory#roleAssignments.
raKind :: Lens' RoleAssignments Text
raKind = lens _raKind (\ s a -> s{_raKind = a})

-- | A list of RoleAssignment resources.
raItems :: Lens' RoleAssignments [RoleAssignment]
raItems
  = lens _raItems (\ s a -> s{_raItems = a}) . _Default
      . _Coerce

instance FromJSON RoleAssignments where
        parseJSON
          = withObject "RoleAssignments"
              (\ o ->
                 RoleAssignments' <$>
                   (o .:? "etag") <*> (o .:? "nextPageToken") <*>
                     (o .:? "kind" .!= "admin#directory#roleAssignments")
                     <*> (o .:? "items" .!= mempty))

instance ToJSON RoleAssignments where
        toJSON RoleAssignments'{..}
          = object
              (catMaybes
                 [("etag" .=) <$> _raEtag,
                  ("nextPageToken" .=) <$> _raNextPageToken,
                  Just ("kind" .= _raKind), ("items" .=) <$> _raItems])

-- | JSON template for privilege resource in Directory API.
--
-- /See:/ 'privilege' smart constructor.
data Privilege = Privilege'
    { _priEtag            :: !(Maybe Text)
    , _priIsOuScopable    :: !(Maybe Bool)
    , _priKind            :: !Text
    , _priServiceName     :: !(Maybe Text)
    , _priServiceId       :: !(Maybe Text)
    , _priPrivilegeName   :: !(Maybe Text)
    , _priChildPrivileges :: !(Maybe [Privilege])
    } deriving (Eq,Show,Data,Typeable,Generic)

-- | Creates a value of 'Privilege' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'priEtag'
--
-- * 'priIsOuScopable'
--
-- * 'priKind'
--
-- * 'priServiceName'
--
-- * 'priServiceId'
--
-- * 'priPrivilegeName'
--
-- * 'priChildPrivileges'
privilege
    :: Privilege
privilege =
    Privilege'
    { _priEtag = Nothing
    , _priIsOuScopable = Nothing
    , _priKind = "admin#directory#privilege"
    , _priServiceName = Nothing
    , _priServiceId = Nothing
    , _priPrivilegeName = Nothing
    , _priChildPrivileges = Nothing
    }

-- | ETag of the resource.
priEtag :: Lens' Privilege (Maybe Text)
priEtag = lens _priEtag (\ s a -> s{_priEtag = a})

-- | If the privilege can be restricted to an organization unit.
priIsOuScopable :: Lens' Privilege (Maybe Bool)
priIsOuScopable
  = lens _priIsOuScopable
      (\ s a -> s{_priIsOuScopable = a})

-- | The type of the API resource. This is always admin#directory#privilege.
priKind :: Lens' Privilege Text
priKind = lens _priKind (\ s a -> s{_priKind = a})

-- | The name of the service this privilege is for.
priServiceName :: Lens' Privilege (Maybe Text)
priServiceName
  = lens _priServiceName
      (\ s a -> s{_priServiceName = a})

-- | The obfuscated ID of the service this privilege is for.
priServiceId :: Lens' Privilege (Maybe Text)
priServiceId
  = lens _priServiceId (\ s a -> s{_priServiceId = a})

-- | The name of the privilege.
priPrivilegeName :: Lens' Privilege (Maybe Text)
priPrivilegeName
  = lens _priPrivilegeName
      (\ s a -> s{_priPrivilegeName = a})

-- | A list of child privileges. Privileges for a service form a tree. Each
-- privilege can have a list of child privileges; this list is empty for a
-- leaf privilege.
priChildPrivileges :: Lens' Privilege [Privilege]
priChildPrivileges
  = lens _priChildPrivileges
      (\ s a -> s{_priChildPrivileges = a})
      . _Default
      . _Coerce

instance FromJSON Privilege where
        parseJSON
          = withObject "Privilege"
              (\ o ->
                 Privilege' <$>
                   (o .:? "etag") <*> (o .:? "isOuScopable") <*>
                     (o .:? "kind" .!= "admin#directory#privilege")
                     <*> (o .:? "serviceName")
                     <*> (o .:? "serviceId")
                     <*> (o .:? "privilegeName")
                     <*> (o .:? "childPrivileges" .!= mempty))

instance ToJSON Privilege where
        toJSON Privilege'{..}
          = object
              (catMaybes
                 [("etag" .=) <$> _priEtag,
                  ("isOuScopable" .=) <$> _priIsOuScopable,
                  Just ("kind" .= _priKind),
                  ("serviceName" .=) <$> _priServiceName,
                  ("serviceId" .=) <$> _priServiceId,
                  ("privilegeName" .=) <$> _priPrivilegeName,
                  ("childPrivileges" .=) <$> _priChildPrivileges])

-- | JSON response template for List roles operation in Directory API.
--
-- /See:/ 'roles' smart constructor.
data Roles = Roles'
    { _rEtag          :: !(Maybe Text)
    , _rNextPageToken :: !(Maybe Text)
    , _rKind          :: !Text
    , _rItems         :: !(Maybe [Role])
    } deriving (Eq,Show,Data,Typeable,Generic)

-- | Creates a value of 'Roles' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'rEtag'
--
-- * 'rNextPageToken'
--
-- * 'rKind'
--
-- * 'rItems'
roles
    :: Roles
roles =
    Roles'
    { _rEtag = Nothing
    , _rNextPageToken = Nothing
    , _rKind = "admin#directory#roles"
    , _rItems = Nothing
    }

-- | ETag of the resource.
rEtag :: Lens' Roles (Maybe Text)
rEtag = lens _rEtag (\ s a -> s{_rEtag = a})

rNextPageToken :: Lens' Roles (Maybe Text)
rNextPageToken
  = lens _rNextPageToken
      (\ s a -> s{_rNextPageToken = a})

-- | The type of the API resource. This is always admin#directory#roles.
rKind :: Lens' Roles Text
rKind = lens _rKind (\ s a -> s{_rKind = a})

-- | A list of Role resources.
rItems :: Lens' Roles [Role]
rItems
  = lens _rItems (\ s a -> s{_rItems = a}) . _Default .
      _Coerce

instance FromJSON Roles where
        parseJSON
          = withObject "Roles"
              (\ o ->
                 Roles' <$>
                   (o .:? "etag") <*> (o .:? "nextPageToken") <*>
                     (o .:? "kind" .!= "admin#directory#roles")
                     <*> (o .:? "items" .!= mempty))

instance ToJSON Roles where
        toJSON Roles'{..}
          = object
              (catMaybes
                 [("etag" .=) <$> _rEtag,
                  ("nextPageToken" .=) <$> _rNextPageToken,
                  Just ("kind" .= _rKind), ("items" .=) <$> _rItems])

--
-- /See:/ 'chromeOSDeviceDiskVolumeReportsItem' smart constructor.
newtype ChromeOSDeviceDiskVolumeReportsItem = ChromeOSDeviceDiskVolumeReportsItem'
    { _coddvriVolumeInfo :: Maybe [ChromeOSDeviceDiskVolumeReportsItemVolumeInfoItem]
    } deriving (Eq,Show,Data,Typeable,Generic)

-- | Creates a value of 'ChromeOSDeviceDiskVolumeReportsItem' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'coddvriVolumeInfo'
chromeOSDeviceDiskVolumeReportsItem
    :: ChromeOSDeviceDiskVolumeReportsItem
chromeOSDeviceDiskVolumeReportsItem =
    ChromeOSDeviceDiskVolumeReportsItem'
    { _coddvriVolumeInfo = Nothing
    }

-- | Disk volumes
coddvriVolumeInfo :: Lens' ChromeOSDeviceDiskVolumeReportsItem [ChromeOSDeviceDiskVolumeReportsItemVolumeInfoItem]
coddvriVolumeInfo
  = lens _coddvriVolumeInfo
      (\ s a -> s{_coddvriVolumeInfo = a})
      . _Default
      . _Coerce

instance FromJSON ChromeOSDeviceDiskVolumeReportsItem
         where
        parseJSON
          = withObject "ChromeOSDeviceDiskVolumeReportsItem"
              (\ o ->
                 ChromeOSDeviceDiskVolumeReportsItem' <$>
                   (o .:? "volumeInfo" .!= mempty))

instance ToJSON ChromeOSDeviceDiskVolumeReportsItem
         where
        toJSON ChromeOSDeviceDiskVolumeReportsItem'{..}
          = object
              (catMaybes
                 [("volumeInfo" .=) <$> _coddvriVolumeInfo])

-- | JSON template for address.
--
-- /See:/ 'userAddress' smart constructor.
data UserAddress = UserAddress'
    { _uaStreetAddress      :: !(Maybe Text)
    , _uaPoBox              :: !(Maybe Text)
    , _uaCountry            :: !(Maybe Text)
    , _uaPostalCode         :: !(Maybe Text)
    , _uaFormatted          :: !(Maybe Text)
    , _uaExtendedAddress    :: !(Maybe Text)
    , _uaLocality           :: !(Maybe Text)
    , _uaPrimary            :: !(Maybe Bool)
    , _uaCountryCode        :: !(Maybe Text)
    , _uaRegion             :: !(Maybe Text)
    , _uaType               :: !(Maybe Text)
    , _uaCustomType         :: !(Maybe Text)
    , _uaSourceIsStructured :: !(Maybe Bool)
    } deriving (Eq,Show,Data,Typeable,Generic)

-- | Creates a value of 'UserAddress' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'uaStreetAddress'
--
-- * 'uaPoBox'
--
-- * 'uaCountry'
--
-- * 'uaPostalCode'
--
-- * 'uaFormatted'
--
-- * 'uaExtendedAddress'
--
-- * 'uaLocality'
--
-- * 'uaPrimary'
--
-- * 'uaCountryCode'
--
-- * 'uaRegion'
--
-- * 'uaType'
--
-- * 'uaCustomType'
--
-- * 'uaSourceIsStructured'
userAddress
    :: UserAddress
userAddress =
    UserAddress'
    { _uaStreetAddress = Nothing
    , _uaPoBox = Nothing
    , _uaCountry = Nothing
    , _uaPostalCode = Nothing
    , _uaFormatted = Nothing
    , _uaExtendedAddress = Nothing
    , _uaLocality = Nothing
    , _uaPrimary = Nothing
    , _uaCountryCode = Nothing
    , _uaRegion = Nothing
    , _uaType = Nothing
    , _uaCustomType = Nothing
    , _uaSourceIsStructured = Nothing
    }

-- | Street.
uaStreetAddress :: Lens' UserAddress (Maybe Text)
uaStreetAddress
  = lens _uaStreetAddress
      (\ s a -> s{_uaStreetAddress = a})

-- | Other parts of address.
uaPoBox :: Lens' UserAddress (Maybe Text)
uaPoBox = lens _uaPoBox (\ s a -> s{_uaPoBox = a})

-- | Country.
uaCountry :: Lens' UserAddress (Maybe Text)
uaCountry
  = lens _uaCountry (\ s a -> s{_uaCountry = a})

-- | Postal code.
uaPostalCode :: Lens' UserAddress (Maybe Text)
uaPostalCode
  = lens _uaPostalCode (\ s a -> s{_uaPostalCode = a})

-- | Formatted address.
uaFormatted :: Lens' UserAddress (Maybe Text)
uaFormatted
  = lens _uaFormatted (\ s a -> s{_uaFormatted = a})

-- | Extended Address.
uaExtendedAddress :: Lens' UserAddress (Maybe Text)
uaExtendedAddress
  = lens _uaExtendedAddress
      (\ s a -> s{_uaExtendedAddress = a})

-- | Locality.
uaLocality :: Lens' UserAddress (Maybe Text)
uaLocality
  = lens _uaLocality (\ s a -> s{_uaLocality = a})

-- | If this is user\'s primary address. Only one entry could be marked as
-- primary.
uaPrimary :: Lens' UserAddress (Maybe Bool)
uaPrimary
  = lens _uaPrimary (\ s a -> s{_uaPrimary = a})

-- | Country code.
uaCountryCode :: Lens' UserAddress (Maybe Text)
uaCountryCode
  = lens _uaCountryCode
      (\ s a -> s{_uaCountryCode = a})

-- | Region.
uaRegion :: Lens' UserAddress (Maybe Text)
uaRegion = lens _uaRegion (\ s a -> s{_uaRegion = a})

-- | Each entry can have a type which indicates standard values of that
-- entry. For example address could be of home, work etc. In addition to
-- the standard type, an entry can have a custom type and can take any
-- value. Such type should have the CUSTOM value as type and also have a
-- customType value.
uaType :: Lens' UserAddress (Maybe Text)
uaType = lens _uaType (\ s a -> s{_uaType = a})

-- | Custom type.
uaCustomType :: Lens' UserAddress (Maybe Text)
uaCustomType
  = lens _uaCustomType (\ s a -> s{_uaCustomType = a})

-- | User supplied address was structured. Structured addresses are NOT
-- supported at this time. You might be able to write structured addresses,
-- but any values will eventually be clobbered.
uaSourceIsStructured :: Lens' UserAddress (Maybe Bool)
uaSourceIsStructured
  = lens _uaSourceIsStructured
      (\ s a -> s{_uaSourceIsStructured = a})

instance FromJSON UserAddress where
        parseJSON
          = withObject "UserAddress"
              (\ o ->
                 UserAddress' <$>
                   (o .:? "streetAddress") <*> (o .:? "poBox") <*>
                     (o .:? "country")
                     <*> (o .:? "postalCode")
                     <*> (o .:? "formatted")
                     <*> (o .:? "extendedAddress")
                     <*> (o .:? "locality")
                     <*> (o .:? "primary")
                     <*> (o .:? "countryCode")
                     <*> (o .:? "region")
                     <*> (o .:? "type")
                     <*> (o .:? "customType")
                     <*> (o .:? "sourceIsStructured"))

instance ToJSON UserAddress where
        toJSON UserAddress'{..}
          = object
              (catMaybes
                 [("streetAddress" .=) <$> _uaStreetAddress,
                  ("poBox" .=) <$> _uaPoBox,
                  ("country" .=) <$> _uaCountry,
                  ("postalCode" .=) <$> _uaPostalCode,
                  ("formatted" .=) <$> _uaFormatted,
                  ("extendedAddress" .=) <$> _uaExtendedAddress,
                  ("locality" .=) <$> _uaLocality,
                  ("primary" .=) <$> _uaPrimary,
                  ("countryCode" .=) <$> _uaCountryCode,
                  ("region" .=) <$> _uaRegion, ("type" .=) <$> _uaType,
                  ("customType" .=) <$> _uaCustomType,
                  ("sourceIsStructured" .=) <$> _uaSourceIsStructured])

-- | JSON template for postal address of a customer.
--
-- /See:/ 'customerPostalAddress' smart constructor.
data CustomerPostalAddress = CustomerPostalAddress'
    { _cpaOrganizationName :: !(Maybe Text)
    , _cpaPostalCode       :: !(Maybe Text)
    , _cpaAddressLine1     :: !(Maybe Text)
    , _cpaLocality         :: !(Maybe Text)
    , _cpaContactName      :: !(Maybe Text)
    , _cpaAddressLine2     :: !(Maybe Text)
    , _cpaCountryCode      :: !(Maybe Text)
    , _cpaRegion           :: !(Maybe Text)
    , _cpaAddressLine3     :: !(Maybe Text)
    } deriving (Eq,Show,Data,Typeable,Generic)

-- | Creates a value of 'CustomerPostalAddress' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'cpaOrganizationName'
--
-- * 'cpaPostalCode'
--
-- * 'cpaAddressLine1'
--
-- * 'cpaLocality'
--
-- * 'cpaContactName'
--
-- * 'cpaAddressLine2'
--
-- * 'cpaCountryCode'
--
-- * 'cpaRegion'
--
-- * 'cpaAddressLine3'
customerPostalAddress
    :: CustomerPostalAddress
customerPostalAddress =
    CustomerPostalAddress'
    { _cpaOrganizationName = Nothing
    , _cpaPostalCode = Nothing
    , _cpaAddressLine1 = Nothing
    , _cpaLocality = Nothing
    , _cpaContactName = Nothing
    , _cpaAddressLine2 = Nothing
    , _cpaCountryCode = Nothing
    , _cpaRegion = Nothing
    , _cpaAddressLine3 = Nothing
    }

-- | The company or company division name.
cpaOrganizationName :: Lens' CustomerPostalAddress (Maybe Text)
cpaOrganizationName
  = lens _cpaOrganizationName
      (\ s a -> s{_cpaOrganizationName = a})

-- | The postal code. A postalCode example is a postal zip code such as
-- 10009. This is in accordance with -
-- http:\/\/portablecontacts.net\/draft-spec.html#address_element.
cpaPostalCode :: Lens' CustomerPostalAddress (Maybe Text)
cpaPostalCode
  = lens _cpaPostalCode
      (\ s a -> s{_cpaPostalCode = a})

-- | A customer\'s physical address. The address can be composed of one to
-- three lines.
cpaAddressLine1 :: Lens' CustomerPostalAddress (Maybe Text)
cpaAddressLine1
  = lens _cpaAddressLine1
      (\ s a -> s{_cpaAddressLine1 = a})

-- | Name of the locality. An example of a locality value is the city of San
-- Francisco.
cpaLocality :: Lens' CustomerPostalAddress (Maybe Text)
cpaLocality
  = lens _cpaLocality (\ s a -> s{_cpaLocality = a})

-- | The customer contact\'s name.
cpaContactName :: Lens' CustomerPostalAddress (Maybe Text)
cpaContactName
  = lens _cpaContactName
      (\ s a -> s{_cpaContactName = a})

-- | Address line 2 of the address.
cpaAddressLine2 :: Lens' CustomerPostalAddress (Maybe Text)
cpaAddressLine2
  = lens _cpaAddressLine2
      (\ s a -> s{_cpaAddressLine2 = a})

-- | This is a required property. For countryCode information see the ISO
-- 3166 country code elements.
cpaCountryCode :: Lens' CustomerPostalAddress (Maybe Text)
cpaCountryCode
  = lens _cpaCountryCode
      (\ s a -> s{_cpaCountryCode = a})

-- | Name of the region. An example of a region value is NY for the state of
-- New York.
cpaRegion :: Lens' CustomerPostalAddress (Maybe Text)
cpaRegion
  = lens _cpaRegion (\ s a -> s{_cpaRegion = a})

-- | Address line 3 of the address.
cpaAddressLine3 :: Lens' CustomerPostalAddress (Maybe Text)
cpaAddressLine3
  = lens _cpaAddressLine3
      (\ s a -> s{_cpaAddressLine3 = a})

instance FromJSON CustomerPostalAddress where
        parseJSON
          = withObject "CustomerPostalAddress"
              (\ o ->
                 CustomerPostalAddress' <$>
                   (o .:? "organizationName") <*> (o .:? "postalCode")
                     <*> (o .:? "addressLine1")
                     <*> (o .:? "locality")
                     <*> (o .:? "contactName")
                     <*> (o .:? "addressLine2")
                     <*> (o .:? "countryCode")
                     <*> (o .:? "region")
                     <*> (o .:? "addressLine3"))

instance ToJSON CustomerPostalAddress where
        toJSON CustomerPostalAddress'{..}
          = object
              (catMaybes
                 [("organizationName" .=) <$> _cpaOrganizationName,
                  ("postalCode" .=) <$> _cpaPostalCode,
                  ("addressLine1" .=) <$> _cpaAddressLine1,
                  ("locality" .=) <$> _cpaLocality,
                  ("contactName" .=) <$> _cpaContactName,
                  ("addressLine2" .=) <$> _cpaAddressLine2,
                  ("countryCode" .=) <$> _cpaCountryCode,
                  ("region" .=) <$> _cpaRegion,
                  ("addressLine3" .=) <$> _cpaAddressLine3])

-- | JSON template for roleAssignment resource in Directory API.
--
-- /See:/ 'roleAssignment' smart constructor.
data RoleAssignment = RoleAssignment'
    { _rolEtag             :: !(Maybe Text)
    , _rolScopeType        :: !(Maybe Text)
    , _rolKind             :: !Text
    , _rolAssignedTo       :: !(Maybe Text)
    , _rolRoleId           :: !(Maybe (Textual Int64))
    , _rolRoleAssignmentId :: !(Maybe (Textual Int64))
    , _rolOrgUnitId        :: !(Maybe Text)
    } deriving (Eq,Show,Data,Typeable,Generic)

-- | Creates a value of 'RoleAssignment' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'rolEtag'
--
-- * 'rolScopeType'
--
-- * 'rolKind'
--
-- * 'rolAssignedTo'
--
-- * 'rolRoleId'
--
-- * 'rolRoleAssignmentId'
--
-- * 'rolOrgUnitId'
roleAssignment
    :: RoleAssignment
roleAssignment =
    RoleAssignment'
    { _rolEtag = Nothing
    , _rolScopeType = Nothing
    , _rolKind = "admin#directory#roleAssignment"
    , _rolAssignedTo = Nothing
    , _rolRoleId = Nothing
    , _rolRoleAssignmentId = Nothing
    , _rolOrgUnitId = Nothing
    }

-- | ETag of the resource.
rolEtag :: Lens' RoleAssignment (Maybe Text)
rolEtag = lens _rolEtag (\ s a -> s{_rolEtag = a})

-- | The scope in which this role is assigned. Possible values are: -
-- CUSTOMER - ORG_UNIT
rolScopeType :: Lens' RoleAssignment (Maybe Text)
rolScopeType
  = lens _rolScopeType (\ s a -> s{_rolScopeType = a})

-- | The type of the API resource. This is always
-- admin#directory#roleAssignment.
rolKind :: Lens' RoleAssignment Text
rolKind = lens _rolKind (\ s a -> s{_rolKind = a})

-- | The unique ID of the user this role is assigned to.
rolAssignedTo :: Lens' RoleAssignment (Maybe Text)
rolAssignedTo
  = lens _rolAssignedTo
      (\ s a -> s{_rolAssignedTo = a})

-- | The ID of the role that is assigned.
rolRoleId :: Lens' RoleAssignment (Maybe Int64)
rolRoleId
  = lens _rolRoleId (\ s a -> s{_rolRoleId = a}) .
      mapping _Coerce

-- | ID of this roleAssignment.
rolRoleAssignmentId :: Lens' RoleAssignment (Maybe Int64)
rolRoleAssignmentId
  = lens _rolRoleAssignmentId
      (\ s a -> s{_rolRoleAssignmentId = a})
      . mapping _Coerce

-- | If the role is restricted to an organization unit, this contains the ID
-- for the organization unit the exercise of this role is restricted to.
rolOrgUnitId :: Lens' RoleAssignment (Maybe Text)
rolOrgUnitId
  = lens _rolOrgUnitId (\ s a -> s{_rolOrgUnitId = a})

instance FromJSON RoleAssignment where
        parseJSON
          = withObject "RoleAssignment"
              (\ o ->
                 RoleAssignment' <$>
                   (o .:? "etag") <*> (o .:? "scopeType") <*>
                     (o .:? "kind" .!= "admin#directory#roleAssignment")
                     <*> (o .:? "assignedTo")
                     <*> (o .:? "roleId")
                     <*> (o .:? "roleAssignmentId")
                     <*> (o .:? "orgUnitId"))

instance ToJSON RoleAssignment where
        toJSON RoleAssignment'{..}
          = object
              (catMaybes
                 [("etag" .=) <$> _rolEtag,
                  ("scopeType" .=) <$> _rolScopeType,
                  Just ("kind" .= _rolKind),
                  ("assignedTo" .=) <$> _rolAssignedTo,
                  ("roleId" .=) <$> _rolRoleId,
                  ("roleAssignmentId" .=) <$> _rolRoleAssignmentId,
                  ("orgUnitId" .=) <$> _rolOrgUnitId])

-- | JSON template for Group resource in Directory API.
--
-- /See:/ 'group'' smart constructor.
data Group = Group'
    { _groEmail              :: !(Maybe Text)
    , _groEtag               :: !(Maybe Text)
    , _groDirectMembersCount :: !(Maybe (Textual Int64))
    , _groKind               :: !Text
    , _groAliases            :: !(Maybe [Text])
    , _groNonEditableAliases :: !(Maybe [Text])
    , _groName               :: !(Maybe Text)
    , _groAdminCreated       :: !(Maybe Bool)
    , _groId                 :: !(Maybe Text)
    , _groDescription        :: !(Maybe Text)
    } deriving (Eq,Show,Data,Typeable,Generic)

-- | Creates a value of 'Group' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'groEmail'
--
-- * 'groEtag'
--
-- * 'groDirectMembersCount'
--
-- * 'groKind'
--
-- * 'groAliases'
--
-- * 'groNonEditableAliases'
--
-- * 'groName'
--
-- * 'groAdminCreated'
--
-- * 'groId'
--
-- * 'groDescription'
group'
    :: Group
group' =
    Group'
    { _groEmail = Nothing
    , _groEtag = Nothing
    , _groDirectMembersCount = Nothing
    , _groKind = "admin#directory#group"
    , _groAliases = Nothing
    , _groNonEditableAliases = Nothing
    , _groName = Nothing
    , _groAdminCreated = Nothing
    , _groId = Nothing
    , _groDescription = Nothing
    }

-- | Email of Group
groEmail :: Lens' Group (Maybe Text)
groEmail = lens _groEmail (\ s a -> s{_groEmail = a})

-- | ETag of the resource.
groEtag :: Lens' Group (Maybe Text)
groEtag = lens _groEtag (\ s a -> s{_groEtag = a})

-- | Group direct members count
groDirectMembersCount :: Lens' Group (Maybe Int64)
groDirectMembersCount
  = lens _groDirectMembersCount
      (\ s a -> s{_groDirectMembersCount = a})
      . mapping _Coerce

-- | Kind of resource this is.
groKind :: Lens' Group Text
groKind = lens _groKind (\ s a -> s{_groKind = a})

-- | List of aliases (Read-only)
groAliases :: Lens' Group [Text]
groAliases
  = lens _groAliases (\ s a -> s{_groAliases = a}) .
      _Default
      . _Coerce

-- | List of non editable aliases (Read-only)
groNonEditableAliases :: Lens' Group [Text]
groNonEditableAliases
  = lens _groNonEditableAliases
      (\ s a -> s{_groNonEditableAliases = a})
      . _Default
      . _Coerce

-- | Group name
groName :: Lens' Group (Maybe Text)
groName = lens _groName (\ s a -> s{_groName = a})

-- | Is the group created by admin (Read-only) *
groAdminCreated :: Lens' Group (Maybe Bool)
groAdminCreated
  = lens _groAdminCreated
      (\ s a -> s{_groAdminCreated = a})

-- | Unique identifier of Group (Read-only)
groId :: Lens' Group (Maybe Text)
groId = lens _groId (\ s a -> s{_groId = a})

-- | Description of the group
groDescription :: Lens' Group (Maybe Text)
groDescription
  = lens _groDescription
      (\ s a -> s{_groDescription = a})

instance FromJSON Group where
        parseJSON
          = withObject "Group"
              (\ o ->
                 Group' <$>
                   (o .:? "email") <*> (o .:? "etag") <*>
                     (o .:? "directMembersCount")
                     <*> (o .:? "kind" .!= "admin#directory#group")
                     <*> (o .:? "aliases" .!= mempty)
                     <*> (o .:? "nonEditableAliases" .!= mempty)
                     <*> (o .:? "name")
                     <*> (o .:? "adminCreated")
                     <*> (o .:? "id")
                     <*> (o .:? "description"))

instance ToJSON Group where
        toJSON Group'{..}
          = object
              (catMaybes
                 [("email" .=) <$> _groEmail,
                  ("etag" .=) <$> _groEtag,
                  ("directMembersCount" .=) <$> _groDirectMembersCount,
                  Just ("kind" .= _groKind),
                  ("aliases" .=) <$> _groAliases,
                  ("nonEditableAliases" .=) <$> _groNonEditableAliases,
                  ("name" .=) <$> _groName,
                  ("adminCreated" .=) <$> _groAdminCreated,
                  ("id" .=) <$> _groId,
                  ("description" .=) <$> _groDescription])

-- | JSON template for Chrome Os Device resource in Directory API.
--
-- /See:/ 'chromeOSDevice' smart constructor.
data ChromeOSDevice = ChromeOSDevice'
    { _codStatus               :: !(Maybe Text)
    , _codEtag                 :: !(Maybe Text)
    , _codCPUStatusReports     :: !(Maybe [ChromeOSDeviceCPUStatusReportsItem])
    , _codAnnotatedUser        :: !(Maybe Text)
    , _codSystemRamFreeReports :: !(Maybe [ChromeOSDeviceSystemRamFreeReportsItem])
    , _codPlatformVersion      :: !(Maybe Text)
    , _codLastSync             :: !(Maybe DateTime')
    , _codActiveTimeRanges     :: !(Maybe [ChromeOSDeviceActiveTimeRangesItem])
    , _codKind                 :: !Text
    , _codEthernetMACAddress   :: !(Maybe Text)
    , _codLastEnrollmentTime   :: !(Maybe DateTime')
    , _codAnnotatedLocation    :: !(Maybe Text)
    , _codMACAddress           :: !(Maybe Text)
    , _codOrgUnitPath          :: !(Maybe Text)
    , _codRecentUsers          :: !(Maybe [ChromeOSDeviceRecentUsersItem])
    , _codSupportEndDate       :: !(Maybe DateTime')
    , _codModel                :: !(Maybe Text)
    , _codWillAutoRenew        :: !(Maybe Bool)
    , _codMeid                 :: !(Maybe Text)
    , _codDeviceFiles          :: !(Maybe [ChromeOSDeviceDeviceFilesItem])
    , _codDeviceId             :: !(Maybe Text)
    , _codBootMode             :: !(Maybe Text)
    , _codTpmVersionInfo       :: !(Maybe ChromeOSDeviceTpmVersionInfo)
    , _codOrderNumber          :: !(Maybe Text)
    , _codDiskVolumeReports    :: !(Maybe [ChromeOSDeviceDiskVolumeReportsItem])
    , _codAnnotatedAssetId     :: !(Maybe Text)
    , _codNotes                :: !(Maybe Text)
    , _codSerialNumber         :: !(Maybe Text)
    , _codFirmwareVersion      :: !(Maybe Text)
    , _codOSVersion            :: !(Maybe Text)
    , _codSystemRamTotal       :: !(Maybe (Textual Int64))
    } deriving (Eq,Show,Data,Typeable,Generic)

-- | Creates a value of 'ChromeOSDevice' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'codStatus'
--
-- * 'codEtag'
--
-- * 'codCPUStatusReports'
--
-- * 'codAnnotatedUser'
--
-- * 'codSystemRamFreeReports'
--
-- * 'codPlatformVersion'
--
-- * 'codLastSync'
--
-- * 'codActiveTimeRanges'
--
-- * 'codKind'
--
-- * 'codEthernetMACAddress'
--
-- * 'codLastEnrollmentTime'
--
-- * 'codAnnotatedLocation'
--
-- * 'codMACAddress'
--
-- * 'codOrgUnitPath'
--
-- * 'codRecentUsers'
--
-- * 'codSupportEndDate'
--
-- * 'codModel'
--
-- * 'codWillAutoRenew'
--
-- * 'codMeid'
--
-- * 'codDeviceFiles'
--
-- * 'codDeviceId'
--
-- * 'codBootMode'
--
-- * 'codTpmVersionInfo'
--
-- * 'codOrderNumber'
--
-- * 'codDiskVolumeReports'
--
-- * 'codAnnotatedAssetId'
--
-- * 'codNotes'
--
-- * 'codSerialNumber'
--
-- * 'codFirmwareVersion'
--
-- * 'codOSVersion'
--
-- * 'codSystemRamTotal'
chromeOSDevice
    :: ChromeOSDevice
chromeOSDevice =
    ChromeOSDevice'
    { _codStatus = Nothing
    , _codEtag = Nothing
    , _codCPUStatusReports = Nothing
    , _codAnnotatedUser = Nothing
    , _codSystemRamFreeReports = Nothing
    , _codPlatformVersion = Nothing
    , _codLastSync = Nothing
    , _codActiveTimeRanges = Nothing
    , _codKind = "admin#directory#chromeosdevice"
    , _codEthernetMACAddress = Nothing
    , _codLastEnrollmentTime = Nothing
    , _codAnnotatedLocation = Nothing
    , _codMACAddress = Nothing
    , _codOrgUnitPath = Nothing
    , _codRecentUsers = Nothing
    , _codSupportEndDate = Nothing
    , _codModel = Nothing
    , _codWillAutoRenew = Nothing
    , _codMeid = Nothing
    , _codDeviceFiles = Nothing
    , _codDeviceId = Nothing
    , _codBootMode = Nothing
    , _codTpmVersionInfo = Nothing
    , _codOrderNumber = Nothing
    , _codDiskVolumeReports = Nothing
    , _codAnnotatedAssetId = Nothing
    , _codNotes = Nothing
    , _codSerialNumber = Nothing
    , _codFirmwareVersion = Nothing
    , _codOSVersion = Nothing
    , _codSystemRamTotal = Nothing
    }

-- | status of the device (Read-only)
codStatus :: Lens' ChromeOSDevice (Maybe Text)
codStatus
  = lens _codStatus (\ s a -> s{_codStatus = a})

-- | ETag of the resource.
codEtag :: Lens' ChromeOSDevice (Maybe Text)
codEtag = lens _codEtag (\ s a -> s{_codEtag = a})

-- | Reports of CPU utilization and temperature (Read-only)
codCPUStatusReports :: Lens' ChromeOSDevice [ChromeOSDeviceCPUStatusReportsItem]
codCPUStatusReports
  = lens _codCPUStatusReports
      (\ s a -> s{_codCPUStatusReports = a})
      . _Default
      . _Coerce

-- | User of the device
codAnnotatedUser :: Lens' ChromeOSDevice (Maybe Text)
codAnnotatedUser
  = lens _codAnnotatedUser
      (\ s a -> s{_codAnnotatedUser = a})

-- | Reports of amounts of available RAM memory (Read-only)
codSystemRamFreeReports :: Lens' ChromeOSDevice [ChromeOSDeviceSystemRamFreeReportsItem]
codSystemRamFreeReports
  = lens _codSystemRamFreeReports
      (\ s a -> s{_codSystemRamFreeReports = a})
      . _Default
      . _Coerce

-- | Chromebook platform version (Read-only)
codPlatformVersion :: Lens' ChromeOSDevice (Maybe Text)
codPlatformVersion
  = lens _codPlatformVersion
      (\ s a -> s{_codPlatformVersion = a})

-- | Date and time the device was last synchronized with the policy settings
-- in the G Suite administrator control panel (Read-only)
codLastSync :: Lens' ChromeOSDevice (Maybe UTCTime)
codLastSync
  = lens _codLastSync (\ s a -> s{_codLastSync = a}) .
      mapping _DateTime

-- | List of active time ranges (Read-only)
codActiveTimeRanges :: Lens' ChromeOSDevice [ChromeOSDeviceActiveTimeRangesItem]
codActiveTimeRanges
  = lens _codActiveTimeRanges
      (\ s a -> s{_codActiveTimeRanges = a})
      . _Default
      . _Coerce

-- | Kind of resource this is.
codKind :: Lens' ChromeOSDevice Text
codKind = lens _codKind (\ s a -> s{_codKind = a})

-- | Chromebook Mac Address on ethernet network interface (Read-only)
codEthernetMACAddress :: Lens' ChromeOSDevice (Maybe Text)
codEthernetMACAddress
  = lens _codEthernetMACAddress
      (\ s a -> s{_codEthernetMACAddress = a})

-- | Date and time the device was last enrolled (Read-only)
codLastEnrollmentTime :: Lens' ChromeOSDevice (Maybe UTCTime)
codLastEnrollmentTime
  = lens _codLastEnrollmentTime
      (\ s a -> s{_codLastEnrollmentTime = a})
      . mapping _DateTime

-- | Address or location of the device as noted by the administrator
codAnnotatedLocation :: Lens' ChromeOSDevice (Maybe Text)
codAnnotatedLocation
  = lens _codAnnotatedLocation
      (\ s a -> s{_codAnnotatedLocation = a})

-- | Chromebook Mac Address on wifi network interface (Read-only)
codMACAddress :: Lens' ChromeOSDevice (Maybe Text)
codMACAddress
  = lens _codMACAddress
      (\ s a -> s{_codMACAddress = a})

-- | OrgUnit of the device
codOrgUnitPath :: Lens' ChromeOSDevice (Maybe Text)
codOrgUnitPath
  = lens _codOrgUnitPath
      (\ s a -> s{_codOrgUnitPath = a})

-- | List of recent device users, in descending order by last login time
-- (Read-only)
codRecentUsers :: Lens' ChromeOSDevice [ChromeOSDeviceRecentUsersItem]
codRecentUsers
  = lens _codRecentUsers
      (\ s a -> s{_codRecentUsers = a})
      . _Default
      . _Coerce

-- | Final date the device will be supported (Read-only)
codSupportEndDate :: Lens' ChromeOSDevice (Maybe UTCTime)
codSupportEndDate
  = lens _codSupportEndDate
      (\ s a -> s{_codSupportEndDate = a})
      . mapping _DateTime

-- | Chromebook Model (Read-only)
codModel :: Lens' ChromeOSDevice (Maybe Text)
codModel = lens _codModel (\ s a -> s{_codModel = a})

-- | Will Chromebook auto renew after support end date (Read-only)
codWillAutoRenew :: Lens' ChromeOSDevice (Maybe Bool)
codWillAutoRenew
  = lens _codWillAutoRenew
      (\ s a -> s{_codWillAutoRenew = a})

-- | Mobile Equipment identifier for the 3G mobile card in the Chromebook
-- (Read-only)
codMeid :: Lens' ChromeOSDevice (Maybe Text)
codMeid = lens _codMeid (\ s a -> s{_codMeid = a})

-- | List of device files to download (Read-only)
codDeviceFiles :: Lens' ChromeOSDevice [ChromeOSDeviceDeviceFilesItem]
codDeviceFiles
  = lens _codDeviceFiles
      (\ s a -> s{_codDeviceFiles = a})
      . _Default
      . _Coerce

-- | Unique identifier of Chrome OS Device (Read-only)
codDeviceId :: Lens' ChromeOSDevice (Maybe Text)
codDeviceId
  = lens _codDeviceId (\ s a -> s{_codDeviceId = a})

-- | Chromebook boot mode (Read-only)
codBootMode :: Lens' ChromeOSDevice (Maybe Text)
codBootMode
  = lens _codBootMode (\ s a -> s{_codBootMode = a})

-- | Trusted Platform Module (TPM) (Read-only)
codTpmVersionInfo :: Lens' ChromeOSDevice (Maybe ChromeOSDeviceTpmVersionInfo)
codTpmVersionInfo
  = lens _codTpmVersionInfo
      (\ s a -> s{_codTpmVersionInfo = a})

-- | Chromebook order number (Read-only)
codOrderNumber :: Lens' ChromeOSDevice (Maybe Text)
codOrderNumber
  = lens _codOrderNumber
      (\ s a -> s{_codOrderNumber = a})

-- | Reports of disk space and other info about mounted\/connected volumes.
codDiskVolumeReports :: Lens' ChromeOSDevice [ChromeOSDeviceDiskVolumeReportsItem]
codDiskVolumeReports
  = lens _codDiskVolumeReports
      (\ s a -> s{_codDiskVolumeReports = a})
      . _Default
      . _Coerce

-- | AssetId specified during enrollment or through later annotation
codAnnotatedAssetId :: Lens' ChromeOSDevice (Maybe Text)
codAnnotatedAssetId
  = lens _codAnnotatedAssetId
      (\ s a -> s{_codAnnotatedAssetId = a})

-- | Notes added by the administrator
codNotes :: Lens' ChromeOSDevice (Maybe Text)
codNotes = lens _codNotes (\ s a -> s{_codNotes = a})

-- | Chromebook serial number (Read-only)
codSerialNumber :: Lens' ChromeOSDevice (Maybe Text)
codSerialNumber
  = lens _codSerialNumber
      (\ s a -> s{_codSerialNumber = a})

-- | Chromebook firmware version (Read-only)
codFirmwareVersion :: Lens' ChromeOSDevice (Maybe Text)
codFirmwareVersion
  = lens _codFirmwareVersion
      (\ s a -> s{_codFirmwareVersion = a})

-- | Chromebook Os Version (Read-only)
codOSVersion :: Lens' ChromeOSDevice (Maybe Text)
codOSVersion
  = lens _codOSVersion (\ s a -> s{_codOSVersion = a})

-- | Total RAM on the device [in bytes] (Read-only)
codSystemRamTotal :: Lens' ChromeOSDevice (Maybe Int64)
codSystemRamTotal
  = lens _codSystemRamTotal
      (\ s a -> s{_codSystemRamTotal = a})
      . mapping _Coerce

instance FromJSON ChromeOSDevice where
        parseJSON
          = withObject "ChromeOSDevice"
              (\ o ->
                 ChromeOSDevice' <$>
                   (o .:? "status") <*> (o .:? "etag") <*>
                     (o .:? "cpuStatusReports" .!= mempty)
                     <*> (o .:? "annotatedUser")
                     <*> (o .:? "systemRamFreeReports" .!= mempty)
                     <*> (o .:? "platformVersion")
                     <*> (o .:? "lastSync")
                     <*> (o .:? "activeTimeRanges" .!= mempty)
                     <*>
                     (o .:? "kind" .!= "admin#directory#chromeosdevice")
                     <*> (o .:? "ethernetMacAddress")
                     <*> (o .:? "lastEnrollmentTime")
                     <*> (o .:? "annotatedLocation")
                     <*> (o .:? "macAddress")
                     <*> (o .:? "orgUnitPath")
                     <*> (o .:? "recentUsers" .!= mempty)
                     <*> (o .:? "supportEndDate")
                     <*> (o .:? "model")
                     <*> (o .:? "willAutoRenew")
                     <*> (o .:? "meid")
                     <*> (o .:? "deviceFiles" .!= mempty)
                     <*> (o .:? "deviceId")
                     <*> (o .:? "bootMode")
                     <*> (o .:? "tpmVersionInfo")
                     <*> (o .:? "orderNumber")
                     <*> (o .:? "diskVolumeReports" .!= mempty)
                     <*> (o .:? "annotatedAssetId")
                     <*> (o .:? "notes")
                     <*> (o .:? "serialNumber")
                     <*> (o .:? "firmwareVersion")
                     <*> (o .:? "osVersion")
                     <*> (o .:? "systemRamTotal"))

instance ToJSON ChromeOSDevice where
        toJSON ChromeOSDevice'{..}
          = object
              (catMaybes
                 [("status" .=) <$> _codStatus,
                  ("etag" .=) <$> _codEtag,
                  ("cpuStatusReports" .=) <$> _codCPUStatusReports,
                  ("annotatedUser" .=) <$> _codAnnotatedUser,
                  ("systemRamFreeReports" .=) <$>
                    _codSystemRamFreeReports,
                  ("platformVersion" .=) <$> _codPlatformVersion,
                  ("lastSync" .=) <$> _codLastSync,
                  ("activeTimeRanges" .=) <$> _codActiveTimeRanges,
                  Just ("kind" .= _codKind),
                  ("ethernetMacAddress" .=) <$> _codEthernetMACAddress,
                  ("lastEnrollmentTime" .=) <$> _codLastEnrollmentTime,
                  ("annotatedLocation" .=) <$> _codAnnotatedLocation,
                  ("macAddress" .=) <$> _codMACAddress,
                  ("orgUnitPath" .=) <$> _codOrgUnitPath,
                  ("recentUsers" .=) <$> _codRecentUsers,
                  ("supportEndDate" .=) <$> _codSupportEndDate,
                  ("model" .=) <$> _codModel,
                  ("willAutoRenew" .=) <$> _codWillAutoRenew,
                  ("meid" .=) <$> _codMeid,
                  ("deviceFiles" .=) <$> _codDeviceFiles,
                  ("deviceId" .=) <$> _codDeviceId,
                  ("bootMode" .=) <$> _codBootMode,
                  ("tpmVersionInfo" .=) <$> _codTpmVersionInfo,
                  ("orderNumber" .=) <$> _codOrderNumber,
                  ("diskVolumeReports" .=) <$> _codDiskVolumeReports,
                  ("annotatedAssetId" .=) <$> _codAnnotatedAssetId,
                  ("notes" .=) <$> _codNotes,
                  ("serialNumber" .=) <$> _codSerialNumber,
                  ("firmwareVersion" .=) <$> _codFirmwareVersion,
                  ("osVersion" .=) <$> _codOSVersion,
                  ("systemRamTotal" .=) <$> _codSystemRamTotal])

-- | JSON response template for List Users operation in Apps Directory API.
--
-- /See:/ 'users' smart constructor.
data Users = Users'
    { _uEtag          :: !(Maybe Text)
    , _uNextPageToken :: !(Maybe Text)
    , _uUsers         :: !(Maybe [User])
    , _uKind          :: !Text
    , _uTriggerEvent  :: !(Maybe Text)
    } deriving (Eq,Show,Data,Typeable,Generic)

-- | Creates a value of 'Users' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'uEtag'
--
-- * 'uNextPageToken'
--
-- * 'uUsers'
--
-- * 'uKind'
--
-- * 'uTriggerEvent'
users
    :: Users
users =
    Users'
    { _uEtag = Nothing
    , _uNextPageToken = Nothing
    , _uUsers = Nothing
    , _uKind = "admin#directory#users"
    , _uTriggerEvent = Nothing
    }

-- | ETag of the resource.
uEtag :: Lens' Users (Maybe Text)
uEtag = lens _uEtag (\ s a -> s{_uEtag = a})

-- | Token used to access next page of this result.
uNextPageToken :: Lens' Users (Maybe Text)
uNextPageToken
  = lens _uNextPageToken
      (\ s a -> s{_uNextPageToken = a})

-- | List of user objects.
uUsers :: Lens' Users [User]
uUsers
  = lens _uUsers (\ s a -> s{_uUsers = a}) . _Default .
      _Coerce

-- | Kind of resource this is.
uKind :: Lens' Users Text
uKind = lens _uKind (\ s a -> s{_uKind = a})

-- | Event that triggered this response (only used in case of Push Response)
uTriggerEvent :: Lens' Users (Maybe Text)
uTriggerEvent
  = lens _uTriggerEvent
      (\ s a -> s{_uTriggerEvent = a})

instance FromJSON Users where
        parseJSON
          = withObject "Users"
              (\ o ->
                 Users' <$>
                   (o .:? "etag") <*> (o .:? "nextPageToken") <*>
                     (o .:? "users" .!= mempty)
                     <*> (o .:? "kind" .!= "admin#directory#users")
                     <*> (o .:? "trigger_event"))

instance ToJSON Users where
        toJSON Users'{..}
          = object
              (catMaybes
                 [("etag" .=) <$> _uEtag,
                  ("nextPageToken" .=) <$> _uNextPageToken,
                  ("users" .=) <$> _uUsers, Just ("kind" .= _uKind),
                  ("trigger_event" .=) <$> _uTriggerEvent])

-- | The template that returns individual ASP (Access Code) data.
--
-- /See:/ 'asp' smart constructor.
data Asp = Asp'
    { _aCreationTime :: !(Maybe (Textual Int64))
    , _aEtag         :: !(Maybe Text)
    , _aCodeId       :: !(Maybe (Textual Int32))
    , _aKind         :: !Text
    , _aName         :: !(Maybe Text)
    , _aLastTimeUsed :: !(Maybe (Textual Int64))
    , _aUserKey      :: !(Maybe Text)
    } deriving (Eq,Show,Data,Typeable,Generic)

-- | Creates a value of 'Asp' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'aCreationTime'
--
-- * 'aEtag'
--
-- * 'aCodeId'
--
-- * 'aKind'
--
-- * 'aName'
--
-- * 'aLastTimeUsed'
--
-- * 'aUserKey'
asp
    :: Asp
asp =
    Asp'
    { _aCreationTime = Nothing
    , _aEtag = Nothing
    , _aCodeId = Nothing
    , _aKind = "admin#directory#asp"
    , _aName = Nothing
    , _aLastTimeUsed = Nothing
    , _aUserKey = Nothing
    }

-- | The time when the ASP was created. Expressed in Unix time format.
aCreationTime :: Lens' Asp (Maybe Int64)
aCreationTime
  = lens _aCreationTime
      (\ s a -> s{_aCreationTime = a})
      . mapping _Coerce

-- | ETag of the ASP.
aEtag :: Lens' Asp (Maybe Text)
aEtag = lens _aEtag (\ s a -> s{_aEtag = a})

-- | The unique ID of the ASP.
aCodeId :: Lens' Asp (Maybe Int32)
aCodeId
  = lens _aCodeId (\ s a -> s{_aCodeId = a}) .
      mapping _Coerce

-- | The type of the API resource. This is always admin#directory#asp.
aKind :: Lens' Asp Text
aKind = lens _aKind (\ s a -> s{_aKind = a})

-- | The name of the application that the user, represented by their userId,
-- entered when the ASP was created.
aName :: Lens' Asp (Maybe Text)
aName = lens _aName (\ s a -> s{_aName = a})

-- | The time when the ASP was last used. Expressed in Unix time format.
aLastTimeUsed :: Lens' Asp (Maybe Int64)
aLastTimeUsed
  = lens _aLastTimeUsed
      (\ s a -> s{_aLastTimeUsed = a})
      . mapping _Coerce

-- | The unique ID of the user who issued the ASP.
aUserKey :: Lens' Asp (Maybe Text)
aUserKey = lens _aUserKey (\ s a -> s{_aUserKey = a})

instance FromJSON Asp where
        parseJSON
          = withObject "Asp"
              (\ o ->
                 Asp' <$>
                   (o .:? "creationTime") <*> (o .:? "etag") <*>
                     (o .:? "codeId")
                     <*> (o .:? "kind" .!= "admin#directory#asp")
                     <*> (o .:? "name")
                     <*> (o .:? "lastTimeUsed")
                     <*> (o .:? "userKey"))

instance ToJSON Asp where
        toJSON Asp'{..}
          = object
              (catMaybes
                 [("creationTime" .=) <$> _aCreationTime,
                  ("etag" .=) <$> _aEtag, ("codeId" .=) <$> _aCodeId,
                  Just ("kind" .= _aKind), ("name" .=) <$> _aName,
                  ("lastTimeUsed" .=) <$> _aLastTimeUsed,
                  ("userKey" .=) <$> _aUserKey])

-- | JSON response template for List Schema operation in Directory API.
--
-- /See:/ 'schemas' smart constructor.
data Schemas = Schemas'
    { _sEtag    :: !(Maybe Text)
    , _sSchemas :: !(Maybe [Schema])
    , _sKind    :: !Text
    } deriving (Eq,Show,Data,Typeable,Generic)

-- | Creates a value of 'Schemas' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'sEtag'
--
-- * 'sSchemas'
--
-- * 'sKind'
schemas
    :: Schemas
schemas =
    Schemas'
    { _sEtag = Nothing
    , _sSchemas = Nothing
    , _sKind = "admin#directory#schemas"
    }

-- | ETag of the resource.
sEtag :: Lens' Schemas (Maybe Text)
sEtag = lens _sEtag (\ s a -> s{_sEtag = a})

-- | List of UserSchema objects.
sSchemas :: Lens' Schemas [Schema]
sSchemas
  = lens _sSchemas (\ s a -> s{_sSchemas = a}) .
      _Default
      . _Coerce

-- | Kind of resource this is.
sKind :: Lens' Schemas Text
sKind = lens _sKind (\ s a -> s{_sKind = a})

instance FromJSON Schemas where
        parseJSON
          = withObject "Schemas"
              (\ o ->
                 Schemas' <$>
                   (o .:? "etag") <*> (o .:? "schemas" .!= mempty) <*>
                     (o .:? "kind" .!= "admin#directory#schemas"))

instance ToJSON Schemas where
        toJSON Schemas'{..}
          = object
              (catMaybes
                 [("etag" .=) <$> _sEtag,
                  ("schemas" .=) <$> _sSchemas,
                  Just ("kind" .= _sKind)])

--
-- /See:/ 'chromeOSDeviceDeviceFilesItem' smart constructor.
data ChromeOSDeviceDeviceFilesItem = ChromeOSDeviceDeviceFilesItem'
    { _coddfiName        :: !(Maybe Text)
    , _coddfiDownloadURL :: !(Maybe Text)
    , _coddfiType        :: !(Maybe Text)
    , _coddfiCreateTime  :: !(Maybe DateTime')
    } deriving (Eq,Show,Data,Typeable,Generic)

-- | Creates a value of 'ChromeOSDeviceDeviceFilesItem' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'coddfiName'
--
-- * 'coddfiDownloadURL'
--
-- * 'coddfiType'
--
-- * 'coddfiCreateTime'
chromeOSDeviceDeviceFilesItem
    :: ChromeOSDeviceDeviceFilesItem
chromeOSDeviceDeviceFilesItem =
    ChromeOSDeviceDeviceFilesItem'
    { _coddfiName = Nothing
    , _coddfiDownloadURL = Nothing
    , _coddfiType = Nothing
    , _coddfiCreateTime = Nothing
    }

-- | File name
coddfiName :: Lens' ChromeOSDeviceDeviceFilesItem (Maybe Text)
coddfiName
  = lens _coddfiName (\ s a -> s{_coddfiName = a})

-- | File download URL
coddfiDownloadURL :: Lens' ChromeOSDeviceDeviceFilesItem (Maybe Text)
coddfiDownloadURL
  = lens _coddfiDownloadURL
      (\ s a -> s{_coddfiDownloadURL = a})

-- | File type
coddfiType :: Lens' ChromeOSDeviceDeviceFilesItem (Maybe Text)
coddfiType
  = lens _coddfiType (\ s a -> s{_coddfiType = a})

-- | Date and time the file was created
coddfiCreateTime :: Lens' ChromeOSDeviceDeviceFilesItem (Maybe UTCTime)
coddfiCreateTime
  = lens _coddfiCreateTime
      (\ s a -> s{_coddfiCreateTime = a})
      . mapping _DateTime

instance FromJSON ChromeOSDeviceDeviceFilesItem where
        parseJSON
          = withObject "ChromeOSDeviceDeviceFilesItem"
              (\ o ->
                 ChromeOSDeviceDeviceFilesItem' <$>
                   (o .:? "name") <*> (o .:? "downloadUrl") <*>
                     (o .:? "type")
                     <*> (o .:? "createTime"))

instance ToJSON ChromeOSDeviceDeviceFilesItem where
        toJSON ChromeOSDeviceDeviceFilesItem'{..}
          = object
              (catMaybes
                 [("name" .=) <$> _coddfiName,
                  ("downloadUrl" .=) <$> _coddfiDownloadURL,
                  ("type" .=) <$> _coddfiType,
                  ("createTime" .=) <$> _coddfiCreateTime])

-- | JSON template for Building List Response object in Directory API.
--
-- /See:/ 'buildings' smart constructor.
data Buildings = Buildings'
    { _bEtag          :: !(Maybe Text)
    , _bNextPageToken :: !(Maybe Text)
    , _bBuildings     :: !(Maybe [Building])
    , _bKind          :: !Text
    } deriving (Eq,Show,Data,Typeable,Generic)

-- | Creates a value of 'Buildings' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'bEtag'
--
-- * 'bNextPageToken'
--
-- * 'bBuildings'
--
-- * 'bKind'
buildings
    :: Buildings
buildings =
    Buildings'
    { _bEtag = Nothing
    , _bNextPageToken = Nothing
    , _bBuildings = Nothing
    , _bKind = "admin#directory#resources#buildings#buildingsList"
    }

-- | ETag of the resource.
bEtag :: Lens' Buildings (Maybe Text)
bEtag = lens _bEtag (\ s a -> s{_bEtag = a})

-- | The continuation token, used to page through large result sets. Provide
-- this value in a subsequent request to return the next page of results.
bNextPageToken :: Lens' Buildings (Maybe Text)
bNextPageToken
  = lens _bNextPageToken
      (\ s a -> s{_bNextPageToken = a})

-- | The Buildings in this page of results.
bBuildings :: Lens' Buildings [Building]
bBuildings
  = lens _bBuildings (\ s a -> s{_bBuildings = a}) .
      _Default
      . _Coerce

-- | Kind of resource this is.
bKind :: Lens' Buildings Text
bKind = lens _bKind (\ s a -> s{_bKind = a})

instance FromJSON Buildings where
        parseJSON
          = withObject "Buildings"
              (\ o ->
                 Buildings' <$>
                   (o .:? "etag") <*> (o .:? "nextPageToken") <*>
                     (o .:? "buildings" .!= mempty)
                     <*>
                     (o .:? "kind" .!=
                        "admin#directory#resources#buildings#buildingsList"))

instance ToJSON Buildings where
        toJSON Buildings'{..}
          = object
              (catMaybes
                 [("etag" .=) <$> _bEtag,
                  ("nextPageToken" .=) <$> _bNextPageToken,
                  ("buildings" .=) <$> _bBuildings,
                  Just ("kind" .= _bKind)])

-- | Template for a notification resource.
--
-- /See:/ 'notification' smart constructor.
data Notification = Notification'
    { _nSubject        :: !(Maybe Text)
    , _nEtag           :: !(Maybe Text)
    , _nKind           :: !Text
    , _nBody           :: !(Maybe Text)
    , _nFromAddress    :: !(Maybe Text)
    , _nIsUnread       :: !(Maybe Bool)
    , _nNotificationId :: !(Maybe Text)
    , _nSendTime       :: !(Maybe DateTime')
    } deriving (Eq,Show,Data,Typeable,Generic)

-- | Creates a value of 'Notification' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'nSubject'
--
-- * 'nEtag'
--
-- * 'nKind'
--
-- * 'nBody'
--
-- * 'nFromAddress'
--
-- * 'nIsUnread'
--
-- * 'nNotificationId'
--
-- * 'nSendTime'
notification
    :: Notification
notification =
    Notification'
    { _nSubject = Nothing
    , _nEtag = Nothing
    , _nKind = "admin#directory#notification"
    , _nBody = Nothing
    , _nFromAddress = Nothing
    , _nIsUnread = Nothing
    , _nNotificationId = Nothing
    , _nSendTime = Nothing
    }

-- | Subject of the notification (Read-only)
nSubject :: Lens' Notification (Maybe Text)
nSubject = lens _nSubject (\ s a -> s{_nSubject = a})

-- | ETag of the resource.
nEtag :: Lens' Notification (Maybe Text)
nEtag = lens _nEtag (\ s a -> s{_nEtag = a})

-- | The type of the resource.
nKind :: Lens' Notification Text
nKind = lens _nKind (\ s a -> s{_nKind = a})

-- | Body of the notification (Read-only)
nBody :: Lens' Notification (Maybe Text)
nBody = lens _nBody (\ s a -> s{_nBody = a})

-- | Address from which the notification is received (Read-only)
nFromAddress :: Lens' Notification (Maybe Text)
nFromAddress
  = lens _nFromAddress (\ s a -> s{_nFromAddress = a})

-- | Boolean indicating whether the notification is unread or not.
nIsUnread :: Lens' Notification (Maybe Bool)
nIsUnread
  = lens _nIsUnread (\ s a -> s{_nIsUnread = a})

nNotificationId :: Lens' Notification (Maybe Text)
nNotificationId
  = lens _nNotificationId
      (\ s a -> s{_nNotificationId = a})

-- | Time at which notification was sent (Read-only)
nSendTime :: Lens' Notification (Maybe UTCTime)
nSendTime
  = lens _nSendTime (\ s a -> s{_nSendTime = a}) .
      mapping _DateTime

instance FromJSON Notification where
        parseJSON
          = withObject "Notification"
              (\ o ->
                 Notification' <$>
                   (o .:? "subject") <*> (o .:? "etag") <*>
                     (o .:? "kind" .!= "admin#directory#notification")
                     <*> (o .:? "body")
                     <*> (o .:? "fromAddress")
                     <*> (o .:? "isUnread")
                     <*> (o .:? "notificationId")
                     <*> (o .:? "sendTime"))

instance ToJSON Notification where
        toJSON Notification'{..}
          = object
              (catMaybes
                 [("subject" .=) <$> _nSubject,
                  ("etag" .=) <$> _nEtag, Just ("kind" .= _nKind),
                  ("body" .=) <$> _nBody,
                  ("fromAddress" .=) <$> _nFromAddress,
                  ("isUnread" .=) <$> _nIsUnread,
                  ("notificationId" .=) <$> _nNotificationId,
                  ("sendTime" .=) <$> _nSendTime])

-- | JSON template for instant messenger of an user.
--
-- /See:/ 'userIm' smart constructor.
data UserIm = UserIm'
    { _uiIm             :: !(Maybe Text)
    , _uiProtocol       :: !(Maybe Text)
    , _uiPrimary        :: !(Maybe Bool)
    , _uiCustomProtocol :: !(Maybe Text)
    , _uiType           :: !(Maybe Text)
    , _uiCustomType     :: !(Maybe Text)
    } deriving (Eq,Show,Data,Typeable,Generic)

-- | Creates a value of 'UserIm' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'uiIm'
--
-- * 'uiProtocol'
--
-- * 'uiPrimary'
--
-- * 'uiCustomProtocol'
--
-- * 'uiType'
--
-- * 'uiCustomType'
userIm
    :: UserIm
userIm =
    UserIm'
    { _uiIm = Nothing
    , _uiProtocol = Nothing
    , _uiPrimary = Nothing
    , _uiCustomProtocol = Nothing
    , _uiType = Nothing
    , _uiCustomType = Nothing
    }

-- | Instant messenger id.
uiIm :: Lens' UserIm (Maybe Text)
uiIm = lens _uiIm (\ s a -> s{_uiIm = a})

-- | Protocol used in the instant messenger. It should be one of the values
-- from ImProtocolTypes map. Similar to type, it can take a CUSTOM value
-- and specify the custom name in customProtocol field.
uiProtocol :: Lens' UserIm (Maybe Text)
uiProtocol
  = lens _uiProtocol (\ s a -> s{_uiProtocol = a})

-- | If this is user\'s primary im. Only one entry could be marked as
-- primary.
uiPrimary :: Lens' UserIm (Maybe Bool)
uiPrimary
  = lens _uiPrimary (\ s a -> s{_uiPrimary = a})

-- | Custom protocol.
uiCustomProtocol :: Lens' UserIm (Maybe Text)
uiCustomProtocol
  = lens _uiCustomProtocol
      (\ s a -> s{_uiCustomProtocol = a})

-- | Each entry can have a type which indicates standard types of that entry.
-- For example instant messengers could be of home, work etc. In addition
-- to the standard type, an entry can have a custom type and can take any
-- value. Such types should have the CUSTOM value as type and also have a
-- customType value.
uiType :: Lens' UserIm (Maybe Text)
uiType = lens _uiType (\ s a -> s{_uiType = a})

-- | Custom type.
uiCustomType :: Lens' UserIm (Maybe Text)
uiCustomType
  = lens _uiCustomType (\ s a -> s{_uiCustomType = a})

instance FromJSON UserIm where
        parseJSON
          = withObject "UserIm"
              (\ o ->
                 UserIm' <$>
                   (o .:? "im") <*> (o .:? "protocol") <*>
                     (o .:? "primary")
                     <*> (o .:? "customProtocol")
                     <*> (o .:? "type")
                     <*> (o .:? "customType"))

instance ToJSON UserIm where
        toJSON UserIm'{..}
          = object
              (catMaybes
                 [("im" .=) <$> _uiIm,
                  ("protocol" .=) <$> _uiProtocol,
                  ("primary" .=) <$> _uiPrimary,
                  ("customProtocol" .=) <$> _uiCustomProtocol,
                  ("type" .=) <$> _uiType,
                  ("customType" .=) <$> _uiCustomType])

-- | JSON response template for List tokens operation in Directory API.
--
-- /See:/ 'tokens' smart constructor.
data Tokens = Tokens'
    { _tEtag  :: !(Maybe Text)
    , _tKind  :: !Text
    , _tItems :: !(Maybe [Token])
    } deriving (Eq,Show,Data,Typeable,Generic)

-- | Creates a value of 'Tokens' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'tEtag'
--
-- * 'tKind'
--
-- * 'tItems'
tokens
    :: Tokens
tokens =
    Tokens'
    { _tEtag = Nothing
    , _tKind = "admin#directory#tokenList"
    , _tItems = Nothing
    }

-- | ETag of the resource.
tEtag :: Lens' Tokens (Maybe Text)
tEtag = lens _tEtag (\ s a -> s{_tEtag = a})

-- | The type of the API resource. This is always admin#directory#tokenList.
tKind :: Lens' Tokens Text
tKind = lens _tKind (\ s a -> s{_tKind = a})

-- | A list of Token resources.
tItems :: Lens' Tokens [Token]
tItems
  = lens _tItems (\ s a -> s{_tItems = a}) . _Default .
      _Coerce

instance FromJSON Tokens where
        parseJSON
          = withObject "Tokens"
              (\ o ->
                 Tokens' <$>
                   (o .:? "etag") <*>
                     (o .:? "kind" .!= "admin#directory#tokenList")
                     <*> (o .:? "items" .!= mempty))

instance ToJSON Tokens where
        toJSON Tokens'{..}
          = object
              (catMaybes
                 [("etag" .=) <$> _tEtag, Just ("kind" .= _tKind),
                  ("items" .=) <$> _tItems])

-- | Custom fields of the user.
--
-- /See:/ 'userCustomSchemas' smart constructor.
newtype UserCustomSchemas = UserCustomSchemas'
    { _ucsAddtional :: HashMap Text UserCustomProperties
    } deriving (Eq,Show,Data,Typeable,Generic)

-- | Creates a value of 'UserCustomSchemas' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'ucsAddtional'
userCustomSchemas
    :: HashMap Text UserCustomProperties -- ^ 'ucsAddtional'
    -> UserCustomSchemas
userCustomSchemas pUcsAddtional_ =
    UserCustomSchemas'
    { _ucsAddtional = _Coerce # pUcsAddtional_
    }

ucsAddtional :: Lens' UserCustomSchemas (HashMap Text UserCustomProperties)
ucsAddtional
  = lens _ucsAddtional (\ s a -> s{_ucsAddtional = a})
      . _Coerce

instance FromJSON UserCustomSchemas where
        parseJSON
          = withObject "UserCustomSchemas"
              (\ o -> UserCustomSchemas' <$> (parseJSONObject o))

instance ToJSON UserCustomSchemas where
        toJSON = toJSON . _ucsAddtional

-- | JSON template for a keyword entry.
--
-- /See:/ 'userKeyword' smart constructor.
data UserKeyword = UserKeyword'
    { _ukValue      :: !(Maybe Text)
    , _ukType       :: !(Maybe Text)
    , _ukCustomType :: !(Maybe Text)
    } deriving (Eq,Show,Data,Typeable,Generic)

-- | Creates a value of 'UserKeyword' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'ukValue'
--
-- * 'ukType'
--
-- * 'ukCustomType'
userKeyword
    :: UserKeyword
userKeyword =
    UserKeyword'
    { _ukValue = Nothing
    , _ukType = Nothing
    , _ukCustomType = Nothing
    }

-- | Keyword.
ukValue :: Lens' UserKeyword (Maybe Text)
ukValue = lens _ukValue (\ s a -> s{_ukValue = a})

-- | Each entry can have a type which indicates standard type of that entry.
-- For example, keyword could be of type occupation or outlook. In addition
-- to the standard type, an entry can have a custom type and can give it
-- any name. Such types should have the CUSTOM value as type and also have
-- a customType value.
ukType :: Lens' UserKeyword (Maybe Text)
ukType = lens _ukType (\ s a -> s{_ukType = a})

-- | Custom Type.
ukCustomType :: Lens' UserKeyword (Maybe Text)
ukCustomType
  = lens _ukCustomType (\ s a -> s{_ukCustomType = a})

instance FromJSON UserKeyword where
        parseJSON
          = withObject "UserKeyword"
              (\ o ->
                 UserKeyword' <$>
                   (o .:? "value") <*> (o .:? "type") <*>
                     (o .:? "customType"))

instance ToJSON UserKeyword where
        toJSON UserKeyword'{..}
          = object
              (catMaybes
                 [("value" .=) <$> _ukValue, ("type" .=) <$> _ukType,
                  ("customType" .=) <$> _ukCustomType])

-- | JSON response template to list domain aliases in Directory API.
--
-- /See:/ 'domainAliases' smart constructor.
data DomainAliases = DomainAliases'
    { _daEtag          :: !(Maybe Text)
    , _daKind          :: !Text
    , _daDomainAliases :: !(Maybe [DomainAlias])
    } deriving (Eq,Show,Data,Typeable,Generic)

-- | Creates a value of 'DomainAliases' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'daEtag'
--
-- * 'daKind'
--
-- * 'daDomainAliases'
domainAliases
    :: DomainAliases
domainAliases =
    DomainAliases'
    { _daEtag = Nothing
    , _daKind = "admin#directory#domainAliases"
    , _daDomainAliases = Nothing
    }

-- | ETag of the resource.
daEtag :: Lens' DomainAliases (Maybe Text)
daEtag = lens _daEtag (\ s a -> s{_daEtag = a})

-- | Kind of resource this is.
daKind :: Lens' DomainAliases Text
daKind = lens _daKind (\ s a -> s{_daKind = a})

-- | List of domain alias objects.
daDomainAliases :: Lens' DomainAliases [DomainAlias]
daDomainAliases
  = lens _daDomainAliases
      (\ s a -> s{_daDomainAliases = a})
      . _Default
      . _Coerce

instance FromJSON DomainAliases where
        parseJSON
          = withObject "DomainAliases"
              (\ o ->
                 DomainAliases' <$>
                   (o .:? "etag") <*>
                     (o .:? "kind" .!= "admin#directory#domainAliases")
                     <*> (o .:? "domainAliases" .!= mempty))

instance ToJSON DomainAliases where
        toJSON DomainAliases'{..}
          = object
              (catMaybes
                 [("etag" .=) <$> _daEtag, Just ("kind" .= _daKind),
                  ("domainAliases" .=) <$> _daDomainAliases])

-- | JSON response template to list aliases in Directory API.
--
-- /See:/ 'aliases' smart constructor.
data Aliases = Aliases'
    { _aliEtag    :: !(Maybe Text)
    , _aliKind    :: !Text
    , _aliAliases :: !(Maybe [JSONValue])
    } deriving (Eq,Show,Data,Typeable,Generic)

-- | Creates a value of 'Aliases' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'aliEtag'
--
-- * 'aliKind'
--
-- * 'aliAliases'
aliases
    :: Aliases
aliases =
    Aliases'
    { _aliEtag = Nothing
    , _aliKind = "admin#directory#aliases"
    , _aliAliases = Nothing
    }

-- | ETag of the resource.
aliEtag :: Lens' Aliases (Maybe Text)
aliEtag = lens _aliEtag (\ s a -> s{_aliEtag = a})

-- | Kind of resource this is.
aliKind :: Lens' Aliases Text
aliKind = lens _aliKind (\ s a -> s{_aliKind = a})

-- | List of alias objects.
aliAliases :: Lens' Aliases [JSONValue]
aliAliases
  = lens _aliAliases (\ s a -> s{_aliAliases = a}) .
      _Default
      . _Coerce

instance FromJSON Aliases where
        parseJSON
          = withObject "Aliases"
              (\ o ->
                 Aliases' <$>
                   (o .:? "etag") <*>
                     (o .:? "kind" .!= "admin#directory#aliases")
                     <*> (o .:? "aliases" .!= mempty))

instance ToJSON Aliases where
        toJSON Aliases'{..}
          = object
              (catMaybes
                 [("etag" .=) <$> _aliEtag, Just ("kind" .= _aliKind),
                  ("aliases" .=) <$> _aliAliases])

-- | JSON template for Calendar Resource object in Directory API.
--
-- /See:/ 'calendarResource' smart constructor.
data CalendarResource = CalendarResource'
    { _crEtags                  :: !(Maybe Text)
    , _crResourceId             :: !(Maybe Text)
    , _crResourceType           :: !(Maybe Text)
    , _crResourceName           :: !(Maybe Text)
    , _crKind                   :: !Text
    , _crBuildingId             :: !(Maybe Text)
    , _crFeatureInstances       :: !(Maybe JSONValue)
    , _crResourceEmail          :: !(Maybe Text)
    , _crCapacity               :: !(Maybe (Textual Int32))
    , _crResourceDescription    :: !(Maybe Text)
    , _crFloorName              :: !(Maybe Text)
    , _crGeneratedResourceName  :: !(Maybe Text)
    , _crResourceCategory       :: !(Maybe Text)
    , _crFloorSection           :: !(Maybe Text)
    , _crUserVisibleDescription :: !(Maybe Text)
    } deriving (Eq,Show,Data,Typeable,Generic)

-- | Creates a value of 'CalendarResource' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'crEtags'
--
-- * 'crResourceId'
--
-- * 'crResourceType'
--
-- * 'crResourceName'
--
-- * 'crKind'
--
-- * 'crBuildingId'
--
-- * 'crFeatureInstances'
--
-- * 'crResourceEmail'
--
-- * 'crCapacity'
--
-- * 'crResourceDescription'
--
-- * 'crFloorName'
--
-- * 'crGeneratedResourceName'
--
-- * 'crResourceCategory'
--
-- * 'crFloorSection'
--
-- * 'crUserVisibleDescription'
calendarResource
    :: CalendarResource
calendarResource =
    CalendarResource'
    { _crEtags = Nothing
    , _crResourceId = Nothing
    , _crResourceType = Nothing
    , _crResourceName = Nothing
    , _crKind = "admin#directory#resources#calendars#CalendarResource"
    , _crBuildingId = Nothing
    , _crFeatureInstances = Nothing
    , _crResourceEmail = Nothing
    , _crCapacity = Nothing
    , _crResourceDescription = Nothing
    , _crFloorName = Nothing
    , _crGeneratedResourceName = Nothing
    , _crResourceCategory = Nothing
    , _crFloorSection = Nothing
    , _crUserVisibleDescription = Nothing
    }

-- | ETag of the resource.
crEtags :: Lens' CalendarResource (Maybe Text)
crEtags = lens _crEtags (\ s a -> s{_crEtags = a})

-- | The unique ID for the calendar resource.
crResourceId :: Lens' CalendarResource (Maybe Text)
crResourceId
  = lens _crResourceId (\ s a -> s{_crResourceId = a})

-- | The type of the calendar resource, intended for non-room resources.
crResourceType :: Lens' CalendarResource (Maybe Text)
crResourceType
  = lens _crResourceType
      (\ s a -> s{_crResourceType = a})

-- | The name of the calendar resource. For example, \"Training Room 1A\".
crResourceName :: Lens' CalendarResource (Maybe Text)
crResourceName
  = lens _crResourceName
      (\ s a -> s{_crResourceName = a})

-- | The type of the resource. For calendar resources, the value is
-- admin#directory#resources#calendars#CalendarResource.
crKind :: Lens' CalendarResource Text
crKind = lens _crKind (\ s a -> s{_crKind = a})

-- | Unique ID for the building a resource is located in.
crBuildingId :: Lens' CalendarResource (Maybe Text)
crBuildingId
  = lens _crBuildingId (\ s a -> s{_crBuildingId = a})

crFeatureInstances :: Lens' CalendarResource (Maybe JSONValue)
crFeatureInstances
  = lens _crFeatureInstances
      (\ s a -> s{_crFeatureInstances = a})

-- | The read-only email for the calendar resource. Generated as part of
-- creating a new calendar resource.
crResourceEmail :: Lens' CalendarResource (Maybe Text)
crResourceEmail
  = lens _crResourceEmail
      (\ s a -> s{_crResourceEmail = a})

-- | Capacity of a resource, number of seats in a room.
crCapacity :: Lens' CalendarResource (Maybe Int32)
crCapacity
  = lens _crCapacity (\ s a -> s{_crCapacity = a}) .
      mapping _Coerce

-- | Description of the resource, visible only to admins.
crResourceDescription :: Lens' CalendarResource (Maybe Text)
crResourceDescription
  = lens _crResourceDescription
      (\ s a -> s{_crResourceDescription = a})

-- | Name of the floor a resource is located on.
crFloorName :: Lens' CalendarResource (Maybe Text)
crFloorName
  = lens _crFloorName (\ s a -> s{_crFloorName = a})

-- | The read-only auto-generated name of the calendar resource which
-- includes metadata about the resource such as building name, floor,
-- capacity, etc. For example, \"NYC-2-Training Room 1A (16)\".
crGeneratedResourceName :: Lens' CalendarResource (Maybe Text)
crGeneratedResourceName
  = lens _crGeneratedResourceName
      (\ s a -> s{_crGeneratedResourceName = a})

-- | The category of the calendar resource. Either CONFERENCE_ROOM or OTHER.
-- Legacy data is set to CATEGORY_UNKNOWN.
crResourceCategory :: Lens' CalendarResource (Maybe Text)
crResourceCategory
  = lens _crResourceCategory
      (\ s a -> s{_crResourceCategory = a})

-- | Name of the section within a floor a resource is located in.
crFloorSection :: Lens' CalendarResource (Maybe Text)
crFloorSection
  = lens _crFloorSection
      (\ s a -> s{_crFloorSection = a})

-- | Description of the resource, visible to users and admins.
crUserVisibleDescription :: Lens' CalendarResource (Maybe Text)
crUserVisibleDescription
  = lens _crUserVisibleDescription
      (\ s a -> s{_crUserVisibleDescription = a})

instance FromJSON CalendarResource where
        parseJSON
          = withObject "CalendarResource"
              (\ o ->
                 CalendarResource' <$>
                   (o .:? "etags") <*> (o .:? "resourceId") <*>
                     (o .:? "resourceType")
                     <*> (o .:? "resourceName")
                     <*>
                     (o .:? "kind" .!=
                        "admin#directory#resources#calendars#CalendarResource")
                     <*> (o .:? "buildingId")
                     <*> (o .:? "featureInstances")
                     <*> (o .:? "resourceEmail")
                     <*> (o .:? "capacity")
                     <*> (o .:? "resourceDescription")
                     <*> (o .:? "floorName")
                     <*> (o .:? "generatedResourceName")
                     <*> (o .:? "resourceCategory")
                     <*> (o .:? "floorSection")
                     <*> (o .:? "userVisibleDescription"))

instance ToJSON CalendarResource where
        toJSON CalendarResource'{..}
          = object
              (catMaybes
                 [("etags" .=) <$> _crEtags,
                  ("resourceId" .=) <$> _crResourceId,
                  ("resourceType" .=) <$> _crResourceType,
                  ("resourceName" .=) <$> _crResourceName,
                  Just ("kind" .= _crKind),
                  ("buildingId" .=) <$> _crBuildingId,
                  ("featureInstances" .=) <$> _crFeatureInstances,
                  ("resourceEmail" .=) <$> _crResourceEmail,
                  ("capacity" .=) <$> _crCapacity,
                  ("resourceDescription" .=) <$>
                    _crResourceDescription,
                  ("floorName" .=) <$> _crFloorName,
                  ("generatedResourceName" .=) <$>
                    _crGeneratedResourceName,
                  ("resourceCategory" .=) <$> _crResourceCategory,
                  ("floorSection" .=) <$> _crFloorSection,
                  ("userVisibleDescription" .=) <$>
                    _crUserVisibleDescription])

-- | JSON request template to undelete a user in Directory API.
--
-- /See:/ 'userUndelete' smart constructor.
newtype UserUndelete = UserUndelete'
    { _uuOrgUnitPath :: Maybe Text
    } deriving (Eq,Show,Data,Typeable,Generic)

-- | Creates a value of 'UserUndelete' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'uuOrgUnitPath'
userUndelete
    :: UserUndelete
userUndelete =
    UserUndelete'
    { _uuOrgUnitPath = Nothing
    }

-- | OrgUnit of User
uuOrgUnitPath :: Lens' UserUndelete (Maybe Text)
uuOrgUnitPath
  = lens _uuOrgUnitPath
      (\ s a -> s{_uuOrgUnitPath = a})

instance FromJSON UserUndelete where
        parseJSON
          = withObject "UserUndelete"
              (\ o -> UserUndelete' <$> (o .:? "orgUnitPath"))

instance ToJSON UserUndelete where
        toJSON UserUndelete'{..}
          = object
              (catMaybes [("orgUnitPath" .=) <$> _uuOrgUnitPath])

-- | JSON response template for List Members operation in Directory API.
--
-- /See:/ 'members' smart constructor.
data Members = Members'
    { _mEtag          :: !(Maybe Text)
    , _mNextPageToken :: !(Maybe Text)
    , _mKind          :: !Text
    , _mMembers       :: !(Maybe [Member])
    } deriving (Eq,Show,Data,Typeable,Generic)

-- | Creates a value of 'Members' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'mEtag'
--
-- * 'mNextPageToken'
--
-- * 'mKind'
--
-- * 'mMembers'
members
    :: Members
members =
    Members'
    { _mEtag = Nothing
    , _mNextPageToken = Nothing
    , _mKind = "admin#directory#members"
    , _mMembers = Nothing
    }

-- | ETag of the resource.
mEtag :: Lens' Members (Maybe Text)
mEtag = lens _mEtag (\ s a -> s{_mEtag = a})

-- | Token used to access next page of this result.
mNextPageToken :: Lens' Members (Maybe Text)
mNextPageToken
  = lens _mNextPageToken
      (\ s a -> s{_mNextPageToken = a})

-- | Kind of resource this is.
mKind :: Lens' Members Text
mKind = lens _mKind (\ s a -> s{_mKind = a})

-- | List of member objects.
mMembers :: Lens' Members [Member]
mMembers
  = lens _mMembers (\ s a -> s{_mMembers = a}) .
      _Default
      . _Coerce

instance FromJSON Members where
        parseJSON
          = withObject "Members"
              (\ o ->
                 Members' <$>
                   (o .:? "etag") <*> (o .:? "nextPageToken") <*>
                     (o .:? "kind" .!= "admin#directory#members")
                     <*> (o .:? "members" .!= mempty))

instance ToJSON Members where
        toJSON Members'{..}
          = object
              (catMaybes
                 [("etag" .=) <$> _mEtag,
                  ("nextPageToken" .=) <$> _mNextPageToken,
                  Just ("kind" .= _mKind),
                  ("members" .=) <$> _mMembers])

-- | An notification channel used to watch for resource changes.
--
-- /See:/ 'channel' smart constructor.
data Channel = Channel'
    { _cResourceURI :: !(Maybe Text)
    , _cResourceId  :: !(Maybe Text)
    , _cKind        :: !Text
    , _cExpiration  :: !(Maybe (Textual Int64))
    , _cToken       :: !(Maybe Text)
    , _cAddress     :: !(Maybe Text)
    , _cPayload     :: !(Maybe Bool)
    , _cParams      :: !(Maybe ChannelParams)
    , _cId          :: !(Maybe Text)
    , _cType        :: !(Maybe Text)
    } deriving (Eq,Show,Data,Typeable,Generic)

-- | Creates a value of 'Channel' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'cResourceURI'
--
-- * 'cResourceId'
--
-- * 'cKind'
--
-- * 'cExpiration'
--
-- * 'cToken'
--
-- * 'cAddress'
--
-- * 'cPayload'
--
-- * 'cParams'
--
-- * 'cId'
--
-- * 'cType'
channel
    :: Channel
channel =
    Channel'
    { _cResourceURI = Nothing
    , _cResourceId = Nothing
    , _cKind = "api#channel"
    , _cExpiration = Nothing
    , _cToken = Nothing
    , _cAddress = Nothing
    , _cPayload = Nothing
    , _cParams = Nothing
    , _cId = Nothing
    , _cType = Nothing
    }

-- | A version-specific identifier for the watched resource.
cResourceURI :: Lens' Channel (Maybe Text)
cResourceURI
  = lens _cResourceURI (\ s a -> s{_cResourceURI = a})

-- | An opaque ID that identifies the resource being watched on this channel.
-- Stable across different API versions.
cResourceId :: Lens' Channel (Maybe Text)
cResourceId
  = lens _cResourceId (\ s a -> s{_cResourceId = a})

-- | Identifies this as a notification channel used to watch for changes to a
-- resource. Value: the fixed string \"api#channel\".
cKind :: Lens' Channel Text
cKind = lens _cKind (\ s a -> s{_cKind = a})

-- | Date and time of notification channel expiration, expressed as a Unix
-- timestamp, in milliseconds. Optional.
cExpiration :: Lens' Channel (Maybe Int64)
cExpiration
  = lens _cExpiration (\ s a -> s{_cExpiration = a}) .
      mapping _Coerce

-- | An arbitrary string delivered to the target address with each
-- notification delivered over this channel. Optional.
cToken :: Lens' Channel (Maybe Text)
cToken = lens _cToken (\ s a -> s{_cToken = a})

-- | The address where notifications are delivered for this channel.
cAddress :: Lens' Channel (Maybe Text)
cAddress = lens _cAddress (\ s a -> s{_cAddress = a})

-- | A Boolean value to indicate whether payload is wanted. Optional.
cPayload :: Lens' Channel (Maybe Bool)
cPayload = lens _cPayload (\ s a -> s{_cPayload = a})

-- | Additional parameters controlling delivery channel behavior. Optional.
cParams :: Lens' Channel (Maybe ChannelParams)
cParams = lens _cParams (\ s a -> s{_cParams = a})

-- | A UUID or similar unique string that identifies this channel.
cId :: Lens' Channel (Maybe Text)
cId = lens _cId (\ s a -> s{_cId = a})

-- | The type of delivery mechanism used for this channel.
cType :: Lens' Channel (Maybe Text)
cType = lens _cType (\ s a -> s{_cType = a})

instance FromJSON Channel where
        parseJSON
          = withObject "Channel"
              (\ o ->
                 Channel' <$>
                   (o .:? "resourceUri") <*> (o .:? "resourceId") <*>
                     (o .:? "kind" .!= "api#channel")
                     <*> (o .:? "expiration")
                     <*> (o .:? "token")
                     <*> (o .:? "address")
                     <*> (o .:? "payload")
                     <*> (o .:? "params")
                     <*> (o .:? "id")
                     <*> (o .:? "type"))

instance ToJSON Channel where
        toJSON Channel'{..}
          = object
              (catMaybes
                 [("resourceUri" .=) <$> _cResourceURI,
                  ("resourceId" .=) <$> _cResourceId,
                  Just ("kind" .= _cKind),
                  ("expiration" .=) <$> _cExpiration,
                  ("token" .=) <$> _cToken,
                  ("address" .=) <$> _cAddress,
                  ("payload" .=) <$> _cPayload,
                  ("params" .=) <$> _cParams, ("id" .=) <$> _cId,
                  ("type" .=) <$> _cType])

-- | JSON response template for List Mobile Devices operation in Directory
-- API.
--
-- /See:/ 'mobileDevices' smart constructor.
data MobileDevices = MobileDevices'
    { _mdEtag          :: !(Maybe Text)
    , _mdNextPageToken :: !(Maybe Text)
    , _mdKind          :: !Text
    , _mdMobileDevices :: !(Maybe [MobileDevice])
    } deriving (Eq,Show,Data,Typeable,Generic)

-- | Creates a value of 'MobileDevices' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'mdEtag'
--
-- * 'mdNextPageToken'
--
-- * 'mdKind'
--
-- * 'mdMobileDevices'
mobileDevices
    :: MobileDevices
mobileDevices =
    MobileDevices'
    { _mdEtag = Nothing
    , _mdNextPageToken = Nothing
    , _mdKind = "admin#directory#mobiledevices"
    , _mdMobileDevices = Nothing
    }

-- | ETag of the resource.
mdEtag :: Lens' MobileDevices (Maybe Text)
mdEtag = lens _mdEtag (\ s a -> s{_mdEtag = a})

-- | Token used to access next page of this result.
mdNextPageToken :: Lens' MobileDevices (Maybe Text)
mdNextPageToken
  = lens _mdNextPageToken
      (\ s a -> s{_mdNextPageToken = a})

-- | Kind of resource this is.
mdKind :: Lens' MobileDevices Text
mdKind = lens _mdKind (\ s a -> s{_mdKind = a})

-- | List of Mobile Device objects.
mdMobileDevices :: Lens' MobileDevices [MobileDevice]
mdMobileDevices
  = lens _mdMobileDevices
      (\ s a -> s{_mdMobileDevices = a})
      . _Default
      . _Coerce

instance FromJSON MobileDevices where
        parseJSON
          = withObject "MobileDevices"
              (\ o ->
                 MobileDevices' <$>
                   (o .:? "etag") <*> (o .:? "nextPageToken") <*>
                     (o .:? "kind" .!= "admin#directory#mobiledevices")
                     <*> (o .:? "mobiledevices" .!= mempty))

instance ToJSON MobileDevices where
        toJSON MobileDevices'{..}
          = object
              (catMaybes
                 [("etag" .=) <$> _mdEtag,
                  ("nextPageToken" .=) <$> _mdNextPageToken,
                  Just ("kind" .= _mdKind),
                  ("mobiledevices" .=) <$> _mdMobileDevices])

-- | JSON template for token resource in Directory API.
--
-- /See:/ 'token' smart constructor.
data Token = Token'
    { _tokClientId    :: !(Maybe Text)
    , _tokEtag        :: !(Maybe Text)
    , _tokDisplayText :: !(Maybe Text)
    , _tokKind        :: !Text
    , _tokScopes      :: !(Maybe [Text])
    , _tokNATiveApp   :: !(Maybe Bool)
    , _tokAnonymous   :: !(Maybe Bool)
    , _tokUserKey     :: !(Maybe Text)
    } deriving (Eq,Show,Data,Typeable,Generic)

-- | Creates a value of 'Token' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'tokClientId'
--
-- * 'tokEtag'
--
-- * 'tokDisplayText'
--
-- * 'tokKind'
--
-- * 'tokScopes'
--
-- * 'tokNATiveApp'
--
-- * 'tokAnonymous'
--
-- * 'tokUserKey'
token
    :: Token
token =
    Token'
    { _tokClientId = Nothing
    , _tokEtag = Nothing
    , _tokDisplayText = Nothing
    , _tokKind = "admin#directory#token"
    , _tokScopes = Nothing
    , _tokNATiveApp = Nothing
    , _tokAnonymous = Nothing
    , _tokUserKey = Nothing
    }

-- | The Client ID of the application the token is issued to.
tokClientId :: Lens' Token (Maybe Text)
tokClientId
  = lens _tokClientId (\ s a -> s{_tokClientId = a})

-- | ETag of the resource.
tokEtag :: Lens' Token (Maybe Text)
tokEtag = lens _tokEtag (\ s a -> s{_tokEtag = a})

-- | The displayable name of the application the token is issued to.
tokDisplayText :: Lens' Token (Maybe Text)
tokDisplayText
  = lens _tokDisplayText
      (\ s a -> s{_tokDisplayText = a})

-- | The type of the API resource. This is always admin#directory#token.
tokKind :: Lens' Token Text
tokKind = lens _tokKind (\ s a -> s{_tokKind = a})

-- | A list of authorization scopes the application is granted.
tokScopes :: Lens' Token [Text]
tokScopes
  = lens _tokScopes (\ s a -> s{_tokScopes = a}) .
      _Default
      . _Coerce

-- | Whether the token is issued to an installed application. The value is
-- true if the application is installed to a desktop or mobile device.
tokNATiveApp :: Lens' Token (Maybe Bool)
tokNATiveApp
  = lens _tokNATiveApp (\ s a -> s{_tokNATiveApp = a})

-- | Whether the application is registered with Google. The value is true if
-- the application has an anonymous Client ID.
tokAnonymous :: Lens' Token (Maybe Bool)
tokAnonymous
  = lens _tokAnonymous (\ s a -> s{_tokAnonymous = a})

-- | The unique ID of the user that issued the token.
tokUserKey :: Lens' Token (Maybe Text)
tokUserKey
  = lens _tokUserKey (\ s a -> s{_tokUserKey = a})

instance FromJSON Token where
        parseJSON
          = withObject "Token"
              (\ o ->
                 Token' <$>
                   (o .:? "clientId") <*> (o .:? "etag") <*>
                     (o .:? "displayText")
                     <*> (o .:? "kind" .!= "admin#directory#token")
                     <*> (o .:? "scopes" .!= mempty)
                     <*> (o .:? "nativeApp")
                     <*> (o .:? "anonymous")
                     <*> (o .:? "userKey"))

instance ToJSON Token where
        toJSON Token'{..}
          = object
              (catMaybes
                 [("clientId" .=) <$> _tokClientId,
                  ("etag" .=) <$> _tokEtag,
                  ("displayText" .=) <$> _tokDisplayText,
                  Just ("kind" .= _tokKind),
                  ("scopes" .=) <$> _tokScopes,
                  ("nativeApp" .=) <$> _tokNATiveApp,
                  ("anonymous" .=) <$> _tokAnonymous,
                  ("userKey" .=) <$> _tokUserKey])

-- | JSON template for name of a user in Directory API.
--
-- /See:/ 'userName' smart constructor.
data UserName = UserName'
    { _unGivenName  :: !(Maybe Text)
    , _unFullName   :: !(Maybe Text)
    , _unFamilyName :: !(Maybe Text)
    } deriving (Eq,Show,Data,Typeable,Generic)

-- | Creates a value of 'UserName' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'unGivenName'
--
-- * 'unFullName'
--
-- * 'unFamilyName'
userName
    :: UserName
userName =
    UserName'
    { _unGivenName = Nothing
    , _unFullName = Nothing
    , _unFamilyName = Nothing
    }

-- | First Name
unGivenName :: Lens' UserName (Maybe Text)
unGivenName
  = lens _unGivenName (\ s a -> s{_unGivenName = a})

-- | Full Name
unFullName :: Lens' UserName (Maybe Text)
unFullName
  = lens _unFullName (\ s a -> s{_unFullName = a})

-- | Last Name
unFamilyName :: Lens' UserName (Maybe Text)
unFamilyName
  = lens _unFamilyName (\ s a -> s{_unFamilyName = a})

instance FromJSON UserName where
        parseJSON
          = withObject "UserName"
              (\ o ->
                 UserName' <$>
                   (o .:? "givenName") <*> (o .:? "fullName") <*>
                     (o .:? "familyName"))

instance ToJSON UserName where
        toJSON UserName'{..}
          = object
              (catMaybes
                 [("givenName" .=) <$> _unGivenName,
                  ("fullName" .=) <$> _unFullName,
                  ("familyName" .=) <$> _unFamilyName])

-- | JSON template for Building object in Directory API.
--
-- /See:/ 'building' smart constructor.
data Building = Building'
    { _buiEtags        :: !(Maybe Text)
    , _buiKind         :: !Text
    , _buiBuildingId   :: !(Maybe Text)
    , _buiCoordinates  :: !(Maybe BuildingCoordinates)
    , _buiBuildingName :: !(Maybe Text)
    , _buiFloorNames   :: !(Maybe [Text])
    , _buiDescription  :: !(Maybe Text)
    } deriving (Eq,Show,Data,Typeable,Generic)

-- | Creates a value of 'Building' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'buiEtags'
--
-- * 'buiKind'
--
-- * 'buiBuildingId'
--
-- * 'buiCoordinates'
--
-- * 'buiBuildingName'
--
-- * 'buiFloorNames'
--
-- * 'buiDescription'
building
    :: Building
building =
    Building'
    { _buiEtags = Nothing
    , _buiKind = "admin#directory#resources#buildings#Building"
    , _buiBuildingId = Nothing
    , _buiCoordinates = Nothing
    , _buiBuildingName = Nothing
    , _buiFloorNames = Nothing
    , _buiDescription = Nothing
    }

-- | ETag of the resource.
buiEtags :: Lens' Building (Maybe Text)
buiEtags = lens _buiEtags (\ s a -> s{_buiEtags = a})

-- | Kind of resource this is.
buiKind :: Lens' Building Text
buiKind = lens _buiKind (\ s a -> s{_buiKind = a})

-- | Unique identifier for the building. The maximum length is 100
-- characters.
buiBuildingId :: Lens' Building (Maybe Text)
buiBuildingId
  = lens _buiBuildingId
      (\ s a -> s{_buiBuildingId = a})

-- | The geographic coordinates of the center of the building, expressed as
-- latitude and longitude in decimal degrees.
buiCoordinates :: Lens' Building (Maybe BuildingCoordinates)
buiCoordinates
  = lens _buiCoordinates
      (\ s a -> s{_buiCoordinates = a})

-- | The building name as seen by users in Calendar. Must be unique for the
-- customer. For example, \"NYC-CHEL\". The maximum length is 100
-- characters.
buiBuildingName :: Lens' Building (Maybe Text)
buiBuildingName
  = lens _buiBuildingName
      (\ s a -> s{_buiBuildingName = a})

-- | The display names for all floors in this building. The floors are
-- expected to be sorted in ascending order, from lowest floor to highest
-- floor. For example, [\"B2\", \"B1\", \"L\", \"1\", \"2\", \"2M\", \"3\",
-- \"PH\"] Must contain at least one entry.
buiFloorNames :: Lens' Building [Text]
buiFloorNames
  = lens _buiFloorNames
      (\ s a -> s{_buiFloorNames = a})
      . _Default
      . _Coerce

-- | A brief description of the building. For example, \"Chelsea Market\".
buiDescription :: Lens' Building (Maybe Text)
buiDescription
  = lens _buiDescription
      (\ s a -> s{_buiDescription = a})

instance FromJSON Building where
        parseJSON
          = withObject "Building"
              (\ o ->
                 Building' <$>
                   (o .:? "etags") <*>
                     (o .:? "kind" .!=
                        "admin#directory#resources#buildings#Building")
                     <*> (o .:? "buildingId")
                     <*> (o .:? "coordinates")
                     <*> (o .:? "buildingName")
                     <*> (o .:? "floorNames" .!= mempty)
                     <*> (o .:? "description"))

instance ToJSON Building where
        toJSON Building'{..}
          = object
              (catMaybes
                 [("etags" .=) <$> _buiEtags,
                  Just ("kind" .= _buiKind),
                  ("buildingId" .=) <$> _buiBuildingId,
                  ("coordinates" .=) <$> _buiCoordinates,
                  ("buildingName" .=) <$> _buiBuildingName,
                  ("floorNames" .=) <$> _buiFloorNames,
                  ("description" .=) <$> _buiDescription])

--
-- /See:/ 'chromeOSDeviceRecentUsersItem' smart constructor.
data ChromeOSDeviceRecentUsersItem = ChromeOSDeviceRecentUsersItem'
    { _codruiEmail :: !(Maybe Text)
    , _codruiType  :: !(Maybe Text)
    } deriving (Eq,Show,Data,Typeable,Generic)

-- | Creates a value of 'ChromeOSDeviceRecentUsersItem' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'codruiEmail'
--
-- * 'codruiType'
chromeOSDeviceRecentUsersItem
    :: ChromeOSDeviceRecentUsersItem
chromeOSDeviceRecentUsersItem =
    ChromeOSDeviceRecentUsersItem'
    { _codruiEmail = Nothing
    , _codruiType = Nothing
    }

-- | Email address of the user. Present only if the user type is managed
codruiEmail :: Lens' ChromeOSDeviceRecentUsersItem (Maybe Text)
codruiEmail
  = lens _codruiEmail (\ s a -> s{_codruiEmail = a})

-- | The type of the user
codruiType :: Lens' ChromeOSDeviceRecentUsersItem (Maybe Text)
codruiType
  = lens _codruiType (\ s a -> s{_codruiType = a})

instance FromJSON ChromeOSDeviceRecentUsersItem where
        parseJSON
          = withObject "ChromeOSDeviceRecentUsersItem"
              (\ o ->
                 ChromeOSDeviceRecentUsersItem' <$>
                   (o .:? "email") <*> (o .:? "type"))

instance ToJSON ChromeOSDeviceRecentUsersItem where
        toJSON ChromeOSDeviceRecentUsersItem'{..}
          = object
              (catMaybes
                 [("email" .=) <$> _codruiEmail,
                  ("type" .=) <$> _codruiType])

-- | JSON template for Domain Alias object in Directory API.
--
-- /See:/ 'domainAlias' smart constructor.
data DomainAlias = DomainAlias'
    { _dCreationTime     :: !(Maybe (Textual Int64))
    , _dEtag             :: !(Maybe Text)
    , _dKind             :: !Text
    , _dVerified         :: !(Maybe Bool)
    , _dDomainAliasName  :: !(Maybe Text)
    , _dParentDomainName :: !(Maybe Text)
    } deriving (Eq,Show,Data,Typeable,Generic)

-- | Creates a value of 'DomainAlias' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'dCreationTime'
--
-- * 'dEtag'
--
-- * 'dKind'
--
-- * 'dVerified'
--
-- * 'dDomainAliasName'
--
-- * 'dParentDomainName'
domainAlias
    :: DomainAlias
domainAlias =
    DomainAlias'
    { _dCreationTime = Nothing
    , _dEtag = Nothing
    , _dKind = "admin#directory#domainAlias"
    , _dVerified = Nothing
    , _dDomainAliasName = Nothing
    , _dParentDomainName = Nothing
    }

-- | The creation time of the domain alias. (Read-only).
dCreationTime :: Lens' DomainAlias (Maybe Int64)
dCreationTime
  = lens _dCreationTime
      (\ s a -> s{_dCreationTime = a})
      . mapping _Coerce

-- | ETag of the resource.
dEtag :: Lens' DomainAlias (Maybe Text)
dEtag = lens _dEtag (\ s a -> s{_dEtag = a})

-- | Kind of resource this is.
dKind :: Lens' DomainAlias Text
dKind = lens _dKind (\ s a -> s{_dKind = a})

-- | Indicates the verification state of a domain alias. (Read-only)
dVerified :: Lens' DomainAlias (Maybe Bool)
dVerified
  = lens _dVerified (\ s a -> s{_dVerified = a})

-- | The domain alias name.
dDomainAliasName :: Lens' DomainAlias (Maybe Text)
dDomainAliasName
  = lens _dDomainAliasName
      (\ s a -> s{_dDomainAliasName = a})

-- | The parent domain name that the domain alias is associated with. This
-- can either be a primary or secondary domain name within a customer.
dParentDomainName :: Lens' DomainAlias (Maybe Text)
dParentDomainName
  = lens _dParentDomainName
      (\ s a -> s{_dParentDomainName = a})

instance FromJSON DomainAlias where
        parseJSON
          = withObject "DomainAlias"
              (\ o ->
                 DomainAlias' <$>
                   (o .:? "creationTime") <*> (o .:? "etag") <*>
                     (o .:? "kind" .!= "admin#directory#domainAlias")
                     <*> (o .:? "verified")
                     <*> (o .:? "domainAliasName")
                     <*> (o .:? "parentDomainName"))

instance ToJSON DomainAlias where
        toJSON DomainAlias'{..}
          = object
              (catMaybes
                 [("creationTime" .=) <$> _dCreationTime,
                  ("etag" .=) <$> _dEtag, Just ("kind" .= _dKind),
                  ("verified" .=) <$> _dVerified,
                  ("domainAliasName" .=) <$> _dDomainAliasName,
                  ("parentDomainName" .=) <$> _dP