Basic putObject is working:

- This is single PUT action - so only files up to 5GB.
- Buffers in memory because chunked singature is not yet implemented.
- fPutObject is simply wired to putObject (so does not yet work for
  multipart uploads

minio-hs.cabal

@@ -36,6 +36,7 @@ library
                      , conduit-extra
                      , containers
                      , cryptonite
+                     , cryptonite-conduit
                      , errors
                      , filepath
                      , http-client
@@ -55,6 +56,7 @@ library
                      , NoImplicitPrelude
                      , MultiParamTypeClasses
                      , MultiWayIf
+                     , RankNTypes
 
 executable minio-hs-exe
   hs-source-dirs:      app
@@ -84,6 +86,7 @@ test-suite minio-hs-test
                      , conduit-extra
                      , containers
                      , cryptonite
+                     , cryptonite-conduit
                      , errors
                      , filepath
                      , http-client
@@ -108,6 +111,7 @@ test-suite minio-hs-test
                      , NoImplicitPrelude
                      , MultiParamTypeClasses
                      , MultiWayIf
+                     , RankNTypes
   other-modules:       Lib.Prelude
                      , Network.Minio
                      , Network.Minio.API

src/Network/Minio.hs

@@ -1,6 +1,7 @@
 module Network.Minio
   ( module Exports
   , fGetObject
+  , fPutObject
   ) where
 
 {-
@@ -21,11 +22,13 @@ import Network.Minio.Data as
   , ConnectInfo(..)
   )
 
-import System.FilePath
+import System.FilePath (FilePath)
+import qualified System.IO as IO
 import qualified Data.Conduit as C
+import qualified Control.Monad.Trans.Resource as R
 import qualified Data.Conduit.Binary as CB
 
--- import Lib.Prelude
+import Lib.Prelude
 
 import Network.Minio.Data
 import Network.Minio.S3API
@@ -34,3 +37,16 @@ fGetObject :: Bucket -> Object -> FilePath -> Minio ()
 fGetObject bucket object fp = do
   (_, src) <- getObject bucket object [] []
   src C.$$+- CB.sinkFileCautious fp
+
+fPutObject :: Bucket -> Object -> FilePath -> Minio ()
+fPutObject bucket object fp = do
+  -- allocate file handle and register cleanup action
+  (releaseKey, h) <- R.allocate
+    (IO.openBinaryFile fp IO.ReadMode)
+    IO.hClose
+
+  size <- liftIO $ IO.hFileSize h
+  putObject bucket object [] 0 (fromIntegral size) h
+
+  -- release file handle
+  R.release releaseKey

src/Network/Minio/API.hs

@@ -14,10 +14,11 @@ import           Network.HTTP.Conduit (Response)
 import qualified Network.HTTP.Conduit as NC
 import           Network.HTTP.Types (Method, Header, Query)
 import qualified Data.ByteString.Lazy as LBS
+import qualified Data.Conduit as C
+import Data.Conduit.Binary (sourceHandleRange)
 
 import           Lib.Prelude
 
-import qualified Data.Conduit as C
 
 import           Network.Minio.Data
 import           Network.Minio.Data.Crypto
@@ -35,12 +36,23 @@ import           Network.Minio.Sign.V4
 --   -- 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)
+
 buildRequest :: (MonadIO m, MonadReader MinioConn m)
              => RequestInfo -> m NC.Request
 buildRequest ri = do
-  let pload = maybe "" identity $ riPayload ri
-      phash = hashSHA256 pload
-      newRi = ri {
+  (phash, rbody) <- payloadBodyWithHash ri
+  let newRi = ri {
           riPayloadHash = phash
         , riHeaders = ("x-amz-content-sha256", phash) : (riHeaders ri)
         }
@@ -57,7 +69,7 @@ buildRequest ri = do
     , NC.path = getPathFromRI ri
     , NC.queryString = HT.renderQuery False $ riQueryParams ri
     , NC.requestHeaders = reqHeaders
-    , NC.requestBody = NC.RequestBodyBS pload
+    , NC.requestBody = rbody
     }
 
 isFailureStatus :: Response body -> Bool

src/Network/Minio/Data.hs

@@ -11,10 +11,11 @@ module Network.Minio.Data
   , getRegionFromRI
   , Minio
   , MinioErr(..)
+  , MErrV(..)
   , runMinio
   , defaultConnectInfo
   , connect
-  , Payload
+  , Payload(..)
   , s3Name
   ) where
 
@@ -53,7 +54,12 @@ data BucketInfo = BucketInfo {
   , biCreationDate :: UTCTime
   } deriving (Show, Eq)
 
