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

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

-- |
-- Module      : Amazonka.GroundStation.ListContacts
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns a list of contacts.
--
-- If @statusList@ contains AVAILABLE, the request must include
-- @groundStation@, @missionprofileArn@, and @satelliteArn@.
--
-- This operation returns paginated results.
module Amazonka.GroundStation.ListContacts
  ( -- * Creating a Request
    ListContacts (..),
    newListContacts,

    -- * Request Lenses
    listContacts_groundStation,
    listContacts_maxResults,
    listContacts_missionProfileArn,
    listContacts_nextToken,
    listContacts_satelliteArn,
    listContacts_endTime,
    listContacts_startTime,
    listContacts_statusList,

    -- * Destructuring the Response
    ListContactsResponse (..),
    newListContactsResponse,

    -- * Response Lenses
    listContactsResponse_contactList,
    listContactsResponse_nextToken,
    listContactsResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.GroundStation.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- |
--
-- /See:/ 'newListContacts' smart constructor.
data ListContacts = ListContacts'
  { -- | Name of a ground station.
    ListContacts -> Maybe Text
groundStation :: Prelude.Maybe Prelude.Text,
    -- | Maximum number of contacts returned.
    ListContacts -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | ARN of a mission profile.
    ListContacts -> Maybe Text
missionProfileArn :: Prelude.Maybe Prelude.Text,
    -- | Next token returned in the request of a previous @ListContacts@ call.
    -- Used to get the next page of results.
    ListContacts -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | ARN of a satellite.
    ListContacts -> Maybe Text
satelliteArn :: Prelude.Maybe Prelude.Text,
    -- | End time of a contact in UTC.
    ListContacts -> POSIX
endTime :: Data.POSIX,
    -- | Start time of a contact in UTC.
    ListContacts -> POSIX
startTime :: Data.POSIX,
    -- | Status of a contact reservation.
    ListContacts -> [ContactStatus]
statusList :: [ContactStatus]
  }
  deriving (ListContacts -> ListContacts -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListContacts -> ListContacts -> Bool
$c/= :: ListContacts -> ListContacts -> Bool
== :: ListContacts -> ListContacts -> Bool
$c== :: ListContacts -> ListContacts -> Bool
Prelude.Eq, ReadPrec [ListContacts]
ReadPrec ListContacts
Int -> ReadS ListContacts
ReadS [ListContacts]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListContacts]
$creadListPrec :: ReadPrec [ListContacts]
readPrec :: ReadPrec ListContacts
$creadPrec :: ReadPrec ListContacts
readList :: ReadS [ListContacts]
$creadList :: ReadS [ListContacts]
readsPrec :: Int -> ReadS ListContacts
$creadsPrec :: Int -> ReadS ListContacts
Prelude.Read, Int -> ListContacts -> ShowS
[ListContacts] -> ShowS
ListContacts -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListContacts] -> ShowS
$cshowList :: [ListContacts] -> ShowS
show :: ListContacts -> String
$cshow :: ListContacts -> String
showsPrec :: Int -> ListContacts -> ShowS
$cshowsPrec :: Int -> ListContacts -> ShowS
Prelude.Show, forall x. Rep ListContacts x -> ListContacts
forall x. ListContacts -> Rep ListContacts x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListContacts x -> ListContacts
$cfrom :: forall x. ListContacts -> Rep ListContacts x
Prelude.Generic)

-- |
-- Create a value of 'ListContacts' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'groundStation', 'listContacts_groundStation' - Name of a ground station.
--
-- 'maxResults', 'listContacts_maxResults' - Maximum number of contacts returned.
--
-- 'missionProfileArn', 'listContacts_missionProfileArn' - ARN of a mission profile.
--
-- 'nextToken', 'listContacts_nextToken' - Next token returned in the request of a previous @ListContacts@ call.
-- Used to get the next page of results.
--
-- 'satelliteArn', 'listContacts_satelliteArn' - ARN of a satellite.
--
-- 'endTime', 'listContacts_endTime' - End time of a contact in UTC.
--
-- 'startTime', 'listContacts_startTime' - Start time of a contact in UTC.
--
-- 'statusList', 'listContacts_statusList' - Status of a contact reservation.
newListContacts ::
  -- | 'endTime'
  Prelude.UTCTime ->
  -- | 'startTime'
  Prelude.UTCTime ->
  ListContacts
