{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TupleSections         #-}
module Aws.Iam.Internal
    ( iamAction
    , iamAction'
    , markedIter
    , markedIterResponse

    -- * Re-exports
    , (<>)
    ) where

import           Aws.Core
import           Aws.Iam.Core
import           Control.Applicative
import           Control.Arrow       (second)
import           Control.Monad
import           Control.Monad.Trans.Resource (MonadThrow)
import           Data.ByteString     (ByteString)
import           Data.Maybe
import           Data.Monoid
import           Prelude
import           Data.Text           (Text)
import qualified Data.Text           as Text
import qualified Data.Text.Encoding  as Text
import           Text.XML.Cursor     (($//))
import qualified Text.XML.Cursor     as Cu

-- | Similar to 'iamSignQuery'. Accepts parameters in @Text@ form and UTF-8
-- encodes them. Accepts the @Action@ parameter separately since it's always
-- required.
iamAction
    :: ByteString
    -> [(ByteString, Text)]
    -> IamConfiguration qt
    -> SignatureData
    -> SignedQuery
iamAction :: forall qt.
ByteString
-> [(ByteString, Text)]
-> IamConfiguration qt
-> SignatureData
-> SignedQuery
iamAction ByteString
action = [(ByteString, ByteString)]
-> IamConfiguration qt -> SignatureData -> SignedQuery
forall qt.
[(ByteString, ByteString)]
-> IamConfiguration qt -> SignatureData -> SignedQuery
iamSignQuery
                 ([(ByteString, ByteString)]
 -> IamConfiguration qt -> SignatureData -> SignedQuery)
-> ([(ByteString, Text)] -> [(ByteString, ByteString)])
-> [(ByteString, Text)]
-> IamConfiguration qt
-> SignatureData
-> SignedQuery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) (ByteString
"Action", ByteString
action)
                 ([(ByteString, ByteString)] -> [(ByteString, ByteString)])
-> ([(ByteString, Text)] -> [(ByteString, ByteString)])
-> [(ByteString, Text)]
-> [(ByteString, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteString, Text) -> (ByteString, ByteString))
-> [(ByteString, Text)] -> [(ByteString, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> ByteString)
-> (ByteString, Text) -> (ByteString, ByteString)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Text -> ByteString
Text.encodeUtf8)

-- | Similar to 'iamAction'. Accepts parameter list with @Maybe@ parameters.
-- Ignores @Nothing@s.
iamAction'
    :: ByteString
    -> [Maybe (ByteString, Text)]
    -> IamConfiguration qt
    -> SignatureData
    -> SignedQuery
iamAction' :: forall qt.
ByteString
-> [Maybe (ByteString, Text)]
-> IamConfiguration qt
-> SignatureData
-> SignedQuery
iamAction' ByteString
action = ByteString
-> [(ByteString, Text)]
-> IamConfiguration qt
-> SignatureData
-> SignedQuery
forall qt.
ByteString
-> [(ByteString, Text)]
-> IamConfiguration qt
-> SignatureData
-> SignedQuery
iamAction ByteString
action ([(ByteString, Text)]
 -> IamConfiguration qt -> SignatureData -> SignedQuery)
-> ([Maybe (ByteString, Text)] -> [(ByteString, Text)])
-> [Maybe (ByteString, Text)]
-> IamConfiguration qt
-> SignatureData
-> SignedQuery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (ByteString, Text)] -> [(ByteString, Text)]
forall a. [Maybe a] -> [a]
catMaybes

-- | Returns the parameters @Marker@ and @MaxItems@ that are present in all
-- IAM data pagination requests.
markedIter :: Maybe Text -> Maybe Integer -> [Maybe (ByteString, Text)]
markedIter :: Maybe Text -> Maybe Integer -> [Maybe (ByteString, Text)]
markedIter Maybe Text
marker Maybe Integer
maxItems
    = [ (ByteString
"Marker"  ,)                 (Text -> (ByteString, Text))
-> Maybe Text -> Maybe (ByteString, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
marker
      , (ByteString
"MaxItems",) (Text -> (ByteString, Text))
-> (Integer -> Text) -> Integer -> (ByteString, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Text
encodeInteger (Integer -> (ByteString, Text))
-> Maybe Integer -> Maybe (ByteString, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
maxItems
      ]
  where
    encodeInteger :: Integer -> Text
encodeInteger = String -> Text
Text.pack (String -> Text) -> (Integer -> String) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show

-- | Reads and returns the @IsTruncated@ and @Marker@ attributes present in
-- all IAM data pagination responses.
markedIterResponse
    :: MonadThrow m
    => Cu.Cursor
    -> m (Bool, Maybe Text)
markedIterResponse :: forall (m :: * -> *).
MonadThrow m =>
Cursor -> m (Bool, Maybe Text)
markedIterResponse Cursor
cursor = do
    Bool
isTruncated <- (Text -> Text
Text.toCaseFold Text
"true" Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==) (Text -> Bool) -> m Text -> m Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Text -> m Text
attr Text
"IsTruncated"
    Maybe Text
marker      <- if Bool
isTruncated
                    then Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> m Text -> m (Maybe Text)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Text -> m Text
attr Text
"Marker"
                    else Maybe Text -> m (Maybe Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
    (Bool, Maybe Text) -> m (Bool, Maybe Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
isTruncated, Maybe Text
marker)
  where
    attr :: Text -> m Text
attr Text
name = String -> [Text] -> m Text
forall (m :: * -> *) a. MonadThrow m => String -> [a] -> m a
force (String
"Missing " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack Text
name) ([Text] -> m Text) -> [Text] -> m Text
forall a b. (a -> b) -> a -> b
$
                Cursor
cursor Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$// Text -> Cursor -> [Text]
elContent Text
name