diff --git a/examples/GetObject.hs b/examples/GetObject.hs index bd240ea..4d4065d 100755 --- a/examples/GetObject.hs +++ b/examples/GetObject.hs @@ -17,13 +17,12 @@ -- limitations under the License. -- - {-# Language OverloadedStrings #-} -import Network.Minio +import Network.Minio -import qualified Data.Conduit as C -import qualified Data.Conduit.Binary as CB -import Prelude +import Data.Conduit (($$+-)) +import Data.Conduit.Binary (sinkLbs) +import Prelude -- | The following example uses minio's play server at -- https://play.minio.io:9000. The endpoint and associated @@ -35,10 +34,12 @@ import Prelude main :: IO () main = do let - bucket = "krisis" - object = "fail.out" + bucket = "my-bucket" + object = "my-object" res <- runResourceT $ runMinio minioPlayCI $ do - (_, src) <- getObject bucket object [] [] - (src C.$$+- CB.sinkLbs) + src <- getObject bucket object + (src $$+- sinkLbs) - print res + case res of + Left e -> putStrLn $ "getObject failed." ++ (show e) + Right _ -> putStrLn "getObject succeeded." diff --git a/src/Network/Minio/API.hs b/src/Network/Minio/API.hs index 0540951..a786cd9 100644 --- a/src/Network/Minio/API.hs +++ b/src/Network/Minio/API.hs @@ -28,6 +28,7 @@ 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 @@ -36,6 +37,7 @@ import Lib.Prelude import Network.Minio.Data import Network.Minio.Data.Crypto +import Network.Minio.Errors import Network.Minio.Sign.V4 import Network.Minio.Utils import Network.Minio.XmlParser @@ -104,20 +106,33 @@ buildRequest ri = do return $ Just $ connectRegion ci | otherwise -> discoverRegion ri + regionHost <- case region of + Nothing -> return $ connectHost ci + Just r -> if "amazonaws.com" `T.isSuffixOf` (connectHost ci) + then maybe + (throwM $ ME $ ValidationError $ MErrVRegionNotSupported r) + return + (Map.lookup r awsRegionMap) + else return $ connectHost ci + + sha256Hash <- getPayloadSHA256Hash (riPayload ri) let newRi = ri { riPayloadHash = sha256Hash , riHeaders = sha256Header sha256Hash : (riHeaders ri) , riRegion = region } + newCi = ci { + connectHost = regionHost + } - reqHeaders <- liftIO $ signV4 ci newRi + reqHeaders <- liftIO $ signV4 newCi newRi return NC.defaultRequest { NC.method = riMethod newRi - , NC.secure = connectIsSecure ci - , NC.host = encodeUtf8 $ connectHost ci - , NC.port = connectPort ci + , NC.secure = connectIsSecure newCi + , NC.host = encodeUtf8 $ connectHost newCi + , NC.port = connectPort newCi , NC.path = getPathFromRI newRi , NC.queryString = HT.renderQuery False $ riQueryParams newRi , NC.requestHeaders = reqHeaders diff --git a/src/Network/Minio/Errors.hs b/src/Network/Minio/Errors.hs index bbb139e..f0ba615 100644 --- a/src/Network/Minio/Errors.hs +++ b/src/Network/Minio/Errors.hs @@ -33,6 +33,7 @@ data MErrV = MErrVSinglePUTSizeExceeded Int64 | MErrVInvalidSrcObjSpec Text | MErrVInvalidSrcObjByteRange (Int64, Int64) | MErrVCopyObjSingleNoRangeAccepted + | MErrVRegionNotSupported Text deriving (Show, Eq) -- | Errors thrown by the library diff --git a/src/Network/Minio/Sign/V4.hs b/src/Network/Minio/Sign/V4.hs index 8c192b1..89ae8b8 100644 --- a/src/Network/Minio/Sign/V4.hs +++ b/src/Network/Minio/Sign/V4.hs @@ -98,7 +98,8 @@ signV4AtTime ts ci ri = outHeaders = authHeader : headersWithDate timeBS = awsTimeFormatBS ts dateHeader = (mk "X-Amz-Date", timeBS) - hostHeader = (mk "host", encodeUtf8 $ connectHost ci) + hostHeader = (mk "host", encodeUtf8 $ format "{}:{}" $ + [connectHost ci, show $ connectPort ci]) headersWithDate = dateHeader : hostHeader : (riHeaders ri)