newListContacts :: UTCTime -> UTCTime -> ListContacts
newListContacts UTCTime
pEndTime_ UTCTime
pStartTime_ =
  ListContacts'
    { $sel:groundStation:ListContacts' :: Maybe Text
groundStation = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:ListContacts' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:missionProfileArn:ListContacts' :: Maybe Text
missionProfileArn = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListContacts' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:satelliteArn:ListContacts' :: Maybe Text
satelliteArn = forall a. Maybe a
Prelude.Nothing,
      $sel:endTime:ListContacts' :: POSIX
endTime = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pEndTime_,
      $sel:startTime:ListContacts' :: POSIX
startTime = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pStartTime_,
      $sel:statusList:ListContacts' :: [ContactStatus]
statusList = forall a. Monoid a => a
Prelude.mempty
    }

-- | Name of a ground station.
listContacts_groundStation :: Lens.Lens' ListContacts (Prelude.Maybe Prelude.Text)
listContacts_groundStation :: Lens' ListContacts (Maybe Text)
listContacts_groundStation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListContacts' {Maybe Text
groundStation :: Maybe Text
$sel:groundStation:ListContacts' :: ListContacts -> Maybe Text
groundStation} -> Maybe Text
groundStation) (\s :: ListContacts
s@ListContacts' {} Maybe Text
a -> ListContacts
s {$sel:groundStation:ListContacts' :: Maybe Text
groundStation = Maybe Text
a} :: ListContacts)

-- | Maximum number of contacts returned.
listContacts_maxResults :: Lens.Lens' ListContacts (Prelude.Maybe Prelude.Natural)
listContacts_maxResults :: Lens' ListContacts (Maybe Natural)
listContacts_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListContacts' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListContacts' :: ListContacts -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListContacts
s@ListContacts' {} Maybe Natural
a -> ListContacts
s {$sel:maxResults:ListContacts' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListContacts)

-- | ARN of a mission profile.
listContacts_missionProfileArn :: Lens.Lens' ListContacts (Prelude.Maybe Prelude.Text)
listContacts_missionProfileArn :: Lens' ListContacts (Maybe Text)
listContacts_missionProfileArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListContacts' {Maybe Text
missionProfileArn :: Maybe Text
$sel:missionProfileArn:ListContacts' :: ListContacts -> Maybe Text
missionProfileArn} -> Maybe Text
missionProfileArn) (\s :: ListContacts
s@ListContacts' {} Maybe Text
a -> ListContacts
s {$sel:missionProfileArn:ListContacts' :: Maybe Text
missionProfileArn = Maybe Text
a} :: ListContacts)

-- | Next token returned in the request of a previous @ListContacts@ call.
-- Used to get the next page of results.
listContacts_nextToken :: Lens.Lens' ListContacts (Prelude.Maybe Prelude.Text)
listContacts_nextToken :: Lens' ListContacts (Maybe Text)
listContacts_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListContacts' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListContacts' :: ListContacts -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListContacts
s@ListContacts' {} Maybe Text
a -> ListContacts
s {$sel:nextToken:ListContacts' :: Maybe Text
nextToken = Maybe Text
a} :: ListContacts)

-- | ARN of a satellite.
listContacts_satelliteArn :: Lens.Lens' ListContacts (Prelude.Maybe Prelude.Text)
listContacts_satelliteArn :: Lens' ListContacts (Maybe Text)
listContacts_satelliteArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListContacts' {Maybe Text
satelliteArn :: Maybe Text
$sel:satelliteArn:ListContacts' :: ListContacts -> Maybe Text
satelliteArn} -> Maybe Text
satelliteArn) (\s :: ListContacts
s@ListContacts' {} Maybe Text
a -> ListContacts
s {$sel:satelliteArn:ListContacts' :: Maybe Text
satelliteArn = Maybe Text
a} :: ListContacts)

