Eliminate requestInfo function and use default instances

minio-hs.cabal

@@ -38,6 +38,7 @@ library
                      , containers
                      , cryptonite
                      , cryptonite-conduit
+                     , data-default
                      , filepath
                      , http-client
                      , http-conduit
@@ -90,6 +91,7 @@ test-suite minio-hs-test
                      , containers
                      , cryptonite
                      , cryptonite-conduit
+                     , data-default
                      , filepath
                      , http-client
                      , http-conduit

src/Network/Minio/API.hs

@@ -6,13 +6,11 @@ module Network.Minio.API
   , runMinio
   , executeRequest
   , mkStreamRequest
-  , requestInfo
   ) where
 
 import qualified Network.HTTP.Types as HT
 import           Network.HTTP.Conduit (Response)
 import qualified Network.HTTP.Conduit as NC
-import           Network.HTTP.Types (Method, Header, Query)
 import qualified Data.Conduit as C
 import Data.Conduit.Binary (sourceHandleRange)
 
@@ -36,25 +34,32 @@ import Network.Minio.Utils
 --   -- print $ NC.requestBody r
 --   NC.httpLbs r mgr
 
-payloadBodyWithHash :: (MonadIO m) => RequestInfo
-                    -> m (ByteString, NC.RequestBody)
-payloadBodyWithHash ri = case riPayload ri of
-  EPayload -> return (hashSHA256 "", NC.RequestBodyBS "")
-  PayloadBS bs -> return (hashSHA256 bs, NC.RequestBodyBS bs)
-  PayloadH h off size -> do
-    let offM = return . fromIntegral $ off
-        sizeM = return . fromIntegral $ size
-    hash <- hashSHA256FromSource $ sourceHandleRange h offM sizeM
-    return (hash, NC.requestBodySource (fromIntegral size) $
-                  sourceHandleRange h offM sizeM)
+-- sha256Header ::  :: HT.HeaderName
+sha256Header :: ByteString -> HT.Header
+sha256Header = ("x-amz-content-sha256", )
+
+getPayloadSHA256Hash :: (MonadIO m) => Payload -> m ByteString
+getPayloadSHA256Hash (PayloadBS bs) = return $ hashSHA256 bs
+getPayloadSHA256Hash (PayloadH h off size) = hashSHA256FromSource $
+  sourceHandleRange h
+    (return . fromIntegral $ off)
+    (return . fromIntegral $ size)
+
+getRequestBody :: Payload -> NC.RequestBody
+getRequestBody (PayloadBS bs) = NC.RequestBodyBS bs
+getRequestBody (PayloadH h off size) =
+  NC.requestBodySource (fromIntegral size) $
+    sourceHandleRange h
+      (return . fromIntegral $ off)
+      (return . fromIntegral $ size)
 
 buildRequest :: (MonadIO m, MonadReader MinioConn m)
              => RequestInfo -> m NC.Request
 buildRequest ri = do
-  (phash, rbody) <- payloadBodyWithHash ri
+  sha256Hash <- getPayloadSHA256Hash (riPayload ri)
   let newRi = ri {
-          riPayloadHash = phash
-        , riHeaders = ("x-amz-content-sha256", phash) : (riHeaders ri)
+          riPayloadHash = sha256Hash
+        , riHeaders = sha256Header sha256Hash : (riHeaders ri)
         }
 
   ci <- asks mcConnInfo
@@ -66,13 +71,12 @@ buildRequest ri = do
     , 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.path = getPathFromRI newRi
+    , NC.queryString = HT.renderQuery False $ riQueryParams newRi
     , NC.requestHeaders = reqHeaders
-    , NC.requestBody = rbody
+    , NC.requestBody = getRequestBody (riPayload newRi)
     }
 
-
 executeRequest :: RequestInfo -> Minio (Response LByteString)
 executeRequest ri = do
   req <- buildRequest ri
@@ -86,9 +90,3 @@ mkStreamRequest ri = do
   req <- buildRequest ri
   mgr <- asks mcConnManager
   http req mgr
-
-
-requestInfo :: Method -> Maybe Bucket -> Maybe Object
-            -> Query -> [Header] -> Payload
-            -> RequestInfo
-requestInfo m b o q h p = RequestInfo m b o q h p "" Nothing

src/Network/Minio/Data.hs

@@ -23,9 +23,9 @@ import qualified Data.ByteString as B
 import           Network.HTTP.Client (defaultManagerSettings, HttpException)
 import           Network.HTTP.Types (Method, Header, Query)
 import qualified Network.HTTP.Conduit as NC
+import Data.Default (Default(..))
+import qualified Network.HTTP.Types as HT
 
--- import Control.Monad.Trans.Resource (MonadThrow, MonadResource, ResourceT,
---                                      MonadBaseControl(..))
 import Control.Monad.Trans.Resource
 import Control.Monad.Trans.Control
 import Control.Monad.Base
