haskell/minio-hs
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Implement getBucketPolicy/setBucketPolicy (#82)

Browse Source 
fixes #40
fixes #39
This commit is contained in:
Harshavardhana 2018-03-27 00:08:58 -07:00 committed by Krishnan Parthasarathi
parent 51b3e51d46
commit 6d20558098
3 changed files with 86 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
src/Network/Minio.hs
View File

@ -73,7 +73,7 @@ module Network.Minio
, ObjectPartInfo(..)
, listIncompleteParts
-- ** Notifications
-- ** Bucket Notifications
, Notification(..)
, NotificationConfig(..)
, Arn
@ -88,7 +88,6 @@ module Network.Minio
-- * Object Operations
----------------------
, Object
-- ** File operations

59
src/Network/Minio/S3API.hs
View File

@ -1,5 +1,5 @@
--
-- Minio Haskell SDK, (C) 2017 Minio, Inc.
-- Minio Haskell SDK, (C) 2017, 2018 Minio, Inc.
--
-- Licensed under the Apache License, Version 2.0 (the "License");
-- you may not use this file except in compliance with the License.
@ -70,6 +70,10 @@ module Network.Minio.S3API
-----------------------------
, module Network.Minio.PresignedOperations
-- ** Bucket Policies
, getBucketPolicy
, setBucketPolicy
-- * Bucket Notifications
-------------------------
, Notification(..)
@ -85,23 +89,23 @@ module Network.Minio.S3API
, removeAllBucketNotification
) where
import Control.Monad.Catch (catches, Handler(..))
import qualified Data.Conduit as C
import Data.Default (def)
import qualified Network.HTTP.Conduit as NC
import qualified Network.HTTP.Types as HT
import Network.HTTP.Types.Status (status404)
import Control.Monad.Catch (Handler (..), catches)
import qualified Data.Conduit as C
import Data.Default (def)
import qualified Data.Text as T
import Lib.Prelude hiding (catches)
import Lib.Prelude hiding (catches)
import qualified Network.HTTP.Conduit as NC
import qualified Network.HTTP.Types as HT
import Network.HTTP.Types.Status (status404)
import Network.Minio.API
import Network.Minio.Data
import Network.Minio.Errors
import Network.Minio.PresignedOperations
import Network.Minio.Utils
import Network.Minio.XmlGenerator
import Network.Minio.XmlParser
import Network.Minio.PresignedOperations
-- | Fetch all buckets from the service.
getService :: Minio [BucketInfo]
@ -435,3 +439,38 @@ getBucketNotification bucket = do
-- | Remove all notifications configured on a bucket.
removeAllBucketNotification :: Bucket -> Minio ()
removeAllBucketNotification = flip putBucketNotification def
-- | Fetch the policy if any on a bucket.
getBucketPolicy :: Bucket -> Minio Text
getBucketPolicy bucket = do
resp <- executeRequest $ def { riMethod = HT.methodGet
, riBucket = Just bucket
, riQueryParams = [("policy", Nothing)]
}
return $ toS $ NC.responseBody resp
-- | Set a new policy on a bucket.
-- As a special condition if the policy is empty
-- then we treat it as policy DELETE operation.
setBucketPolicy :: Bucket -> Text -> Minio ()
setBucketPolicy bucket policy = do
if T.null policy
then deleteBucketPolicy bucket
else putBucketPolicy bucket policy
-- | Save a new policy on a bucket.
putBucketPolicy :: Bucket -> Text -> Minio()
putBucketPolicy bucket policy = do
void $ executeRequest $ def { riMethod = HT.methodPut
, riBucket = Just bucket
, riQueryParams = [("policy", Nothing)]
, riPayload = PayloadBS $ encodeUtf8 policy
}
-- | Delete any policy set on a bucket.
deleteBucketPolicy :: Bucket -> Minio()
deleteBucketPolicy bucket = do
void $ executeRequest $ def { riMethod = HT.methodDelete
, riBucket = Just bucket
, riQueryParams = [("policy", Nothing)]
}

36
test/LiveServer.hs
View File

@ -533,6 +533,7 @@ liveServerUnitTests = testGroup "Unit tests against a live server"
, presignedUrlFunTest
, presignedPostPolicyFunTest
, bucketPolicyFunTest
]
basicTests :: TestTree
@ -757,3 +758,38 @@ presignedPostPolicyFunTest = funTestWithBucket "Presigned Post Policy tests" $
req' <- Form.formDataBody parts' req
mgr <- NC.newManager NC.tlsManagerSettings
NC.httpLbs req' mgr
bucketPolicyFunTest :: TestTree
bucketPolicyFunTest = funTestWithBucket "Bucket Policy tests" $
\step bucket -> do
step "bucketPolicy basic test - no policy exception"
resE <- MC.try $ getBucketPolicy bucket
case resE of
Left exn -> liftIO $ exn @?= ServiceErr "NoSuchBucketPolicy" "The bucket policy does not exist"
_ -> return ()
resE' <- MC.try $ setBucketPolicy bucket T.empty
case resE' of
Left exn -> liftIO $ exn @?= ServiceErr "NoSuchBucketPolicy" "The bucket policy does not exist"
_ -> return ()
let expectedPolicyJSON = "{\"Version\":\"2012-10-17\",\"Statement\":[{\"Action\":[\"s3:GetBucketLocation\",\"s3:ListBucket\"],\"Effect\":\"Allow\",\"Principal\":{\"AWS\":[\"*\"]},\"Resource\":[\"arn:aws:s3:::testbucket\"],\"Sid\":\"\"},{\"Action\":[\"s3:GetObject\"],\"Effect\":\"Allow\",\"Principal\":{\"AWS\":[\"*\"]},\"Resource\":[\"arn:aws:s3:::testbucket/*\"],\"Sid\":\"\"}]}"
step "try a malformed policy, expect error"
resE'' <- MC.try $ setBucketPolicy bucket expectedPolicyJSON
case resE'' of
Left exn -> liftIO $ exn @?= ServiceErr "MalformedPolicy" "Policy has invalid resource."
_ -> return ()
let expectedPolicyJSON' = "{\"Version\":\"2012-10-17\",\"Statement\":[{\"Action\":[\"s3:GetBucketLocation\",\"s3:ListBucket\"],\"Effect\":\"Allow\",\"Principal\":{\"AWS\":[\"*\"]},\"Resource\":[\"arn:aws:s3:::" <> bucket <> "\"],\"Sid\":\"\"},{\"Action\":[\"s3:GetObject\"],\"Effect\":\"Allow\",\"Principal\":{\"AWS\":[\"*\"]},\"Resource\":[\"arn:aws:s3:::" <> bucket <> "/*\"],\"Sid\":\"\"}]}"
step "set bucket policy"
setBucketPolicy bucket expectedPolicyJSON'
step "verify if bucket policy was properly set"
policyJSON <- getBucketPolicy bucket
liftIO $ policyJSON @?= expectedPolicyJSON'
step "delete bucket policy"
setBucketPolicy bucket T.empty