-- | End time of a contact in UTC.
listContacts_endTime :: Lens.Lens' ListContacts Prelude.UTCTime
listContacts_endTime :: Lens' ListContacts UTCTime
listContacts_endTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListContacts' {POSIX
endTime :: POSIX
$sel:endTime:ListContacts' :: ListContacts -> POSIX
endTime} -> POSIX
endTime) (\s :: ListContacts
s@ListContacts' {} POSIX
a -> ListContacts
s {$sel:endTime:ListContacts' :: POSIX
endTime = POSIX
a} :: ListContacts) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | Start time of a contact in UTC.
listContacts_startTime :: Lens.Lens' ListContacts Prelude.UTCTime
listContacts_startTime :: Lens' ListContacts UTCTime
listContacts_startTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListContacts' {POSIX
startTime :: POSIX
$sel:startTime:ListContacts' :: ListContacts -> POSIX
startTime} -> POSIX
startTime) (\s :: ListContacts
s@ListContacts' {} POSIX
a -> ListContacts
s {$sel:startTime:ListContacts' :: POSIX
startTime = POSIX
a} :: ListContacts) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | Status of a contact reservation.
listContacts_statusList :: Lens.Lens' ListContacts [ContactStatus]
listContacts_statusList :: Lens' ListContacts [ContactStatus]
listContacts_statusList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListContacts' {[ContactStatus]
statusList :: [ContactStatus]
$sel:statusList:ListContacts' :: ListContacts -> [ContactStatus]
statusList} -> [ContactStatus]
statusList) (\s :: ListContacts
s@ListContacts' {} [ContactStatus]
a -> ListContacts
s {$sel:statusList:ListContacts' :: [ContactStatus]
statusList = [ContactStatus]
a} :: ListContacts) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSPager ListContacts where
  page :: ListContacts -> AWSResponse ListContacts -> Maybe ListContacts
page ListContacts
rq AWSResponse ListContacts
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListContacts
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListContactsResponse (Maybe Text)
listContactsResponse_nextToken
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListContacts
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListContactsResponse (Maybe [ContactData])
listContactsResponse_contactList
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ ListContacts
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListContacts (Maybe Text)
listContacts_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListContacts
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListContactsResponse (Maybe Text)
listContactsResponse_nextToken
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just

instance Core.AWSRequest ListContacts where
  type AWSResponse ListContacts = ListContactsResponse
  request :: (Service -> Service) -> ListContacts -> Request ListContacts
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ListContacts
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListContacts)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe [ContactData] -> Maybe Text -> Int -> ListContactsResponse
ListContactsResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"contactList" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"nextToken")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable ListContacts where
  hashWithSalt :: Int -> ListContacts -> Int
hashWithSalt Int
_salt ListContacts' {[ContactStatus]
Maybe Natural
Maybe Text
POSIX
statusList :: [ContactStatus]
startTime :: POSIX
endTime :: POSIX
satelliteArn :: Maybe Text
nextToken :: Maybe Text
missionProfileArn :: Maybe Text
maxResults :: Maybe Natural
groundStation :: Maybe Text
$sel:statusList:ListContacts' :: ListContacts -> [ContactStatus]
$sel:startTime:ListContacts' :: ListContacts -> POSIX
$sel:endTime:ListContacts' :: ListContacts -> POSIX
$sel:satelliteArn:ListContacts' :: ListContacts -> Maybe Text
$sel:nextToken:ListContacts' :: ListContacts -> Maybe Text
$sel:missionProfileArn:ListContacts' :: ListContacts -> Maybe Text
$sel:maxResults:ListContacts' :: ListContacts -> Maybe Natural
$sel:groundStation:ListContacts' :: ListContacts -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
groundStation
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
missionProfileArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
satelliteArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` POSIX
endTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` POSIX
startTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [ContactStatus]
statusList

instance Prelude.NFData ListContacts where
  rnf :: ListContacts -> ()