@@ -66,13 +66,14 @@ data BucketInfo = BucketInfo {
   , biCreationDate :: UTCTime
   } deriving (Show, Eq)
 
-
-data Payload = EPayload
-             | PayloadBS ByteString
+data Payload = PayloadBS ByteString
              | PayloadH Handle
                         Int64 -- offset
                         Int64 -- size
 
+instance Default Payload where
+  def = PayloadBS ""
+
 data RequestInfo = RequestInfo {
     riMethod :: Method
   , riBucket :: Maybe Bucket
@@ -84,6 +85,8 @@ data RequestInfo = RequestInfo {
   , riRegion :: Maybe Location
   }
 
+instance Default RequestInfo where
+  def = RequestInfo HT.methodGet def def def def def "" def
 
 getPathFromRI :: RequestInfo -> ByteString
 getPathFromRI ri = B.concat $ parts

src/Network/Minio/S3API.hs

@@ -11,9 +11,7 @@ module Network.Minio.S3API
 import qualified Network.HTTP.Types as HT
 import qualified Network.HTTP.Conduit as NC
 import qualified Data.Conduit as C
--- import Control.Monad.Trans.Resource (MonadResource)
--- import Data.Conduit.Binary (sinkLbs, sourceHandleRange)
--- import qualified Data.ByteString.Lazy as LB
+import Data.Default (def)
 
 import           Lib.Prelude
 
@@ -26,16 +24,15 @@ import Network.Minio.XmlGenerator
 -- | Fetch all buckets from the service.
 getService :: Minio [BucketInfo]
 getService = do
-  resp <- executeRequest $
-    requestInfo HT.methodGet Nothing Nothing [] [] EPayload
+  resp <- executeRequest $ def
   parseListBuckets $ NC.responseBody resp
 
 -- | Fetch bucket location (region)
 getLocation :: Bucket -> Minio Text
 getLocation bucket = do
-  resp <- executeRequest $
-    requestInfo HT.methodGet (Just bucket) Nothing [("location", Nothing)] []
-    EPayload
+  resp <- executeRequest $ def { riBucket = Just bucket
+                               , riQueryParams = [("location", Nothing)]
+                               }
   parseLocation $ NC.responseBody resp
 
 -- | GET an object from the service and return the response headers
@@ -46,22 +43,26 @@ getObject bucket object queryParams headers = do
   resp <- mkStreamRequest reqInfo
   return $ (NC.responseHeaders resp, NC.responseBody resp)
   where
-    reqInfo = requestInfo HT.methodGet (Just bucket) (Just object)
-              queryParams headers EPayload
+    reqInfo = def { riBucket = Just bucket
+                  , riObject = Just object
+                  , riQueryParams = queryParams
+                  , riHeaders = headers}
 
 -- | Creates a bucket via a PUT bucket call.
 putBucket :: Bucket -> Location -> Minio ()
 putBucket bucket location = do
   void $ executeRequest $
-    requestInfo HT.methodPut (Just bucket) Nothing [] [] $
-    PayloadBS $ mkCreateBucketConfig location
+    def { riMethod = HT.methodPut
+        , riBucket = Just bucket
+        , riPayload = PayloadBS $ mkCreateBucketConfig location
+        }
 
 -- | Single PUT object size.
 maxSinglePutObjectSizeBytes :: Int64
 maxSinglePutObjectSizeBytes = 5 * 1024 * 1024 * 1024
 
 -- | PUT an object into the service. This function performs a single
--- PUT object calls, and so can only transfer objects upto 5GiB.
+-- PUT object call, and so can only transfer objects upto 5GiB.
 putObject :: Bucket -> Object -> [HT.Header] -> Int64
           -> Int64 -> Handle -> Minio ()
 putObject bucket object headers offset size h = do
@@ -71,17 +72,26 @@ putObject bucket object headers offset size h = do
 
   -- content-length header is automatically set by library.
   void $ executeRequest $
-    requestInfo HT.methodPut (Just bucket) (Just object) [] headers $
-    PayloadH h offset size
+    def { riMethod = HT.methodPut
+        , riBucket = Just bucket
+        , riObject = Just object
+        , riHeaders = headers
+        , riPayload = PayloadH h offset size
+        }
 
 -- | DELETE a bucket from the service.
 deleteBucket :: Bucket -> Minio ()
 deleteBucket bucket = do
   void $ executeRequest $
-    requestInfo HT.methodDelete (Just bucket) Nothing [] [] EPayload
+    def { riMethod = HT.methodDelete
+        , riBucket = Just bucket
+        }
 
 -- | DELETE an object from the service.
 deleteObject :: Bucket -> Object -> Minio ()
 deleteObject bucket object = do
   void $ executeRequest $
-    requestInfo HT.methodDelete (Just bucket) (Just object) [] [] EPayload
+    def { riMethod = HT.methodDelete
+        , riBucket = Just bucket
+        , riObject = Just object
+        }