diff --git a/Aws/Iam.hs b/Aws/Iam.hs new file mode 100644 --- /dev/null +++ b/Aws/Iam.hs @@ -0,0 +1,7 @@ +module Aws.Iam + ( module Aws.Iam.Commands + , module Aws.Iam.Core + ) where + +import Aws.Iam.Commands +import Aws.Iam.Core diff --git a/Aws/Iam/Commands.hs b/Aws/Iam/Commands.hs new file mode 100644 --- /dev/null +++ b/Aws/Iam/Commands.hs @@ -0,0 +1,29 @@ +module Aws.Iam.Commands + ( module Aws.Iam.Commands.CreateAccessKey + , module Aws.Iam.Commands.CreateUser + , module Aws.Iam.Commands.DeleteAccessKey + , module Aws.Iam.Commands.DeleteUser + , module Aws.Iam.Commands.DeleteUserPolicy + , module Aws.Iam.Commands.GetUser + , module Aws.Iam.Commands.GetUserPolicy + , module Aws.Iam.Commands.ListAccessKeys + , module Aws.Iam.Commands.ListUserPolicies + , module Aws.Iam.Commands.ListUsers + , module Aws.Iam.Commands.PutUserPolicy + , module Aws.Iam.Commands.UpdateAccessKey + , module Aws.Iam.Commands.UpdateUser + ) where + +import Aws.Iam.Commands.CreateAccessKey +import Aws.Iam.Commands.CreateUser +import Aws.Iam.Commands.DeleteAccessKey +import Aws.Iam.Commands.DeleteUser +import Aws.Iam.Commands.DeleteUserPolicy +import Aws.Iam.Commands.GetUser +import Aws.Iam.Commands.GetUserPolicy +import Aws.Iam.Commands.ListAccessKeys +import Aws.Iam.Commands.ListUserPolicies +import Aws.Iam.Commands.ListUsers +import Aws.Iam.Commands.PutUserPolicy +import Aws.Iam.Commands.UpdateAccessKey +import Aws.Iam.Commands.UpdateUser diff --git a/Aws/Iam/Commands/CreateAccessKey.hs b/Aws/Iam/Commands/CreateAccessKey.hs new file mode 100644 --- /dev/null +++ b/Aws/Iam/Commands/CreateAccessKey.hs @@ -0,0 +1,84 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeFamilies #-} +module Aws.Iam.Commands.CreateAccessKey + ( CreateAccessKey(..) + , CreateAccessKeyResponse(..) + , AccessKey(..) + ) where + +import Aws.Core +import Aws.Iam.Core +import Aws.Iam.Internal +import Control.Applicative +import Data.Text (Text) +import qualified Data.Text as Text +import Data.Time +import Data.Typeable +import Text.XML.Cursor (($//)) + +-- | Creates a new AWS secret access key and corresponding AWS access key ID +-- for the given user name. +-- +-- If a user name is not provided, IAM will determine the user name based on +-- the access key signing the request. +-- +-- +data CreateAccessKey = CreateAccessKey (Maybe Text) + deriving (Eq, Ord, Show, Typeable) + +instance SignQuery CreateAccessKey where + type ServiceConfiguration CreateAccessKey = IamConfiguration + signQuery (CreateAccessKey user) + = iamAction' "CreateAccessKey" [("UserName",) <$> user] + +-- | Represents the IAM @AccessKey@ data type. +-- +-- +data AccessKey + = AccessKey { + akAccessKeyId :: Text + -- ^ The Access Key ID. + , akCreateDate :: Maybe UTCTime + -- ^ Date and time at which the access key was created. + , akSecretAccessKey :: Text + -- ^ Secret key used to sign requests. The secret key is accessible only + -- during key creation. + , akStatus :: AccessKeyStatus + -- ^ Whether the access key is active or not. + , akUserName :: Text + -- ^ The user name for which this key is defined. + } + deriving (Eq, Ord, Show, Typeable) + +data CreateAccessKeyResponse + = CreateAccessKeyResponse AccessKey + deriving (Eq, Ord, Show, Typeable) + +instance ResponseConsumer CreateAccessKey CreateAccessKeyResponse where + type ResponseMetadata CreateAccessKeyResponse = IamMetadata + responseConsumer _ + = iamResponseConsumer $ \cursor -> do + let attr name = force ("Missing " ++ Text.unpack name) $ + cursor $// elContent name + akAccessKeyId <- attr "AccessKeyId" + akSecretAccessKey <- attr "SecretAccessKey" + akStatus <- readAccessKeyStatus <$> attr "Status" + akUserName <- attr "UserName" + akCreateDate <- readDate cursor + return $ CreateAccessKeyResponse AccessKey{..} + where + readDate c = case c $// elCont "CreateDate" of + (x:_) -> Just <$> parseDateTime x + _ -> return Nothing + readAccessKeyStatus s + | Text.toCaseFold s == "Active" = AccessKeyActive + | otherwise = AccessKeyInactive + + +instance Transaction CreateAccessKey CreateAccessKeyResponse + +instance AsMemoryResponse CreateAccessKeyResponse where + type MemoryResponse CreateAccessKeyResponse = CreateAccessKeyResponse + loadToMemory = return diff --git a/Aws/Iam/Commands/CreateUser.hs b/Aws/Iam/Commands/CreateUser.hs new file mode 100644 --- /dev/null +++ b/Aws/Iam/Commands/CreateUser.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeFamilies #-} +module Aws.Iam.Commands.CreateUser + ( CreateUser(..) + , CreateUserResponse(..) + , User(..) + ) where + +import Aws.Core +import Aws.Iam.Core +import Aws.Iam.Internal +import Control.Applicative +import Data.Text (Text) +import Data.Typeable + +-- | Creates a new user. +-- +-- +data CreateUser + = CreateUser { + cuUserName :: Text + -- ^ Name of the new user + , cuPath :: Maybe Text + -- ^ Path under which the user will be created. Defaults to @/@ if + -- omitted. + } + deriving (Eq, Ord, Show, Typeable) + +instance SignQuery CreateUser where + type ServiceConfiguration CreateUser = IamConfiguration + signQuery CreateUser{..} + = iamAction' "CreateUser" [ + Just ("UserName", cuUserName) + , ("Path",) <$> cuPath + ] + +data CreateUserResponse = CreateUserResponse User + deriving (Eq, Ord, Show, Typeable) + +instance ResponseConsumer CreateUser CreateUserResponse where + type ResponseMetadata CreateUserResponse = IamMetadata + responseConsumer _ = iamResponseConsumer $ + fmap CreateUserResponse . parseUser + +instance Transaction CreateUser CreateUserResponse + +instance AsMemoryResponse CreateUserResponse where + type MemoryResponse CreateUserResponse = CreateUserResponse + loadToMemory = return diff --git a/Aws/Iam/Commands/DeleteAccessKey.hs b/Aws/Iam/Commands/DeleteAccessKey.hs new file mode 100644 --- /dev/null +++ b/Aws/Iam/Commands/DeleteAccessKey.hs @@ -0,0 +1,48 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeFamilies #-} +module Aws.Iam.Commands.DeleteAccessKey + ( DeleteAccessKey(..) + , DeleteAccessKeyResponse(..) + ) where + +import Aws.Core +import Aws.Iam.Core +import Aws.Iam.Internal +import Control.Applicative +import Data.Text (Text) +import Data.Typeable + +-- | Deletes the access key associated with the specified user. +-- +-- +data DeleteAccessKey + = DeleteAccessKey { + dakAccessKeyId :: Text + -- ^ ID of the access key to be deleted. + , dakUserName :: Maybe Text + -- ^ User name with which the access key is associated. + } + deriving (Eq, Ord, Show, Typeable) + +instance SignQuery DeleteAccessKey where + type ServiceConfiguration DeleteAccessKey = IamConfiguration + signQuery DeleteAccessKey{..} + = iamAction' "DeleteAccessKey" [ + Just ("AccessKeyId", dakAccessKeyId) + , ("UserName",) <$> dakUserName + ] + +data DeleteAccessKeyResponse = DeleteAccessKeyResponse + deriving (Eq, Ord, Show, Typeable) + +instance ResponseConsumer DeleteAccessKey DeleteAccessKeyResponse where + type ResponseMetadata DeleteAccessKeyResponse = IamMetadata + responseConsumer _ = iamResponseConsumer (const $ return DeleteAccessKeyResponse) + +instance Transaction DeleteAccessKey DeleteAccessKeyResponse + +instance AsMemoryResponse DeleteAccessKeyResponse where + type MemoryResponse DeleteAccessKeyResponse = DeleteAccessKeyResponse + loadToMemory = return diff --git a/Aws/Iam/Commands/DeleteUser.hs b/Aws/Iam/Commands/DeleteUser.hs new file mode 100644 --- /dev/null +++ b/Aws/Iam/Commands/DeleteUser.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeFamilies #-} +module Aws.Iam.Commands.DeleteUser + ( DeleteUser(..) + , DeleteUserResponse(..) + ) where + +import Aws.Core +import Aws.Iam.Core +import Aws.Iam.Internal +import Data.Text (Text) +import Data.Typeable + +-- | Deletes the specified user. +-- +-- +data DeleteUser = DeleteUser Text + deriving (Eq, Ord, Show, Typeable) + +instance SignQuery DeleteUser where + type ServiceConfiguration DeleteUser = IamConfiguration + signQuery (DeleteUser userName) + = iamAction "DeleteUser" [("UserName", userName)] + +data DeleteUserResponse = DeleteUserResponse + deriving (Eq, Ord, Show, Typeable) + +instance ResponseConsumer DeleteUser DeleteUserResponse where + type ResponseMetadata DeleteUserResponse = IamMetadata + responseConsumer _ = iamResponseConsumer (const $ return DeleteUserResponse) + +instance Transaction DeleteUser DeleteUserResponse + +instance AsMemoryResponse DeleteUserResponse where + type MemoryResponse DeleteUserResponse = DeleteUserResponse + loadToMemory = return diff --git a/Aws/Iam/Commands/DeleteUserPolicy.hs b/Aws/Iam/Commands/DeleteUserPolicy.hs new file mode 100644 --- /dev/null +++ b/Aws/Iam/Commands/DeleteUserPolicy.hs @@ -0,0 +1,46 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeFamilies #-} +module Aws.Iam.Commands.DeleteUserPolicy + ( DeleteUserPolicy(..) + , DeleteUserPolicyResponse(..) + ) where + +import Aws.Core +import Aws.Iam.Core +import Aws.Iam.Internal +import Data.Text (Text) +import Data.Typeable + +-- | Deletes the specified policy associated with the specified user. +-- +-- +data DeleteUserPolicy + = DeleteUserPolicy { + dupPolicyName :: Text + -- ^ Name of the policy to be deleted. + , dupUserName :: Text + -- ^ Name of the user with whom the policy is associated. + } + deriving (Eq, Ord, Show, Typeable) + +instance SignQuery DeleteUserPolicy where + type ServiceConfiguration DeleteUserPolicy = IamConfiguration + signQuery DeleteUserPolicy{..} + = iamAction "DeleteUserPolicy" [ + ("PolicyName", dupPolicyName) + , ("UserName", dupUserName) + ] + +data DeleteUserPolicyResponse = DeleteUserPolicyResponse + deriving (Eq, Ord, Show, Typeable) + +instance ResponseConsumer DeleteUserPolicy DeleteUserPolicyResponse where + type ResponseMetadata DeleteUserPolicyResponse = IamMetadata + responseConsumer _ = iamResponseConsumer (const $ return DeleteUserPolicyResponse) + +instance Transaction DeleteUserPolicy DeleteUserPolicyResponse + +instance AsMemoryResponse DeleteUserPolicyResponse where + type MemoryResponse DeleteUserPolicyResponse = DeleteUserPolicyResponse + loadToMemory = return diff --git a/Aws/Iam/Commands/GetUser.hs b/Aws/Iam/Commands/GetUser.hs new file mode 100644 --- /dev/null +++ b/Aws/Iam/Commands/GetUser.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeFamilies #-} +module Aws.Iam.Commands.GetUser + ( GetUser(..) + , GetUserResponse(..) + , User(..) + ) where + +import Aws.Core +import Aws.Iam.Core +import Aws.Iam.Internal +import Control.Applicative +import Data.Text (Text) +import Data.Typeable + +-- | Retreives information about the given user. +-- +-- If a user name is not given, IAM determines the user name based on the +-- access key signing the request. +-- +-- +data GetUser = GetUser (Maybe Text) + deriving (Eq, Ord, Show, Typeable) + +instance SignQuery GetUser where + type ServiceConfiguration GetUser = IamConfiguration + signQuery (GetUser user) + = iamAction' "GetUser" [("UserName",) <$> user] + +data GetUserResponse = GetUserResponse User + deriving (Eq, Ord, Show, Typeable) + +instance ResponseConsumer GetUser GetUserResponse where + type ResponseMetadata GetUserResponse = IamMetadata + responseConsumer _ = iamResponseConsumer $ + fmap GetUserResponse . parseUser + +instance Transaction GetUser GetUserResponse + +instance AsMemoryResponse GetUserResponse where + type MemoryResponse GetUserResponse = GetUserResponse + loadToMemory = return diff --git a/Aws/Iam/Commands/GetUserPolicy.hs b/Aws/Iam/Commands/GetUserPolicy.hs new file mode 100644 --- /dev/null +++ b/Aws/Iam/Commands/GetUserPolicy.hs @@ -0,0 +1,71 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeFamilies #-} +module Aws.Iam.Commands.GetUserPolicy + ( GetUserPolicy(..) + , GetUserPolicyResponse(..) + ) where + +import Aws.Core +import Aws.Iam.Core +import Aws.Iam.Internal +import Control.Applicative +import Data.Text (Text) +import qualified Data.Text as Text +import qualified Data.Text.Encoding as Text +import Data.Typeable +import qualified Network.HTTP.Types as HTTP +import Text.XML.Cursor (($//)) + +-- | Retreives the specified policy document for the specified user. +-- +-- +data GetUserPolicy + = GetUserPolicy { + gupPolicyName :: Text + -- ^ Name of the policy. + , gupUserName :: Text + -- ^ Name of the user with whom the policy is associated. + } + deriving (Eq, Ord, Show, Typeable) + +instance SignQuery GetUserPolicy where + type ServiceConfiguration GetUserPolicy = IamConfiguration + signQuery GetUserPolicy{..} + = iamAction "GetUserPolicy" [ + ("PolicyName", gupPolicyName) + , ("UserName", gupUserName) + ] + +data GetUserPolicyResponse + = GetUserPolicyResponse { + guprPolicyDocument :: Text + -- ^ The policy document. + , guprPolicyName :: Text + -- ^ Name of the policy. + , guprUserName :: Text + -- ^ Name of the user with whom the policy is associated. + } + deriving (Eq, Ord, Show, Typeable) + +instance ResponseConsumer GetUserPolicy GetUserPolicyResponse where + type ResponseMetadata GetUserPolicyResponse = IamMetadata + responseConsumer _ + = iamResponseConsumer $ \cursor -> do + let attr name = force ("Missing " ++ Text.unpack name) $ + cursor $// elContent name + guprPolicyDocument <- decodePolicy <$> + attr "PolicyDocument" + guprPolicyName <- attr "PolicyName" + guprUserName <- attr "UserName" + return GetUserPolicyResponse{..} + where + decodePolicy = Text.decodeUtf8 . HTTP.urlDecode False + . Text.encodeUtf8 + + +instance Transaction GetUserPolicy GetUserPolicyResponse + +instance AsMemoryResponse GetUserPolicyResponse where + type MemoryResponse GetUserPolicyResponse = GetUserPolicyResponse + loadToMemory = return diff --git a/Aws/Iam/Commands/ListAccessKeys.hs b/Aws/Iam/Commands/ListAccessKeys.hs new file mode 100644 --- /dev/null +++ b/Aws/Iam/Commands/ListAccessKeys.hs @@ -0,0 +1,104 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeFamilies #-} +module Aws.Iam.Commands.ListAccessKeys + ( ListAccessKeys(..) + , ListAccessKeysResponse(..) + ) where + +import Aws.Core +import Aws.Iam.Core +import Aws.Iam.Internal +import Control.Applicative +import Data.Text (Text) +import Data.Time +import Data.Typeable +import Text.XML.Cursor (laxElement, ($/), ($//), (&|)) + +-- | Returns the access keys associated with the specified user. +-- +-- +data ListAccessKeys + = ListAccessKeys { + lakUserName :: Maybe Text + -- ^ Name of the user. If the user name is not specified, IAM will + -- determine the user based on the key sigining the request. + , lakMarker :: Maybe Text + -- ^ Used for paginating requests. Marks the position of the last + -- request. + , lakMaxItems :: Maybe Integer + -- ^ Used for paginating requests. Specifies the maximum number of items + -- to return in the response. Defaults to 100. + } + deriving (Eq, Ord, Show, Typeable) + +instance SignQuery ListAccessKeys where + type ServiceConfiguration ListAccessKeys = IamConfiguration + signQuery ListAccessKeys{..} + = iamAction' "ListAccessKeys" $ [ + ("UserName",) <$> lakUserName + ] <> markedIter lakMarker lakMaxItems + +-- | Represents the IAM @AccessKeyMetadata@ data type. +-- +-- +data AccessKeyMetadata + = AccessKeyMetadata { + akmAccessKeyId :: Maybe Text + -- ^ ID of the access key. + , akmCreateDate :: Maybe UTCTime + -- ^ Date and time at which the access key was created. + , akmStatus :: Maybe Text + -- ^ Whether the access key is active. + , akmUserName :: Maybe Text + -- ^ Name of the user with whom the access key is associated. + } + deriving (Eq, Ord, Show, Typeable) + +data ListAccessKeysResponse + = ListAccessKeysResponse { + lakrAccessKeyMetadata :: [AccessKeyMetadata] + -- ^ List of 'AccessKeyMetadata' objects + , lakrIsTruncated :: Bool + -- ^ @True@ if the request was truncated because of too many items. + , lakrMarker :: Maybe Text + -- ^ Marks the position at which the request was truncated. This value + -- must be passed with the next request to continue listing from the + -- last position. + } + deriving (Eq, Ord, Show, Typeable) + +instance ResponseConsumer ListAccessKeys ListAccessKeysResponse where + type ResponseMetadata ListAccessKeysResponse = IamMetadata + responseConsumer _ + = iamResponseConsumer $ \cursor -> do + (lakrIsTruncated, lakrMarker) <- markedIterResponse cursor + lakrAccessKeyMetadata <- sequence $ + cursor $// laxElement "member" &| buildAKM + return ListAccessKeysResponse{..} + where + buildAKM m = do + let mattr name = mhead $ m $/ elContent name + let akmAccessKeyId = mattr "AccessKeyId" + akmStatus = mattr "Status" + akmUserName = mattr "UserName" + akmCreateDate <- case m $/ elCont "CreateDate" of + (x:_) -> Just <$> parseDateTime x + _ -> return Nothing + return AccessKeyMetadata{..} + + mhead (x:_) = Just x + mhead _ = Nothing + +instance Transaction ListAccessKeys ListAccessKeysResponse + +instance IteratedTransaction ListAccessKeys ListAccessKeysResponse where + nextIteratedRequest request response + = case lakrMarker response of + Nothing -> Nothing + Just marker -> Just $ request { lakMarker = Just marker } + +instance AsMemoryResponse ListAccessKeysResponse where + type MemoryResponse ListAccessKeysResponse = ListAccessKeysResponse + loadToMemory = return diff --git a/Aws/Iam/Commands/ListUserPolicies.hs b/Aws/Iam/Commands/ListUserPolicies.hs new file mode 100644 --- /dev/null +++ b/Aws/Iam/Commands/ListUserPolicies.hs @@ -0,0 +1,71 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeFamilies #-} +module Aws.Iam.Commands.ListUserPolicies + ( ListUserPolicies(..) + , ListUserPoliciesResponse(..) + ) where + +import Aws.Core +import Aws.Iam.Core +import Aws.Iam.Internal +import Data.Text (Text) +import Data.Typeable +import Text.XML.Cursor (content, laxElement, ($//), (&/)) + +-- | Lists the user policies associated with the specified user. +-- +-- +data ListUserPolicies + = ListUserPolicies { + lupUserName :: Text + -- ^ Policies associated with this user will be listed. + , lupMarker :: Maybe Text + -- ^ Used for paginating requests. Marks the position of the last + -- request. + , lupMaxItems :: Maybe Integer + -- ^ Used for paginating requests. Specifies the maximum number of items + -- to return in the response. Defaults to 100. + } + deriving (Eq, Ord, Show, Typeable) + +instance SignQuery ListUserPolicies where + type ServiceConfiguration ListUserPolicies = IamConfiguration + signQuery ListUserPolicies{..} + = iamAction' "ListUserPolicies" $ [ + Just ("UserName", lupUserName) + ] <> markedIter lupMarker lupMaxItems + +data ListUserPoliciesResponse + = ListUserPoliciesResponse { + luprPolicyNames :: [Text] + -- ^ List of policy names. + , luprIsTruncated :: Bool + -- ^ @True@ if the request was truncated because of too many items. + , luprMarker :: Maybe Text + -- ^ Marks the position at which the request was truncated. This value + -- must be passed with the next request to continue listing from the + -- last position. + } + deriving (Eq, Ord, Show, Typeable) + +instance ResponseConsumer ListUserPolicies ListUserPoliciesResponse where + type ResponseMetadata ListUserPoliciesResponse = IamMetadata + responseConsumer _ + = iamResponseConsumer $ \cursor -> do + (luprIsTruncated, luprMarker) <- markedIterResponse cursor + let luprPolicyNames = cursor $// laxElement "member" &/ content + return ListUserPoliciesResponse{..} + +instance Transaction ListUserPolicies ListUserPoliciesResponse + +instance IteratedTransaction ListUserPolicies ListUserPoliciesResponse where + nextIteratedRequest request response + = case luprMarker response of + Nothing -> Nothing + Just marker -> Just $ request { lupMarker = Just marker } + +instance AsMemoryResponse ListUserPoliciesResponse where + type MemoryResponse ListUserPoliciesResponse = ListUserPoliciesResponse + loadToMemory = return diff --git a/Aws/Iam/Commands/ListUsers.hs b/Aws/Iam/Commands/ListUsers.hs new file mode 100644 --- /dev/null +++ b/Aws/Iam/Commands/ListUsers.hs @@ -0,0 +1,75 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeFamilies #-} +module Aws.Iam.Commands.ListUsers + ( ListUsers(..) + , ListUsersResponse(..) + , User(..) + ) where + +import Aws.Core +import Aws.Iam.Core +import Aws.Iam.Internal +import Control.Applicative +import Data.Text (Text) +import Data.Typeable +import Text.XML.Cursor (laxElement, ($//), (&|)) + +-- | Lists users that have the specified path prefix. +-- +-- +data ListUsers + = ListUsers { + luPathPrefix :: Maybe Text + -- ^ Users defined under this path will be listed. If omitted, defaults + -- to @/@, which lists all users. + , luMarker :: Maybe Text + -- ^ Used for paginating requests. Marks the position of the last + -- request. + , luMaxItems :: Maybe Integer + -- ^ Used for paginating requests. Specifies the maximum number of items + -- to return in the response. Defaults to 100. + } + deriving (Eq, Ord, Show, Typeable) + +instance SignQuery ListUsers where + type ServiceConfiguration ListUsers = IamConfiguration + signQuery ListUsers{..} + = iamAction' "ListUsers" $ [ + ("PathPrefix",) <$> luPathPrefix + ] <> markedIter luMarker luMaxItems + +data ListUsersResponse + = ListUsersResponse { + lurUsers :: [User] + -- ^ List of 'User's. + , lurIsTruncated :: Bool + -- ^ @True@ if the request was truncated because of too many items. + , lurMarker :: Maybe Text + -- ^ Marks the position at which the request was truncated. This value + -- must be passed with the next request to continue listing from the + -- last position. + } + deriving (Eq, Ord, Show, Typeable) + +instance ResponseConsumer ListUsers ListUsersResponse where + type ResponseMetadata ListUsersResponse = IamMetadata + responseConsumer _ + = iamResponseConsumer $ \cursor -> do + (lurIsTruncated, lurMarker) <- markedIterResponse cursor + lurUsers <- sequence $ + cursor $// laxElement "member" &| parseUser + return ListUsersResponse{..} + +instance Transaction ListUsers ListUsersResponse + +instance IteratedTransaction ListUsers ListUsersResponse where + nextIteratedRequest request response + = case lurMarker response of + Nothing -> Nothing + Just marker -> Just $ request { luMarker = Just marker } + +instance AsMemoryResponse ListUsersResponse where + type MemoryResponse ListUsersResponse = ListUsersResponse + loadToMemory = return diff --git a/Aws/Iam/Commands/PutUserPolicy.hs b/Aws/Iam/Commands/PutUserPolicy.hs new file mode 100644 --- /dev/null +++ b/Aws/Iam/Commands/PutUserPolicy.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeFamilies #-} +module Aws.Iam.Commands.PutUserPolicy + ( PutUserPolicy(..) + , PutUserPolicyResponse(..) + ) where + +import Aws.Core +import Aws.Iam.Core +import Aws.Iam.Internal +import Data.Text (Text) +import Data.Typeable + +-- | Adds a policy document with the specified name, associated with the +-- specified user. +-- +-- +data PutUserPolicy + = PutUserPolicy { + pupPolicyDocument :: Text + -- ^ The policy document. + , pupPolicyName :: Text + -- ^ Name of the policy. + , pupUserName :: Text + -- ^ Name of the user with whom this policy is associated. + } + deriving (Eq, Ord, Show, Typeable) + +instance SignQuery PutUserPolicy where + type ServiceConfiguration PutUserPolicy = IamConfiguration + signQuery PutUserPolicy{..} + = iamAction "PutUserPolicy" [ + ("PolicyDocument", pupPolicyDocument) + , ("PolicyName" , pupPolicyName) + , ("UserName" , pupUserName) + ] + +data PutUserPolicyResponse = PutUserPolicyResponse + deriving (Eq, Ord, Show, Typeable) + +instance ResponseConsumer PutUserPolicy PutUserPolicyResponse where + type ResponseMetadata PutUserPolicyResponse = IamMetadata + responseConsumer _ + = iamResponseConsumer (const $ return PutUserPolicyResponse) + +instance Transaction PutUserPolicy PutUserPolicyResponse + +instance AsMemoryResponse PutUserPolicyResponse where + type MemoryResponse PutUserPolicyResponse = PutUserPolicyResponse + loadToMemory = return diff --git a/Aws/Iam/Commands/UpdateAccessKey.hs b/Aws/Iam/Commands/UpdateAccessKey.hs new file mode 100644 --- /dev/null +++ b/Aws/Iam/Commands/UpdateAccessKey.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeFamilies #-} +module Aws.Iam.Commands.UpdateAccessKey + ( UpdateAccessKey(..) + , UpdateAccessKeyResponse(..) + ) where + +import Aws.Core +import Aws.Iam.Core +import Aws.Iam.Internal +import Control.Applicative +import Data.Text (Text) +import Data.Typeable + +-- | Changes the status of the specified access key. +-- +-- +data UpdateAccessKey + = UpdateAccessKey { + uakAccessKeyId :: Text + -- ^ ID of the access key to update. + , uakStatus :: AccessKeyStatus + -- ^ New status of the access key. + , uakUserName :: Maybe Text + -- ^ Name of the user to whom the access key belongs. If omitted, the + -- user will be determined based on the access key used to sign the + -- request. + } + deriving (Eq, Ord, Show, Typeable) + +instance SignQuery UpdateAccessKey where + type ServiceConfiguration UpdateAccessKey = IamConfiguration + signQuery UpdateAccessKey{..} + = iamAction' "UpdateAccessKey" [ + Just ("AccessKeyId", uakAccessKeyId) + , Just ("Status", showStatus uakStatus) + , ("UserName",) <$> uakUserName + ] + where + showStatus AccessKeyActive = "Active" + showStatus _ = "Inactive" + +data UpdateAccessKeyResponse = UpdateAccessKeyResponse + deriving (Eq, Ord, Show, Typeable) + +instance ResponseConsumer UpdateAccessKey UpdateAccessKeyResponse where + type ResponseMetadata UpdateAccessKeyResponse = IamMetadata + responseConsumer _ + = iamResponseConsumer (const $ return UpdateAccessKeyResponse) + +instance Transaction UpdateAccessKey UpdateAccessKeyResponse + +instance AsMemoryResponse UpdateAccessKeyResponse where + type MemoryResponse UpdateAccessKeyResponse = UpdateAccessKeyResponse + loadToMemory = return diff --git a/Aws/Iam/Commands/UpdateUser.hs b/Aws/Iam/Commands/UpdateUser.hs new file mode 100644 --- /dev/null +++ b/Aws/Iam/Commands/UpdateUser.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeFamilies #-} +module Aws.Iam.Commands.UpdateUser + ( UpdateUser(..) + , UpdateUserResponse(..) + ) where + +import Aws.Core +import Aws.Iam.Core +import Aws.Iam.Internal +import Control.Applicative +import Data.Text (Text) +import Data.Typeable + +-- | Updates the name and/or path of the specified user. +-- +-- +data UpdateUser + = UpdateUser { + uuUserName :: Text + -- ^ Name of the user to be updated. + , uuNewUserName :: Maybe Text + -- ^ New name for the user. + , uuNewPath :: Maybe Text + -- ^ New path to which the user will be moved. + } + deriving (Eq, Ord, Show, Typeable) + +instance SignQuery UpdateUser where + type ServiceConfiguration UpdateUser = IamConfiguration + signQuery UpdateUser{..} + = iamAction' "UpdateUser" [ + Just ("UserName", uuUserName) + , ("NewUserName",) <$> uuNewUserName + , ("NewPath",) <$> uuNewPath + ] + +data UpdateUserResponse = UpdateUserResponse + deriving (Eq, Ord, Show, Typeable) + +instance ResponseConsumer UpdateUser UpdateUserResponse where + type ResponseMetadata UpdateUserResponse = IamMetadata + responseConsumer _ + = iamResponseConsumer (const $ return UpdateUserResponse) + +instance Transaction UpdateUser UpdateUserResponse + +instance AsMemoryResponse UpdateUserResponse where + type MemoryResponse UpdateUserResponse = UpdateUserResponse + loadToMemory = return diff --git a/Aws/Iam/Core.hs b/Aws/Iam/Core.hs new file mode 100644 --- /dev/null +++ b/Aws/Iam/Core.hs @@ -0,0 +1,197 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RecordWildCards #-} +module Aws.Iam.Core + ( iamSignQuery + , iamResponseConsumer + , IamMetadata(..) + , IamConfiguration(..) + , IamError(..) + + , parseDateTime + + , AccessKeyStatus(..) + , User(..) + , parseUser + ) where + +import Aws.Core +import qualified Blaze.ByteString.Builder as Blaze +import qualified Blaze.ByteString.Builder.Char8 as Blaze8 +import Control.Exception (Exception) +import qualified Control.Failure as F +import Control.Monad +import Data.ByteString (ByteString) +import Data.IORef +import Data.List (intersperse, sort) +import Data.Maybe +import Data.Monoid +import Data.Text (Text) +import qualified Data.Text as Text +import Data.Time +import Data.Typeable +import qualified Network.HTTP.Conduit as HTTP +import qualified Network.HTTP.Types as HTTP +import System.Locale +import Text.XML.Cursor (($//)) +import qualified Text.XML.Cursor as Cu + +data IamError + = IamError { + iamStatusCode :: HTTP.Status + , iamErrorCode :: Text + , iamErrorMessage :: Text + } + deriving (Show, Typeable) + +instance Exception IamError + +data IamMetadata + = IamMetadata { + requestId :: Maybe Text + } + deriving (Show, Typeable) + +instance Loggable IamMetadata where + toLogText (IamMetadata r) = "IAM: request ID=" <> fromMaybe "" r + +instance Monoid IamMetadata where + mempty = IamMetadata Nothing + IamMetadata r1 `mappend` IamMetadata r2 = IamMetadata (r1 `mplus` r2) + +data IamConfiguration qt + = IamConfiguration { + iamEndpoint :: ByteString + , iamPort :: Int + , iamProtocol :: Protocol + , iamHttpMethod :: Method + } + deriving (Show) + +instance DefaultServiceConfiguration (IamConfiguration NormalQuery) where + defServiceConfig = iam PostQuery HTTPS iamEndpointDefault + debugServiceConfig = iam PostQuery HTTP iamEndpointDefault + +instance DefaultServiceConfiguration (IamConfiguration UriOnlyQuery) where + defServiceConfig = iam Get HTTPS iamEndpointDefault + debugServiceConfig = iam Get HTTP iamEndpointDefault + +-- | The default IAM endpoint. +iamEndpointDefault :: ByteString +iamEndpointDefault = "iam.amazonaws.com" + +-- | Constructs an IamConfiguration with the specified parameters. +iam :: Method -> Protocol -> ByteString -> IamConfiguration qt +iam method protocol endpoint + = IamConfiguration { + iamEndpoint = endpoint + , iamProtocol = protocol + , iamPort = defaultPort protocol + , iamHttpMethod = method + } + +-- | Constructs a 'SignedQuery' with the specified request parameters. +iamSignQuery + :: [(ByteString, ByteString)] + -- ^ Pairs of parameter names and values that will be passed as part of + -- the request data. + -> IamConfiguration qt + -> SignatureData + -> SignedQuery +iamSignQuery q IamConfiguration{..} SignatureData{..} + = SignedQuery { + sqMethod = iamHttpMethod + , sqProtocol = iamProtocol + , sqHost = iamEndpoint + , sqPort = iamPort + , sqPath = "/" + , sqQuery = signedQuery + , sqDate = Just signatureTime + , sqAuthorization = Nothing + , sqContentType = Nothing + , sqContentMd5 = Nothing + , sqAmzHeaders = [] + , sqOtherHeaders = [] + , sqBody = Nothing + , sqStringToSign = stringToSign + } + where + sig = signature signatureCredentials HmacSHA256 stringToSign + signedQuery = ("Signature", Just sig):expandedQuery + accessKey = accessKeyID signatureCredentials + timestampHeader = + case signatureTimeInfo of + AbsoluteTimestamp time -> ("Timestamp", fmtAmzTime time) + AbsoluteExpires time -> ("Expires" , fmtAmzTime time) + newline = Blaze8.fromChar '\n' + stringToSign = Blaze.toByteString . mconcat . intersperse newline $ + map Blaze.copyByteString + [httpMethod iamHttpMethod, iamEndpoint, "/"] + ++ [HTTP.renderQueryBuilder False expandedQuery] + expandedQuery = HTTP.toQuery . sort $ (q ++) [ + ("AWSAccessKeyId" , accessKey) + , ("SignatureMethod" , amzHash HmacSHA256) + , ("SignatureVersion", "2") + , ("Version" , "2010-05-08") + , timestampHeader + ] + +-- | Reads the metadata from an IAM response and delegates parsing the rest of +-- the data from the response to the given function. +iamResponseConsumer :: (Cu.Cursor -> Response IamMetadata a) + -> IORef IamMetadata + -> HTTPResponseConsumer a +iamResponseConsumer inner md resp = xmlCursorConsumer parse md resp + where + parse cursor = do + let rid = listToMaybe $ cursor $// elContent "RequestID" + tellMetadata $ IamMetadata rid + case cursor $// Cu.laxElement "Error" of + [] -> inner cursor + (err:_) -> fromError err + fromError cursor = do + errCode <- force "Missing Error Code" $ cursor $// elContent "Code" + errMsg <- force "Missing Error Message" $ cursor $// elContent "Message" + F.failure $ IamError (HTTP.responseStatus resp) errCode errMsg + +-- | Parses IAM @DateTime@ data type. +parseDateTime :: (F.Failure XmlException m) => String -> m UTCTime +parseDateTime x + = case parseTime defaultTimeLocale iso8601UtcDate x of + Nothing -> F.failure $ XmlException $ "Invalid DateTime: " ++ x + Just dt -> return dt + +-- | The IAM @User@ data type. +-- +-- +data User + = User { + userArn :: Text + -- ^ ARN used to refer to this user. + , userCreateDate :: UTCTime + -- ^ Date and time at which the user was created. + , userPath :: Text + -- ^ Path under which the user was created. + , userUserId :: Text + -- ^ Unique identifier used to refer to this user. + , userUserName :: Text + -- ^ Name of the user. + } + deriving (Eq, Ord, Show, Typeable) + +-- | Parses the IAM @User@ data type. +parseUser :: (F.Failure XmlException m) => Cu.Cursor -> m User +parseUser cursor = do + userArn <- attr "Arn" + userCreateDate <- attr "CreateDate" >>= parseDateTime . Text.unpack + userPath <- attr "Path" + userUserId <- attr "UserId" + userUserName <- attr "UserName" + return User{..} + where + attr name = force ("Missing " ++ Text.unpack name) $ + cursor $// elContent name + + +data AccessKeyStatus = AccessKeyActive | AccessKeyInactive + deriving (Eq, Ord, Show, Typeable) diff --git a/Aws/Iam/Internal.hs b/Aws/Iam/Internal.hs new file mode 100644 --- /dev/null +++ b/Aws/Iam/Internal.hs @@ -0,0 +1,76 @@ +{-# 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 qualified Control.Failure as F +import Control.Monad +import Data.ByteString (ByteString) +import Data.Maybe +import Data.Monoid ((<>)) +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 action = iamSignQuery + . (:) ("Action", action) + . map (second Text.encodeUtf8) + +-- | Similar to 'iamAction'. Accepts parameter list with @Maybe@ parameters. +-- Ignores @Nothing@s. +iamAction' + :: ByteString + -> [Maybe (ByteString, Text)] + -> IamConfiguration qt + -> SignatureData + -> SignedQuery +iamAction' action = iamAction action . 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 marker maxItems + = [ ("Marker" ,) <$> marker + , ("MaxItems",) . encodeInteger <$> maxItems + ] + where + encodeInteger = Text.pack . show + +-- | Reads and returns the @IsTruncated@ and @Marker@ attributes present in +-- all IAM data pagination responses. +markedIterResponse + :: F.Failure XmlException m + => Cu.Cursor + -> m (Bool, Maybe Text) +markedIterResponse cursor = do + isTruncated <- (Text.toCaseFold "true" ==) `liftM` attr "IsTruncated" + marker <- if isTruncated + then Just `liftM` attr "Marker" + else return Nothing + return (isTruncated, marker) + where + attr name = force ("Missing " ++ Text.unpack name) $ + cursor $// elContent name diff --git a/README.org b/README.org --- a/README.org +++ b/README.org @@ -90,6 +90,10 @@ ** 0.8 series +- 0.8.3 + - compatibility with cryptohash 0.11 + - experimental IAM support + - 0.8.2 - compatibility with cereal 0.4.x @@ -199,6 +203,7 @@ | Name | Github | E-Mail | Company | Components | |--------------------+--------------+---------------------------+------------------------+---------------| +| Abhinav Gupta | [[https://github.com/abhinav][abhinav]] | mail@abhinavg.net | - | IAM, SES | | Aristid Breitkreuz | [[https://github.com/aristidb][aristidb]] | aristidb@gmail.com | - | Co-Maintainer | | Bas van Dijk | [[https://github.com/basvandijk][basvandijk]] | v.dijk.bas@gmail.com | [[http://erudify.ch][Erudify AG]] | S3 | | David Vollbracht | [[https://github.com/qxjit][qxjit]] | | | | diff --git a/aws.cabal b/aws.cabal --- a/aws.cabal +++ b/aws.cabal @@ -1,5 +1,5 @@ Name: aws -Version: 0.8.2 +Version: 0.8.3 Synopsis: Amazon Web Services (AWS) for Haskell Description: Bindings for Amazon Web Services (AWS), with the aim of supporting all AWS services. To see a high level overview of the library, see the README at . Homepage: http://github.com/aristidb/aws @@ -20,7 +20,7 @@ Source-repository this type: git location: https://github.com/aristidb/aws.git - tag: 0.8.2 + tag: 0.8.3 Source-repository head type: git @@ -36,6 +36,23 @@ Aws.Aws, Aws.Core, Aws.Ec2.InstanceMetadata, + Aws.Iam, + Aws.Iam.Commands, + Aws.Iam.Commands.CreateAccessKey, + Aws.Iam.Commands.CreateUser, + Aws.Iam.Commands.DeleteAccessKey, + Aws.Iam.Commands.DeleteUser, + Aws.Iam.Commands.DeleteUserPolicy, + Aws.Iam.Commands.GetUser, + Aws.Iam.Commands.GetUserPolicy, + Aws.Iam.Commands.ListAccessKeys, + Aws.Iam.Commands.ListUserPolicies, + Aws.Iam.Commands.ListUsers, + Aws.Iam.Commands.PutUserPolicy, + Aws.Iam.Commands.UpdateAccessKey, + Aws.Iam.Commands.UpdateUser, + Aws.Iam.Core, + Aws.Iam.Internal, Aws.S3, Aws.S3.Commands, Aws.S3.Commands.CopyObject, @@ -88,7 +105,7 @@ conduit >= 1.0 && < 1.1, containers >= 0.4, crypto-api >= 0.9, - cryptohash >= 0.8 && < 0.11, + cryptohash >= 0.8 && < 0.12, cryptohash-cryptoapi == 0.1.*, directory >= 1.0 && < 1.3, failure >= 0.2.0.1 && < 0.3,