Infer XML namespace using connectHost

minio-hs.cabal

@@ -119,6 +119,7 @@ test-suite minio-hs-live-server-test
                      , Network.Minio.PutObject
                      , Network.Minio.S3API
                      , Network.Minio.Sign.V4
+                     , Network.Minio.TestHelpers
                      , Network.Minio.Utils
                      , Network.Minio.Utils.Test
                      , Network.Minio.API.Test
@@ -225,6 +226,7 @@ test-suite minio-hs-test
                      , Network.Minio.PutObject
                      , Network.Minio.S3API
                      , Network.Minio.Sign.V4
+                     , Network.Minio.TestHelpers
                      , Network.Minio.Utils
                      , Network.Minio.Utils.Test
                      , Network.Minio.API.Test

src/Network/Minio.hs

@@ -23,6 +23,7 @@ module Network.Minio
   ---------------------------------
     ConnectInfo(..)
   , awsCI
+  , gcsCI
 
   -- ** Connection helpers
   ------------------------

src/Network/Minio/Data.hs

@@ -91,16 +91,41 @@ data ConnectInfo = ConnectInfo {
   , connectAutoDiscoverRegion :: Bool
   } deriving (Eq, Show)
 
+
 -- | Connects to a Minio server located at @localhost:9000@ with access
 -- key /minio/ and secret key /minio123/. It is over __HTTP__ by
 -- default.
 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
-                                ]
+getHostAddr ci = if | port == 80 || port == 443 -> toS host
+                    | otherwise -> toS $
+                                   T.concat [ host, ":" , Lib.Prelude.show port]
+  where
+    port = connectPort ci
+    host = connectHost ci
+
+
+-- | Default GCS ConnectInfo. Works only for "Simple Migration"
+-- use-case with interoperability mode enabled on GCP console. For
+-- more information - https://cloud.google.com/storage/docs/migrating
+-- Credentials should be supplied before use, for e.g.:
+--
+-- > gcsCI {
+-- >   connectAccessKey = "my-access-key"
+-- > , connectSecretKey = "my-secret-key"
+-- > }
+
+gcsCI :: ConnectInfo
+gcsCI = def {
+      connectHost = "storage.googleapis.com"
+    , connectPort = 443
+    , connectAccessKey = ""
+    , connectSecretKey = ""
+    , connectIsSecure = True
+    , connectAutoDiscoverRegion = False
+    }
 
 -- | Default AWS ConnectInfo. Connects to "us-east-1". Credentials
 -- should be supplied before use, for e.g.:
@@ -551,6 +576,16 @@ data MinioConn = MinioConn
   , mcRegionMap   :: MVar RegionMap
   }
 
+class HasSvcNamespace env where
+  getSvcNamespace :: env -> Text
+
+instance HasSvcNamespace MinioConn where
+  getSvcNamespace env = let host = connectHost $ mcConnInfo env
+                            in if | host  == "storage.googleapis.com" ->
+                                    "http://doc.s3.amazonaws.com/2006-03-01"
+                                  | otherwise ->
+                                    "http://s3.amazonaws.com/doc/2006-03-01/"
+
 -- | Takes connection information and returns a connection object to
 -- be passed to 'runMinio'
 connect :: ConnectInfo -> IO MinioConn
@@ -578,8 +613,8 @@ runMinio ci m = do
     handlerFE = return . Left . MErrIO
     handlerValidation = return . Left . MErrValidation
 
-s3Name :: Text -> Name
-s3Name s = Name s (Just "http://s3.amazonaws.com/doc/2006-03-01/") Nothing
+s3Name :: Text -> Text -> Name
+s3Name ns s = Name s (Just ns) Nothing
 
 -- | Format as per RFC 1123.
 formatRFC1123 :: UTCTime -> T.Text

src/Network/Minio/S3API.hs

@@ -133,11 +133,12 @@ getObject' bucket object queryParams headers = do
 
 -- | Creates a bucket via a PUT bucket call.
 putBucket :: Bucket -> Region -> Minio ()
-putBucket bucket location = void $
-  executeRequest $
+putBucket bucket location = do
+  ns <- asks getSvcNamespace
+  void $ executeRequest $
     def { riMethod = HT.methodPut
         , riBucket = Just bucket
-        , riPayload = PayloadBS $ mkCreateBucketConfig location
+        , riPayload = PayloadBS $ mkCreateBucketConfig ns location
         , riNeedsLocation = False
         }
 
@@ -445,12 +446,13 @@ headBucket bucket = headBucketEx `catches`
 
 -- | Set the notification configuration on a bucket.
 putBucketNotification :: Bucket -> Notification -> Minio ()
-putBucketNotification bucket ncfg =
+putBucketNotification bucket ncfg = do
+  ns <- asks getSvcNamespace
   void $ executeRequest $ def { riMethod = HT.methodPut
                               , riBucket = Just bucket
                               , riQueryParams = [("notification", Nothing)]
                               , riPayload = PayloadBS $
-                                            mkPutNotificationRequest ncfg
+                                            mkPutNotificationRequest ns ncfg
                               }
 
 -- | Retrieve the notification configuration on a bucket.

src/Network/Minio/XmlGenerator.hs

@@ -32,10 +32,10 @@ import           Network.Minio.Data
 
 
 -- | Create a bucketConfig request body XML
-mkCreateBucketConfig :: Region -> ByteString
-mkCreateBucketConfig location = LBS.toStrict $ renderLBS def bucketConfig
+mkCreateBucketConfig :: Text -> Region -> ByteString
+mkCreateBucketConfig ns location = LBS.toStrict $ renderLBS def bucketConfig
   where
-      s3Element n = Element (s3Name n) M.empty
+      s3Element n = Element (s3Name ns n) M.empty
       root = s3Element "CreateBucketConfiguration"
         [ NodeElement $ s3Element "LocationConstraint"
           [ NodeContent location]
@@ -62,14 +62,14 @@ data XNode = XNode Text [XNode]
            | XLeaf Text Text
   deriving (Eq, Show)
 
-toXML :: XNode -> ByteString
-toXML node = LBS.toStrict $ renderLBS def $
+toXML :: Text -> XNode -> ByteString
+toXML ns node = LBS.toStrict $ renderLBS def $
   Document (Prologue [] Nothing []) (xmlNode node) []
   where
     xmlNode :: XNode -> Element
-    xmlNode (XNode name nodes)   = Element (s3Name name) M.empty $
+    xmlNode (XNode name nodes)   = Element (s3Name ns name) M.empty $
                                    map (NodeElement . xmlNode) nodes
-    xmlNode (XLeaf name content) = Element (s3Name name) M.empty
+    xmlNode (XLeaf name content) = Element (s3Name ns name) M.empty
                                    [NodeContent content]
 
 class ToXNode a where
@@ -98,5 +98,5 @@ getFRXNode (FilterRule n v) = XNode "FilterRule" [ XLeaf "Name" n
                                                  , XLeaf "Value" v
                                                  ]
 
-mkPutNotificationRequest :: Notification -> ByteString
-mkPutNotificationRequest = toXML . toXNode
+mkPutNotificationRequest :: Text -> Notification -> ByteString
+mkPutNotificationRequest ns = toXML ns . toXNode