Refactor request builder and Payload type

src/Network/Minio/API.hs

@@ -34,61 +34,43 @@ import           Network.Minio.Sign.V4
 --   -- print $ NC.requestBody r
 --   NC.httpLbs r mgr
 
-executeRequest :: RequestInfo -> Minio (Response LByteString)
-executeRequest ri = do
-  let PayloadSingle pload = riPayload ri
+buildRequest :: (MonadIO m, MonadReader MinioConn m)
+             => RequestInfo -> m NC.Request
+buildRequest ri = do
+  let pload = maybe "" identity $ riPayload ri
       phash = hashSHA256 pload
-      newRI = ri {
+      newRi = ri {
           riPayloadHash = phash
         , riHeaders = ("x-amz-content-sha256", phash) : (riHeaders ri)
         }
 
   ci <- asks mcConnInfo
 
-  reqHeaders <- liftIO $ signV4 ci newRI
+  reqHeaders <- liftIO $ signV4 ci newRi
 
+  return NC.defaultRequest {
+      NC.method = riMethod newRi
+    , NC.secure = connectIsSecure ci
+    , NC.host = encodeUtf8 $ connectHost ci
+    , NC.port = connectPort ci
+    , NC.path = getPathFromRI ri
+    , NC.queryString = HT.renderQuery False $ riQueryParams ri
+    , NC.requestHeaders = reqHeaders
+    , NC.requestBody = NC.RequestBodyBS pload
+    }
+
+executeRequest :: RequestInfo -> Minio (Response LByteString)
+executeRequest ri = do
+  req <- buildRequest ri
   mgr <- asks mcConnManager
-
-  let req = NC.defaultRequest {
-          NC.method = riMethod newRI
-        , NC.secure = connectIsSecure ci
-        , NC.host = encodeUtf8 $ connectHost ci
-        , NC.port = connectPort ci
-        , NC.path = getPathFromRI ri
-        , NC.queryString = HT.renderQuery False $ riQueryParams ri
-        , NC.requestHeaders = reqHeaders
-        , NC.requestBody = NC.RequestBodyBS pload
-        }
-
   NC.httpLbs req mgr
 
 mkStreamRequest :: RequestInfo
                 -> Minio (Response (C.ResumableSource Minio ByteString))
 mkStreamRequest ri = do
-  let PayloadSingle pload = riPayload ri
-      phash = hashSHA256 pload
-      newRI = ri {
-          riPayloadHash = phash
-        , riHeaders = ("x-amz-content-sha256", phash) : (riHeaders ri)
-        }
-
-  ci <- asks mcConnInfo
-
-  reqHeaders <- liftIO $ signV4 ci newRI
-
+  req <- buildRequest ri
   mgr <- asks mcConnManager
 
-  let req = NC.defaultRequest {
-          NC.method = riMethod newRI
-        , NC.secure = connectIsSecure ci
-        , NC.host = encodeUtf8 $ connectHost ci
-        , NC.port = connectPort ci
-        , NC.path = getPathFromRI ri
-        , NC.queryString = HT.renderQuery False $ riQueryParams ri
-        , NC.requestHeaders = reqHeaders
-        , NC.requestBody = NC.RequestBodyBS pload
-        }
-
   NC.http req mgr
 
 requestInfo :: Method -> Maybe Bucket -> Maybe Object

src/Network/Minio/Data.hs

@@ -56,9 +56,7 @@ data BucketInfo = BucketInfo {
   , biCreationDate :: UTCTime
   } deriving (Show, Eq)
 
-
-data Payload = PayloadSingle ByteString
-  deriving (Show, Eq)
+type Payload = Maybe ByteString
 
 data RequestInfo = RequestInfo {
     riMethod :: Method

src/Network/Minio/S3API.hs

@@ -26,15 +26,14 @@ status204 = HT.Status{ HT.statusCode = 204, HT.statusMessage = "No Content" }
 getService :: Minio [BucketInfo]
 getService = do
   resp <- executeRequest $
-    requestInfo HT.methodGet Nothing Nothing [] [] $
-    PayloadSingle ""
+    requestInfo HT.methodGet Nothing Nothing [] [] Nothing
   parseListBuckets $ NC.responseBody resp
 
 getLocation :: Bucket -> Minio Text
 getLocation bucket = do
   resp <- executeRequest $
     requestInfo HT.methodGet (Just bucket) Nothing [("location", Nothing)] []
-    (PayloadSingle "")
+    Nothing
   parseLocation $ NC.responseBody resp
 
 getObject :: Bucket -> Object -> HT.Query -> [HT.Header]
@@ -48,13 +47,13 @@ getObject bucket object queryParams headers = do
             throwError $ MErrXml $ LBS.toStrict $ NC.responseBody errMsg
   where
     reqInfo = requestInfo HT.methodGet (Just bucket) (Just object)
-              queryParams headers (PayloadSingle "")
+              queryParams headers Nothing
 
 putBucket :: Bucket -> Location -> Minio ()
 putBucket bucket location = do
   resp <- executeRequest $
     requestInfo HT.methodPut (Just bucket) Nothing [] [] $
-    PayloadSingle $ mkCreateBucketConfig bucket location
+    Just $ mkCreateBucketConfig bucket location
 
   let httpStatus = NC.responseStatus resp
   when (httpStatus /= HT.ok200) $
@@ -63,8 +62,7 @@ putBucket bucket location = do
 deleteBucket :: Bucket -> Minio ()
 deleteBucket bucket = do
   resp <- executeRequest $
-    requestInfo HT.methodDelete (Just bucket) Nothing [] [] $
-    (PayloadSingle "")
+    requestInfo HT.methodDelete (Just bucket) Nothing [] [] Nothing
   let httpStatus = NC.responseStatus resp
   when (httpStatus /= status204) $
     throwError $ MErrXml $ LBS.toStrict $ NC.responseBody resp
@@ -72,8 +70,7 @@ deleteBucket bucket = do
 deleteObject :: Bucket -> Object -> Minio ()
 deleteObject bucket object = do
   resp <- executeRequest $
-    requestInfo HT.methodDelete (Just bucket) (Just object) [] [] $
-    (PayloadSingle "")
+    requestInfo HT.methodDelete (Just bucket) (Just object) [] [] Nothing
   let httpStatus = NC.responseStatus resp
   when (httpStatus /= status204) $
     throwError $ MErrXml $ LBS.toStrict $ NC.responseBody resp