-type Payload = Maybe ByteString
+
+data Payload = EPayload
+             | PayloadBS ByteString
+             | PayloadH Handle
+                        Int64 -- offset
+                        Int64 -- size
 
 data RequestInfo = RequestInfo {
     riMethod :: Method
@@ -76,10 +82,14 @@ getPathFromRI ri = B.concat $ parts
 getRegionFromRI :: RequestInfo -> Text
 getRegionFromRI ri = maybe "us-east-1" identity (riRegion ri)
 
+data MErrV = MErrVSinglePUTSizeExceeded Int64
+  deriving (Show)
+
 data MinioErr = MErrMsg ByteString -- generic
               | MErrHttp HttpException -- http exceptions
               | MErrXml ByteString -- XML parsing/generation errors
               | MErrService ByteString -- error response from service
+              | MErrValidation MErrV -- client-side validation errors
   deriving (Show)
 
 newtype Minio a = Minio {

src/Network/Minio/Data/Crypto.hs

@@ -1,21 +1,33 @@
 module Network.Minio.Data.Crypto
   (
     hashSHA256
+  , hashSHA256FromSource
   , hmacSHA256
   , hmacSHA256RawBS
   , digestToBS
   , digestToBase16
   ) where
 
-import Crypto.Hash (SHA256(..), hashWith)
+import Crypto.Hash (SHA256(..), hashWith, Digest)
 import Crypto.MAC.HMAC (hmac, HMAC)
 import Data.ByteArray (ByteArrayAccess, convert)
 import Data.ByteArray.Encoding (convertToBase, Base(Base16))
+import qualified Data.Conduit as C
+import Crypto.Hash.Conduit (sinkHash)
 
 import Lib.Prelude
 
 hashSHA256 :: ByteString -> ByteString
-hashSHA256 = convertToBase Base16 . hashWith SHA256
+hashSHA256 = digestToBase16 . hashWith SHA256
+
+hashSHA256FromSource :: Monad m => C.Producer m ByteString -> m ByteString
+hashSHA256FromSource src = do
+  digest <- src C.$$ sinkSHA256Hash
+  return $ digestToBase16 digest
+  where
+    -- To help with type inference
+    sinkSHA256Hash :: Monad m => C.Consumer ByteString m (Digest SHA256)
+    sinkSHA256Hash = sinkHash
 
 hmacSHA256 :: ByteString -> ByteString -> HMAC SHA256
 hmacSHA256 message key = hmac key message

src/Network/Minio/S3API.hs

@@ -3,6 +3,7 @@ module Network.Minio.S3API
   , getLocation
   , getObject
   , putBucket
+  , putObject
   , deleteBucket
   , deleteObject
   ) where
@@ -10,26 +11,29 @@ 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           Lib.Prelude
 
-
 import           Network.Minio.Data
 import Network.Minio.API
 import Network.Minio.XmlParser
 import Network.Minio.XmlGenerator
 
+
 getService :: Minio [BucketInfo]
 getService = do
   resp <- executeRequest $
-    requestInfo HT.methodGet Nothing Nothing [] [] Nothing
+    requestInfo HT.methodGet Nothing Nothing [] [] EPayload
   parseListBuckets $ NC.responseBody resp
 
 getLocation :: Bucket -> Minio Text
 getLocation bucket = do
   resp <- executeRequest $
     requestInfo HT.methodGet (Just bucket) Nothing [("location", Nothing)] []
-    Nothing
+    EPayload
   parseLocation $ NC.responseBody resp
 
 getObject :: Bucket -> Object -> HT.Query -> [HT.Header]
@@ -39,20 +43,36 @@ getObject bucket object queryParams headers = do
   return $ (NC.responseHeaders resp, NC.responseBody resp)
   where
     reqInfo = requestInfo HT.methodGet (Just bucket) (Just object)
-              queryParams headers Nothing
+              queryParams headers EPayload
 
 putBucket :: Bucket -> Location -> Minio ()
 putBucket bucket location = do
   void $ executeRequest $
     requestInfo HT.methodPut (Just bucket) Nothing [] [] $
-    Just $ mkCreateBucketConfig location
+    PayloadBS $ mkCreateBucketConfig location
+
+maxSinglePutObjectSizeBytes :: Int64
+maxSinglePutObjectSizeBytes = 5 * 1024 * 1024 * 1024
+
+putObject :: Bucket -> Object -> [HT.Header] -> Int64
+          -> Int64 -> Handle -> Minio ()
+putObject bucket object headers offset size h = do
+  -- check length is within single PUT object size.
+  when (size > maxSinglePutObjectSizeBytes) $
+    throwError $ MErrValidation $ MErrVSinglePUTSizeExceeded size
+
+  -- content-length header is automatically set by library.
+  void $ executeRequest $
+    requestInfo HT.methodPut (Just bucket) (Just object) [] headers $
+    PayloadH h offset size
+
 
 deleteBucket :: Bucket -> Minio ()
 deleteBucket bucket = do
   void $ executeRequest $
-    requestInfo HT.methodDelete (Just bucket) Nothing [] [] Nothing
+    requestInfo HT.methodDelete (Just bucket) Nothing [] [] EPayload
 
 deleteObject :: Bucket -> Object -> Minio ()
 deleteObject bucket object = do
   void $ executeRequest $
-    requestInfo HT.methodDelete (Just bucket) (Just object) [] [] Nothing
+    requestInfo HT.methodDelete (Just bucket) (Just object) [] [] EPayload

test/Spec.hs

@@ -3,9 +3,15 @@ import Protolude
 import Test.Tasty
 import Test.Tasty.HUnit
 
+-- import qualified System.IO as SIO
+
 import Control.Monad.Trans.Resource (runResourceT)
 
+-- import qualified Conduit as C
+-- import Data.Conduit.Binary
+
 import Network.Minio
+-- import Network.Minio.S3API
 import XmlTests
 
 main :: IO ()
@@ -50,6 +56,18 @@ unitTests = testGroup "Unit tests"
       step "Running test.."
       ret <- runResourceT $ runMinio mc $ getService
       isRight ret @? ("getService failure => " ++ show ret)
+  , testCaseSteps "Simple putObject works" $ \step -> do
+      step "Preparing..."
+
+      mc <- connect defaultConnectInfo
+
+      step "Running test.."
+      ret <- runResourceT $ runMinio mc $
+             fPutObject "testbucket" "lsb-release" "/etc/lsb-release"
+      -- h <- SIO.openBinaryFile "/etc/lsb-release" SIO.ReadMode
+      -- ret <- runResourceT $ runMinio mc $
+      --        putObject "testbucket" "lsb-release" [] 0 105 h
+      isRight ret @? ("putObject failure => " ++ show ret)
 
   , testCase "Test mkCreateBucketConfig." testMkCreateBucketConfig
   ]