diff --git a/src/Network/Minio.hs b/src/Network/Minio.hs index a772bd5..aa7a8e5 100644 --- a/src/Network/Minio.hs +++ b/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 diff --git a/src/Network/Minio/Data.hs b/src/Network/Minio/Data.hs index 566d15f..1180cdb 100644 --- a/src/Network/Minio/Data.hs +++ b/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 diff --git a/src/Network/Minio/S3API.hs b/src/Network/Minio/S3API.hs index 7fcce80..adaaf0c 100644 --- a/src/Network/Minio/S3API.hs +++ b/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 diff --git a/src/Network/Minio/Utils.hs b/src/Network/Minio/Utils.hs index 31bc0e1..0ab0fba 100644 --- a/src/Network/Minio/Utils.hs +++ b/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 diff --git a/src/Network/Minio/XmlParser.hs b/src/Network/Minio/XmlParser.hs index f5d878a..6041279 100644 --- a/src/Network/Minio/XmlParser.hs +++ b/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 -> - either (throwM . XMLParseError . show) return $ fst <$> decimal str +parseDecimals numStr = forM numStr parseDecimal s3Elem :: Text -> Axis s3Elem = element . s3Name diff --git a/test/Spec.hs b/test/Spec.hs index ee5b8fd..a1de8d3 100644 --- a/test/Spec.hs +++ b/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