Add port to host header for signing. (#24)

* Add port to host header for signing.

* Use endpoint corresponding to region for AWS S3

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 Data.Conduit (($$+-))
-import qualified Data.Conduit.Binary as CB
+import Data.Conduit.Binary (sinkLbs)
-import           Prelude
+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"
+      bucket = "my-bucket"
-      object = "fail.out"
+      object = "my-object"
   res <- runResourceT $ runMinio minioPlayCI $ do
-    (_, src) <- getObject bucket object [] []
+    src <- getObject bucket object
-    (src C.$$+- CB.sinkLbs)
+    (src $$+- sinkLbs)
 
-  print res
+  case res of
+    Left e -> putStrLn $ "getObject failed." ++ (show e)
+    Right _ -> putStrLn "getObject succeeded."

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.secure = connectIsSecure newCi
-    , NC.host = encodeUtf8 $ connectHost ci
+    , NC.host = encodeUtf8 $ connectHost newCi
-    , NC.port = connectPort ci
+    , NC.port = connectPort newCi
     , NC.path = getPathFromRI newRi
     , NC.queryString = HT.renderQuery False $ riQueryParams newRi
     , NC.requestHeaders = reqHeaders

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

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)