Add statObject high-level API (#11)

src/Network/Minio.hs

@@ -43,6 +43,7 @@ module Network.Minio
   , putObjectFromSource
 
   , getObject
+  , statObject
 
   ) where
 
@@ -96,3 +97,7 @@ makeBucket :: Bucket -> Maybe Region -> Minio ()
 makeBucket bucket regionMay= do
   region <- maybe (asks $ connectRegion . mcConnInfo) return regionMay
   putBucket bucket region
+
+-- | Get an object's metadata from the object store.
+statObject :: Bucket -> Object -> Minio ObjectInfo
+statObject bucket object = headObject bucket object

src/Network/Minio/Data.hs

@@ -230,6 +230,7 @@ s3Name s = Name s (Just "http://s3.amazonaws.com/doc/2006-03-01/") Nothing
 data MErrV = MErrVSinglePUTSizeExceeded Int64
            | MErrVPutSizeExceeded Int64
            | MErrVETagHeaderNotFound
+           | MErrVInvalidObjectInfoResponse
   deriving (Show, Eq)
 
 -- | Errors thrown by the library

src/Network/Minio/S3API.hs

@@ -13,6 +13,7 @@ module Network.Minio.S3API
   -- * Retrieving objects
   -----------------------
   , getObject'
+  , headObject
 
   -- * Creating buckets and objects
   ---------------------------------
@@ -246,3 +247,20 @@ listIncompleteParts' bucket object uploadId maxParts partNumMarker = do
       , ("part-number-marker", partNumMarker)
       , ("max-parts", maxParts)
       ]
+
+-- | Get metadata of an object.
+headObject :: Bucket -> Object -> Minio ObjectInfo
+headObject bucket object = do
+  resp <- executeRequest $ def { riMethod = HT.methodHead
+                               , riBucket = Just bucket
+                               , riObject = Just object
+                               }
+
+  let
+    headers = NC.responseHeaders resp
+    modTime = getLastModifiedHeader headers
+    etag = getETagHeader headers
+    size = getContentLength headers
+
+  maybe (throwM $ ValidationError MErrVInvalidObjectInfoResponse) return $
+    ObjectInfo <$> Just object <*> modTime <*> etag <*> size

src/Network/Minio/Utils.hs

@@ -9,17 +9,25 @@ import qualified Control.Monad.Trans.Resource as R
 
 import qualified Data.ByteString as B
 import qualified Data.Conduit as C
+import qualified Data.Text as T
 import           Data.Text.Encoding.Error (lenientDecode)
+import           Data.Text.Read (decimal)
+import           Data.Time
 import qualified Network.HTTP.Client as NClient
 import           Network.HTTP.Conduit (Response)
 import qualified Network.HTTP.Conduit as NC
 import qualified Network.HTTP.Types as HT
+import qualified Network.HTTP.Types.Header as Hdr
 import qualified System.IO as IO
 
 import           Lib.Prelude
 
 import           Network.Minio.Data
 
+-- | Represent the time format string returned by S3 API calls.
+s3TimeFormat :: [Char]
+s3TimeFormat = iso8601DateFormat $ Just "%T%QZ"
+
 allocateReadFile :: (R.MonadResource m, R.MonadResourceBase m)
                  => FilePath -> m (R.ReleaseKey, Handle)
 allocateReadFile fp = do
@@ -72,7 +80,18 @@ lookupHeader :: HT.HeaderName -> [HT.Header] -> Maybe ByteString
 lookupHeader hdr = headMay . map snd . filter (\(h, _) -> h == hdr)
 
 getETagHeader :: [HT.Header] -> Maybe Text
-getETagHeader hs = decodeUtf8Lenient <$> lookupHeader "ETag" hs
+getETagHeader hs = decodeUtf8Lenient <$> lookupHeader Hdr.hETag hs
+
+getLastModifiedHeader :: [HT.Header] -> Maybe UTCTime
+getLastModifiedHeader hs = do
+  modTimebs <- decodeUtf8Lenient <$> lookupHeader Hdr.hLastModified hs
+  parseTimeM True defaultTimeLocale rfc822DateFormat (T.unpack modTimebs)
+
+getContentLength :: [HT.Header] -> Maybe Int64
+getContentLength hs = do
+  nbs <- decodeUtf8Lenient <$> lookupHeader Hdr.hContentLength hs
+  fst <$> hush (decimal nbs)
+
 
 decodeUtf8Lenient :: ByteString -> Text
 decodeUtf8Lenient = decodeUtf8With lenientDecode

src/Network/Minio/XmlParser.hs

@@ -19,6 +19,7 @@ import           Text.XML.Cursor
 import           Lib.Prelude
 
 import           Network.Minio.Data
+import           Network.Minio.Utils (s3TimeFormat)
 
 
 -- | Helper functions.
@@ -28,19 +29,17 @@ uncurry3 f (a, b, c) = f a b c
 uncurry4 :: (a -> b -> c -> d -> e) -> (a, b, c, d) -> e
 uncurry4 f (a, b, c, d) = f a b c d
 
--- | Represent the time format string returned by S3 API calls.
-s3TimeFormat :: [Char]
-s3TimeFormat = iso8601DateFormat $ Just "%T%QZ"
-
 -- | Parse time strings from XML
 parseS3XMLTime :: (MonadThrow m) => Text -> m UTCTime
 parseS3XMLTime = either (throwM . XMLParseError) return
                . parseTimeM True defaultTimeLocale s3TimeFormat
                . T.unpack
 
+parseDecimal :: (MonadThrow m, Integral a) => Text -> m a
+parseDecimal numStr = either (throwM . XMLParseError . show) return $ fst <$> decimal numStr
+
 parseDecimals :: (MonadThrow m, Integral a) => [Text] -> m [a]
-parseDecimals numStr = forM numStr $ \str ->
+parseDecimals numStr = forM numStr parseDecimal
-  either (throwM . XMLParseError . show) return $ fst <$> decimal str
 
 s3Elem :: Text -> Axis
 s3Elem = element . s3Name

test/Spec.hs

@@ -300,6 +300,21 @@ liveServerUnitTests = testGroup "Unit tests against a live server"
       incompleteParts <- (listIncompleteParts bucket object uid) $$ sinkList
       liftIO $ (length incompleteParts) @?= 10
 
+  , funTestWithBucket "High-level statObject Test" $ \step bucket -> do
+      let
+        object = "sample"
+        zeroByte = 0
+
+      step "create an object"
+      inputFile <- mkRandFile zeroByte
+      fPutObject bucket object inputFile
+
+      step "get metadata of the object"
+      res <- statObject bucket object
+      liftIO $ (oiSize res) @?= 0
+
+      step "delete object"
+      deleteObject bucket object
   ]
 
 unitTests :: TestTree