diff --git a/minio-hs.cabal b/minio-hs.cabal index d2a2c61..bdc5222 100644 --- a/minio-hs.cabal +++ b/minio-hs.cabal @@ -63,7 +63,6 @@ library , memory , resourcet , text - , text-format , time , transformers , unliftio @@ -152,7 +151,6 @@ test-suite minio-hs-live-server-test , tasty-smallcheck , temporary , text - , text-format , time , transformers , unliftio @@ -192,7 +190,6 @@ test-suite minio-hs-test , tasty-smallcheck , temporary , text - , text-format , time , transformers , unliftio diff --git a/src/Lib/Prelude.hs b/src/Lib/Prelude.hs index c7ebbae..8f072e6 100644 --- a/src/Lib/Prelude.hs +++ b/src/Lib/Prelude.hs @@ -17,29 +17,16 @@ module Lib.Prelude ( module Exports , both - - , format - , formatBS ) where -import Protolude as Exports +import Protolude as Exports -import Data.Time as Exports (UTCTime(..), diffUTCTime) -import Control.Monad.Trans.Maybe as Exports (runMaybeT, MaybeT(..)) +import Control.Monad.Trans.Maybe as Exports (MaybeT (..), runMaybeT) +import Data.Time as Exports (UTCTime (..), + diffUTCTime) -import Control.Monad.Catch as Exports (throwM, MonadThrow, MonadCatch) - -import Data.Text.Format as Exports (Shown(..)) -import qualified Data.Text.Format as TF -import Data.Text.Format.Params (Params) - -format :: Params ps => TF.Format -> ps -> Text -format f args = toS $ TF.format f args - -formatBS :: Params ps => TF.Format -> ps -> ByteString -formatBS f args = toS $ TF.format f args - --- import Data.Tuple as Exports (uncurry) +import Control.Monad.Catch as Exports (MonadCatch, MonadThrow, + throwM) -- | Apply a function on both elements of a pair both :: (a -> b) -> (a, a) -> (b, b) diff --git a/src/Network/Minio/API.hs b/src/Network/Minio/API.hs index abf6d27..aafff60 100644 --- a/src/Network/Minio/API.hs +++ b/src/Network/Minio/API.hs @@ -28,18 +28,18 @@ module Network.Minio.API , checkObjectNameValidity ) where -import qualified Data.Conduit as C -import Data.Conduit.Binary (sourceHandleRange) -import Data.Default (def) -import qualified Data.Map as Map -import qualified Data.Char as C -import qualified Data.Text as T -import qualified Data.ByteString as B +import qualified Data.ByteString as B +import qualified Data.Char as C +import qualified Data.Conduit as C +import Data.Conduit.Binary (sourceHandleRange) +import Data.Default (def) +import qualified Data.Map as Map +import qualified Data.Text as T -import Network.HTTP.Conduit (Response) -import qualified Network.HTTP.Conduit as NC -import qualified Network.HTTP.Types as HT -import Network.HTTP.Types.Header (hHost) +import Network.HTTP.Conduit (Response) +import qualified Network.HTTP.Conduit as NC +import qualified Network.HTTP.Types as HT +import Network.HTTP.Types.Header (hHost) import Lib.Prelude @@ -128,9 +128,7 @@ buildRequest ri = do -- otherwise compute sha256 | otherwise -> getPayloadSHA256Hash (riPayload ri) - let hostHeader = (hHost, formatBS "{}:{}" [connectHost ci, - show $ connectPort ci]) - + let hostHeader = (hHost, getHostAddr ci) newRi = ri { riPayloadHash = Just sha256Hash , riHeaders = hostHeader : sha256Header sha256Hash diff --git a/src/Network/Minio/Data.hs b/src/Network/Minio/Data.hs index 36cf9b0..15d6598 100644 --- a/src/Network/Minio/Data.hs +++ b/src/Network/Minio/Data.hs @@ -24,13 +24,13 @@ import qualified Control.Monad.Catch as MC import Control.Monad.IO.Unlift (MonadUnliftIO, UnliftIO (..), askUnliftIO, withUnliftIO) import Control.Monad.Trans.Resource - import qualified Data.ByteString as B import Data.CaseInsensitive (mk) import Data.Default (Default (..)) import qualified Data.Map as Map import qualified Data.Text as T import Data.Time (defaultTimeLocale, formatTime) +import GHC.Show (Show (show)) import Network.HTTP.Client (defaultManagerSettings) import qualified Network.HTTP.Conduit as NC import Network.HTTP.Types (ByteRange, Header, Method, Query, @@ -39,8 +39,6 @@ import qualified Network.HTTP.Types as HT import Network.Minio.Errors import Text.XML -import GHC.Show (Show (..)) - import Lib.Prelude -- | max obj size is 5TiB @@ -99,6 +97,12 @@ data ConnectInfo = ConnectInfo { instance Default ConnectInfo where def = ConnectInfo "localhost" 9000 "minio" "minio123" False "us-east-1" True +getHostAddr :: ConnectInfo -> ByteString +getHostAddr ci = toS $ T.concat [ connectHost ci, ":" + , Lib.Prelude.show $ connectPort ci + ] + + -- | Default AWS ConnectInfo. Connects to "us-east-1". Credentials -- should be supplied before use, for e.g.: -- diff --git a/src/Network/Minio/PresignedOperations.hs b/src/Network/Minio/PresignedOperations.hs index e3568b6..5ea6da7 100644 --- a/src/Network/Minio/PresignedOperations.hs +++ b/src/Network/Minio/PresignedOperations.hs @@ -71,8 +71,7 @@ makePresignedUrl expiry method bucket object region extraQuery extraHeaders = do ci <- asks mcConnInfo let - host = formatBS "{}:{}" (connectHost ci, connectPort ci) - hostHeader = (hHost, host) + hostHeader = (hHost, getHostAddr ci) ri = def { riMethod = method , riBucket = bucket , riObject = object @@ -89,7 +88,8 @@ makePresignedUrl expiry method bucket object region extraQuery extraHeaders = do scheme = byteString $ bool "http://" "https://" $ connectIsSecure ci return $ toS $ toLazyByteString $ - scheme <> byteString host <> byteString (getPathFromRI ri) <> queryStr + scheme <> byteString (getHostAddr ci) <> byteString (getPathFromRI ri) <> + queryStr -- | Generate a URL with authentication signature to PUT (upload) an -- object. Any extra headers if passed, are signed, and so they are @@ -272,10 +272,9 @@ presignedPostPolicy p = do -- compute POST upload URL bucket = Map.findWithDefault "" "bucket" formData scheme = byteString $ bool "http://" "https://" $ connectIsSecure ci - host = formatBS "{}:{}" (connectHost ci, connectPort ci) region = connectRegion ci - url = toS $ toLazyByteString $ scheme <> byteString host <> + url = toS $ toLazyByteString $ scheme <> byteString (getHostAddr ci) <> byteString "/" <> byteString (toS bucket) <> byteString "/" return (url, formData) diff --git a/src/Network/Minio/S3API.hs b/src/Network/Minio/S3API.hs index 9065ce3..fef6858 100644 --- a/src/Network/Minio/S3API.hs +++ b/src/Network/Minio/S3API.hs @@ -280,8 +280,10 @@ putObjectPart bucket object uploadId partNumber headers payload = do ] srcInfoToHeaders :: SourceInfo -> [HT.Header] -srcInfoToHeaders srcInfo = ("x-amz-copy-source", encodeUtf8 $ format "/{}/{}" [srcBucket srcInfo, srcObject srcInfo]) : - rangeHdr ++ zip names values +srcInfoToHeaders srcInfo = ("x-amz-copy-source", + toS $ T.concat ["/", srcBucket srcInfo, + "/", srcObject srcInfo] + ) : rangeHdr ++ zip names values where names = ["x-amz-copy-source-if-match", "x-amz-copy-source-if-none-match", "x-amz-copy-source-if-unmodified-since", diff --git a/test/LiveServer.hs b/test/LiveServer.hs index 59b6a58..f868025 100644 --- a/test/LiveServer.hs +++ b/test/LiveServer.hs @@ -19,6 +19,7 @@ import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.QuickCheck as QC +import Conduit (replicateC) import qualified Control.Monad.Catch as MC import qualified Control.Monad.Trans.Resource as R import qualified Data.ByteString as BS @@ -798,7 +799,7 @@ bucketPolicyFunTest = funTestWithBucket "Bucket Policy tests" $ 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\":\"\"}]}" + let expectedPolicyJSON = "{\"Version\":\"2012-10-17\",\"Statement\":[{\"Action\":[\"s3:GetBucketLocation\",\"s3:ListBucket\"],\"Effect\":\"Allow\",\"Principal\":{\"AWS\":[\"*\"]},\"Resource\":[\"arn:aws:s3:::testbucket\"]},{\"Action\":[\"s3:GetObject\"],\"Effect\":\"Allow\",\"Principal\":{\"AWS\":[\"*\"]},\"Resource\":[\"arn:aws:s3:::testbucket/*\"]}]}" step "try a malformed policy, expect error" resE'' <- MC.try $ setBucketPolicy bucket expectedPolicyJSON @@ -806,14 +807,28 @@ bucketPolicyFunTest = funTestWithBucket "Bucket Policy tests" $ 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\":\"\"}]}" + let expectedPolicyJSON' = "{\"Version\":\"2012-10-17\",\"Statement\":[{\"Action\":[\"s3:GetBucketLocation\",\"s3:ListBucket\"],\"Effect\":\"Allow\",\"Principal\":{\"AWS\":[\"*\"]},\"Resource\":[\"arn:aws:s3:::" <> bucket <> "\"]},{\"Action\":[\"s3:GetObject\"],\"Effect\":\"Allow\",\"Principal\":{\"AWS\":[\"*\"]},\"Resource\":[\"arn:aws:s3:::" <> bucket <> "/*\"]}]}" step "set bucket policy" setBucketPolicy bucket expectedPolicyJSON' - step "verify if bucket policy was properly set" - policyJSON <- getBucketPolicy bucket - liftIO $ policyJSON @?= expectedPolicyJSON' + let obj = "myobject" + + step "verify bucket policy: (1) create `myobject`" + putObject bucket obj (replicateC 100 "c") Nothing def + + step "verify bucket policy: (2) get `myobject` anonymously" + connInfo <- asks mcConnInfo + let proto = bool "http://" "https://" $ connectIsSecure connInfo + url = BS.concat [proto, getHostAddr connInfo, "/", toS bucket, + "/", toS obj] + respE <- liftIO $ (fmap (Right . toS) $ NC.simpleHttp $ toS url) `catch` + (\(e :: NC.HttpException) -> return $ Left (show e :: Text)) + case respE of + Left err -> liftIO $ assertFailure $ show err + Right s -> liftIO $ s @?= (BS.concat $ replicate 100 "c") + + deleteObject bucket obj step "delete bucket policy" setBucketPolicy bucket T.empty diff --git a/test/Network/Minio/API/Test.hs b/test/Network/Minio/API/Test.hs index e6a8a74..b1db72b 100644 --- a/test/Network/Minio/API/Test.hs +++ b/test/Network/Minio/API/Test.hs @@ -19,13 +19,14 @@ module Network.Minio.API.Test , objectNameValidityTests ) where -import Test.Tasty -import Test.Tasty.HUnit +import Test.Tasty +import Test.Tasty.HUnit -import Lib.Prelude +import Lib.Prelude -import Network.Minio.API +import Network.Minio.API +assertBool' :: Bool -> Assertion assertBool' = assertBool "Test failed!" bucketNameValidityTests :: TestTree