rnf ListContacts' {[ContactStatus]
Maybe Natural
Maybe Text
POSIX
statusList :: [ContactStatus]
startTime :: POSIX
endTime :: POSIX
satelliteArn :: Maybe Text
nextToken :: Maybe Text
missionProfileArn :: Maybe Text
maxResults :: Maybe Natural
groundStation :: Maybe Text
$sel:statusList:ListContacts' :: ListContacts -> [ContactStatus]
$sel:startTime:ListContacts' :: ListContacts -> POSIX
$sel:endTime:ListContacts' :: ListContacts -> POSIX
$sel:satelliteArn:ListContacts' :: ListContacts -> Maybe Text
$sel:nextToken:ListContacts' :: ListContacts -> Maybe Text
$sel:missionProfileArn:ListContacts' :: ListContacts -> Maybe Text
$sel:maxResults:ListContacts' :: ListContacts -> Maybe Natural
$sel:groundStation:ListContacts' :: ListContacts -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
groundStation
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxResults
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
missionProfileArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
satelliteArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
endTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
startTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [ContactStatus]
statusList

instance Data.ToHeaders ListContacts where
  toHeaders :: ListContacts -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON ListContacts where
  toJSON :: ListContacts -> Value
toJSON ListContacts' {[ContactStatus]
Maybe Natural
Maybe Text
POSIX
statusList :: [ContactStatus]
startTime :: POSIX
endTime :: POSIX
satelliteArn :: Maybe Text
nextToken :: Maybe Text
missionProfileArn :: Maybe Text
maxResults :: Maybe Natural
groundStation :: Maybe Text
$sel:statusList:ListContacts' :: ListContacts -> [ContactStatus]
$sel:startTime:ListContacts' :: ListContacts -> POSIX
$sel:endTime:ListContacts' :: ListContacts -> POSIX
$sel:satelliteArn:ListContacts' :: ListContacts -> Maybe Text
$sel:nextToken:ListContacts' :: ListContacts -> Maybe Text
$sel:missionProfileArn:ListContacts' :: ListContacts -> Maybe Text
$sel:maxResults:ListContacts' :: ListContacts -> Maybe Natural
$sel:groundStation:ListContacts' :: ListContacts -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"groundStation" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
groundStation,
            (Key
"maxResults" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Natural
maxResults,
            (Key
"missionProfileArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
missionProfileArn,
            (Key
"nextToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
nextToken,
            (Key
"satelliteArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
satelliteArn,
            forall a. a -> Maybe a
Prelude.Just (Key
"endTime" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= POSIX
endTime),
            forall a. a -> Maybe a
Prelude.Just (Key
"startTime" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= POSIX
startTime),
            forall a. a -> Maybe a
Prelude.Just (Key
"statusList" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [ContactStatus]
statusList)
          ]
      )

instance Data.ToPath ListContacts where
  toPath :: ListContacts -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/contacts"

instance Data.ToQuery ListContacts where
  toQuery :: ListContacts -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- |
--
-- /See:/ 'newListContactsResponse' smart constructor.
data ListContactsResponse = ListContactsResponse'
  { -- | List of contacts.
    ListContactsResponse -> Maybe [ContactData]
contactList :: Prelude.Maybe [ContactData],
    -- | Next token returned in the response of a previous @ListContacts@ call.
    -- Used to get the next page of results.
    ListContactsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListContactsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListContactsResponse -> ListContactsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListContactsResponse -> ListContactsResponse -> Bool
$c/= :: ListContactsResponse -> ListContactsResponse -> Bool
== :: ListContactsResponse -> ListContactsResponse -> Bool
$c== :: ListContactsResponse -> ListContactsResponse -> Bool
Prelude.Eq, ReadPrec [ListContactsResponse]
ReadPrec ListContactsResponse
Int -> ReadS ListContactsResponse
ReadS [ListContactsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListContactsResponse]
$creadListPrec :: ReadPrec [ListContactsResponse]
readPrec :: ReadPrec ListContactsResponse
$creadPrec :: ReadPrec ListContactsResponse
readList :: ReadS [ListContactsResponse]
$creadList :: ReadS [ListContactsResponse]
readsPrec :: Int -> ReadS ListContactsResponse
$creadsPrec :: Int -> ReadS ListContactsResponse
Prelude.Read, Int -> ListContactsResponse -> ShowS
[ListContactsResponse] -> ShowS
ListContactsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListContactsResponse] -> ShowS
$cshowList :: [ListContactsResponse] -> ShowS
show :: ListContactsResponse -> String
$cshow :: ListContactsResponse -> String
showsPrec :: Int -> ListContactsResponse -> ShowS
$cshowsPrec :: Int -> ListContactsResponse -> ShowS
Prelude.Show, forall x. Rep ListContactsResponse x -> ListContactsResponse
forall x. ListContactsResponse -> Rep ListContactsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListContactsResponse x -> ListContactsResponse
$cfrom :: forall x. ListContactsResponse -> Rep ListContactsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListContactsResponse' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'contactList', 'listContactsResponse_contactList' - List of contacts.
--
-- 'nextToken', 'listContactsResponse_nextToken' - Next token returned in the response of a previous @ListContacts@ call.
-- Used to get the next page of results.
--
-- 'httpStatus', 'listContactsResponse_httpStatus' - The response's http status code.
newListContactsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListContactsResponse
newListContactsResponse :: Int -> ListContactsResponse
newListContactsResponse Int
pHttpStatus_ =
  ListContactsResponse'
    { $sel:contactList:ListContactsResponse' :: Maybe [ContactData]
contactList =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListContactsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListContactsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | List of contacts.
listContactsResponse_contactList :: Lens.Lens' ListContactsResponse (Prelude.Maybe [ContactData])
listContactsResponse_contactList :: Lens' ListContactsResponse (Maybe [ContactData])
listContactsResponse_contactList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListContactsResponse' {Maybe [ContactData]
contactList :: Maybe [ContactData]
$sel:contactList:ListContactsResponse' :: ListContactsResponse -> Maybe [ContactData]
contactList} -> Maybe [ContactData]
contactList) (\s :: ListContactsResponse
s@ListContactsResponse' {} Maybe [ContactData]
a -> ListContactsResponse
s {$sel:contactList:ListContactsResponse' :: Maybe [ContactData]
contactList = Maybe [ContactData]
a} :: ListContactsResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Next token returned in the response of a previous @ListContacts@ call.
-- Used to get the next page of results.
listContactsResponse_nextToken :: Lens.Lens' ListContactsResponse (Prelude.Maybe Prelude.Text)
listContactsResponse_nextToken :: Lens' ListContactsResponse (Maybe Text)
listContactsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListContactsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListContactsResponse' :: ListContactsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListContactsResponse
s@ListContactsResponse' {} Maybe Text
a -> ListContactsResponse
s {$sel:nextToken:ListContactsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListContactsResponse)

-- | The response's http status code.
listContactsResponse_httpStatus :: Lens.Lens' ListContactsResponse Prelude.Int
listContactsResponse_httpStatus :: Lens' ListContactsResponse Int
listContactsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListContactsResponse' {Int
httpStatus :: Int
$sel:httpStatus:ListContactsResponse' :: ListContactsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ListContactsResponse
s@ListContactsResponse' {} Int
a -> ListContactsResponse
s {$sel:httpStatus:ListContactsResponse' :: Int
httpStatus = Int
a} :: ListContactsResponse)

instance Prelude.NFData ListContactsResponse where
  rnf :: ListContactsResponse -> ()
rnf ListContactsResponse' {Int
Maybe [ContactData]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
contactList :: Maybe [ContactData]
$sel:httpStatus:ListContactsResponse' :: ListContactsResponse -> Int
$sel:nextToken:ListContactsResponse' :: ListContactsResponse -> Maybe Text
$sel:contactList:ListContactsResponse' :: ListContactsResponse -> Maybe [ContactData]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [ContactData]
contactList
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus