module Network.Minio.Utils where
import qualified Conduit as C
import Control.Monad.IO.Unlift (MonadUnliftIO)
import qualified Control.Monad.Trans.Resource as R
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as LB
import Data.CaseInsensitive (mk, original)
import qualified Data.Conduit.Binary as CB
import qualified Data.HashMap.Strict as H
import qualified Data.List as List
import qualified Data.Text as T
import Data.Text.Read (decimal)
import Data.Time
( defaultTimeLocale,
parseTimeM,
rfc822DateFormat,
)
import Lib.Prelude
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 Network.Minio.Data
import Network.Minio.Data.ByteString
import Network.Minio.JsonParser (parseErrResponseJSON)
import Network.Minio.XmlParser (parseErrResponse)
import qualified System.IO as IO
import qualified UnliftIO as U
import qualified UnliftIO.Async as A
import qualified UnliftIO.MVar as UM
allocateReadFile ::
(MonadUnliftIO m, R.MonadResource m) =>
FilePath ->
m (R.ReleaseKey, Handle)
allocateReadFile :: FilePath -> m (ReleaseKey, Handle)
allocateReadFile FilePath
fp = do
(ReleaseKey
rk, Either IOException Handle
hdlE) <- IO (Either IOException Handle)
-> (Either IOException Handle -> IO ())
-> m (ReleaseKey, Either IOException Handle)
forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
R.allocate (FilePath -> IO (Either IOException Handle)
forall e. Exception e => FilePath -> IO (Either e Handle)
openReadFile FilePath
fp) Either IOException Handle -> IO ()
forall b. Either b Handle -> IO ()
cleanup
(IOException -> m (ReleaseKey, Handle))
-> (Handle -> m (ReleaseKey, Handle))
-> Either IOException Handle
-> m (ReleaseKey, Handle)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\(IOException
e :: U.IOException) -> IOException -> m (ReleaseKey, Handle)
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO IOException
e) ((ReleaseKey, Handle) -> m (ReleaseKey, Handle)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ReleaseKey, Handle) -> m (ReleaseKey, Handle))
-> (Handle -> (ReleaseKey, Handle))
-> Handle
-> m (ReleaseKey, Handle)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReleaseKey
rk,)) Either IOException Handle
hdlE
where
openReadFile :: FilePath -> IO (Either e Handle)
openReadFile FilePath
f = IO Handle -> IO (Either e Handle)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
U.try (IO Handle -> IO (Either e Handle))
-> IO Handle -> IO (Either e Handle)
forall a b. (a -> b) -> a -> b
$ FilePath -> IOMode -> IO Handle
IO.openBinaryFile FilePath
f IOMode
IO.ReadMode
cleanup :: Either b Handle -> IO ()
cleanup = (b -> IO ()) -> (Handle -> IO ()) -> Either b Handle -> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (IO () -> b -> IO ()
forall a b. a -> b -> a
const (IO () -> b -> IO ()) -> IO () -> b -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Handle -> IO ()
IO.hClose
getFileSize ::
(MonadUnliftIO m) =>
Handle ->
m (Maybe Int64)
getFileSize :: Handle -> m (Maybe Int64)
getFileSize Handle
h = do
Either IOException Int64
resE <- IO (Either IOException Int64) -> m (Either IOException Int64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either IOException Int64) -> m (Either IOException Int64))
-> IO (Either IOException Int64) -> m (Either IOException Int64)
forall a b. (a -> b) -> a -> b
$ IO Int64 -> IO (Either IOException Int64)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try (IO Int64 -> IO (Either IOException Int64))
-> IO Int64 -> IO (Either IOException Int64)
forall a b. (a -> b) -> a -> b
$ Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int64) -> IO Integer -> IO Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO Integer
IO.hFileSize Handle
h
case Either IOException Int64
resE of
Left (IOException
_ :: U.IOException) -> Maybe Int64 -> m (Maybe Int64)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int64
forall a. Maybe a
Nothing
Right Int64
s -> Maybe Int64 -> m (Maybe Int64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int64 -> m (Maybe Int64)) -> Maybe Int64 -> m (Maybe Int64)
forall a b. (a -> b) -> a -> b
$ Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
s
isHandleSeekable ::
(R.MonadResource m) =>
Handle ->
m Bool
isHandleSeekable :: Handle -> m Bool
isHandleSeekable Handle
h = do
Either IOException Bool
resE <- IO (Either IOException Bool) -> m (Either IOException Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either IOException Bool) -> m (Either IOException Bool))
-> IO (Either IOException Bool) -> m (Either IOException Bool)
forall a b. (a -> b) -> a -> b
$ IO Bool -> IO (Either IOException Bool)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try (IO Bool -> IO (Either IOException Bool))
-> IO Bool -> IO (Either IOException Bool)
forall a b. (a -> b) -> a -> b
$ Handle -> IO Bool
IO.hIsSeekable Handle
h
case Either IOException Bool
resE of
Left (IOException
_ :: U.IOException) -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Right Bool
v -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
v
withNewHandle ::
(MonadUnliftIO m, R.MonadResource m) =>
FilePath ->
(Handle -> m a) ->
m (Either U.IOException a)
withNewHandle :: FilePath -> (Handle -> m a) -> m (Either IOException a)
withNewHandle FilePath
fp Handle -> m a
fileAction = do
Either IOException (ReleaseKey, Handle)
handleE <- m (ReleaseKey, Handle)
-> m (Either IOException (ReleaseKey, Handle))
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try (m (ReleaseKey, Handle)
-> m (Either IOException (ReleaseKey, Handle)))
-> m (ReleaseKey, Handle)
-> m (Either IOException (ReleaseKey, Handle))
forall a b. (a -> b) -> a -> b
$ FilePath -> m (ReleaseKey, Handle)
forall (m :: * -> *).
(MonadUnliftIO m, MonadResource m) =>
FilePath -> m (ReleaseKey, Handle)
allocateReadFile FilePath
fp
(IOException -> m (Either IOException a))
-> ((ReleaseKey, Handle) -> m (Either IOException a))
-> Either IOException (ReleaseKey, Handle)
-> m (Either IOException a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either IOException a -> m (Either IOException a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either IOException a -> m (Either IOException a))
-> (IOException -> Either IOException a)
-> IOException
-> m (Either IOException a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOException -> Either IOException a
forall a b. a -> Either a b
Left) (ReleaseKey, Handle) -> m (Either IOException a)
doAction Either IOException (ReleaseKey, Handle)
handleE
where
doAction :: (ReleaseKey, Handle) -> m (Either IOException a)
doAction (ReleaseKey
rkey, Handle
h) = do
Either IOException a
resE <- m a -> m (Either IOException a)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try (m a -> m (Either IOException a))
-> m a -> m (Either IOException a)
forall a b. (a -> b) -> a -> b
$ Handle -> m a
fileAction Handle
h
ReleaseKey -> m ()
forall (m :: * -> *). MonadIO m => ReleaseKey -> m ()
R.release ReleaseKey
rkey
Either IOException a -> m (Either IOException a)
forall (m :: * -> *) a. Monad m => a -> m a
return Either IOException a
resE
mkHeaderFromPairs :: [(ByteString, ByteString)] -> [HT.Header]
= ((ByteString, ByteString) -> Header)
-> [(ByteString, ByteString)] -> [Header]
forall a b. (a -> b) -> [a] -> [b]
map ((ByteString -> CI ByteString) -> (ByteString, ByteString) -> Header
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
mk)
lookupHeader :: HT.HeaderName -> [HT.Header] -> Maybe ByteString
CI ByteString
hdr = [ByteString] -> Maybe ByteString
forall a. [a] -> Maybe a
listToMaybe ([ByteString] -> Maybe ByteString)
-> ([Header] -> [ByteString]) -> [Header] -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Header -> ByteString) -> [Header] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map Header -> ByteString
forall a b. (a, b) -> b
snd ([Header] -> [ByteString])
-> ([Header] -> [Header]) -> [Header] -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Header -> Bool) -> [Header] -> [Header]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(CI ByteString
h, ByteString
_) -> CI ByteString
h CI ByteString -> CI ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== CI ByteString
hdr)
getETagHeader :: [HT.Header] -> Maybe Text
[Header]
hs = ByteString -> Text
decodeUtf8Lenient (ByteString -> Text) -> Maybe ByteString -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CI ByteString -> [Header] -> Maybe ByteString
lookupHeader CI ByteString
Hdr.hETag [Header]
hs
getMetadata :: [HT.Header] -> [(Text, Text)]
getMetadata :: [Header] -> [(Text, Text)]
getMetadata =
(Header -> (Text, Text)) -> [Header] -> [(Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (\(CI ByteString
x, ByteString
y) -> (ByteString -> Text
decodeUtf8Lenient (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ CI ByteString -> ByteString
forall s. CI s -> s
original CI ByteString
x, ByteString -> Text
decodeUtf8Lenient (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
stripBS ByteString
y))
toMaybeMetadataHeader :: (Text, Text) -> Maybe (Text, Text)
(Text
k, Text
v) =
(,Text
v) (Text -> (Text, Text)) -> Maybe Text -> Maybe (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
userMetadataHeaderNameMaybe Text
k
getNonUserMetadataMap :: [(Text, Text)] -> H.HashMap Text Text
getNonUserMetadataMap :: [(Text, Text)] -> HashMap Text Text
getNonUserMetadataMap =
[(Text, Text)] -> HashMap Text Text
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
H.fromList
([(Text, Text)] -> HashMap Text Text)
-> ([(Text, Text)] -> [(Text, Text)])
-> [(Text, Text)]
-> HashMap Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Text) -> Bool) -> [(Text, Text)] -> [(Text, Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter
( Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing
(Maybe Text -> Bool)
-> ((Text, Text) -> Maybe Text) -> (Text, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
userMetadataHeaderNameMaybe
(Text -> Maybe Text)
-> ((Text, Text) -> Text) -> (Text, Text) -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text) -> Text
forall a b. (a, b) -> a
fst
)
getUserMetadataMap :: [(Text, Text)] -> H.HashMap Text Text
getUserMetadataMap :: [(Text, Text)] -> HashMap Text Text
getUserMetadataMap =
[(Text, Text)] -> HashMap Text Text
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
H.fromList
([(Text, Text)] -> HashMap Text Text)
-> ([(Text, Text)] -> [(Text, Text)])
-> [(Text, Text)]
-> HashMap Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Text) -> Maybe (Text, Text))
-> [(Text, Text)] -> [(Text, Text)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text, Text) -> Maybe (Text, Text)
toMaybeMetadataHeader
getLastModifiedHeader :: [HT.Header] -> Maybe UTCTime
[Header]
hs = do
Text
modTimebs <- ByteString -> Text
decodeUtf8Lenient (ByteString -> Text) -> Maybe ByteString -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CI ByteString -> [Header] -> Maybe ByteString
lookupHeader CI ByteString
Hdr.hLastModified [Header]
hs
Bool -> TimeLocale -> FilePath -> FilePath -> Maybe UTCTime
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> FilePath -> FilePath -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale FilePath
rfc822DateFormat (Text -> FilePath
T.unpack Text
modTimebs)
getContentLength :: [HT.Header] -> Maybe Int64
getContentLength :: [Header] -> Maybe Int64
getContentLength [Header]
hs = do
Text
nbs <- ByteString -> Text
decodeUtf8Lenient (ByteString -> Text) -> Maybe ByteString -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CI ByteString -> [Header] -> Maybe ByteString
lookupHeader CI ByteString
Hdr.hContentLength [Header]
hs
(Int64, Text) -> Int64
forall a b. (a, b) -> a
fst ((Int64, Text) -> Int64) -> Maybe (Int64, Text) -> Maybe Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> Maybe (Int64, Text))
-> ((Int64, Text) -> Maybe (Int64, Text))
-> Either FilePath (Int64, Text)
-> Maybe (Int64, Text)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe (Int64, Text) -> FilePath -> Maybe (Int64, Text)
forall a b. a -> b -> a
const Maybe (Int64, Text)
forall a. Maybe a
Nothing) (Int64, Text) -> Maybe (Int64, Text)
forall a. a -> Maybe a
Just (Reader Int64
forall a. Integral a => Reader a
decimal Text
nbs)
decodeUtf8Lenient :: ByteString -> Text
decodeUtf8Lenient :: ByteString -> Text
decodeUtf8Lenient = OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode
isSuccessStatus :: HT.Status -> Bool
isSuccessStatus :: Status -> Bool
isSuccessStatus Status
sts =
let s :: Int
s = Status -> Int
HT.statusCode Status
sts
in (Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
200 Bool -> Bool -> Bool
&& Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
300)
httpLbs ::
MonadIO m =>
NC.Request ->
NC.Manager ->
m (NC.Response LByteString)
httpLbs :: Request -> Manager -> m (Response LByteString)
httpLbs Request
req Manager
mgr = do
Either HttpException (Response LByteString)
respE <- IO (Either HttpException (Response LByteString))
-> m (Either HttpException (Response LByteString))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either HttpException (Response LByteString))
-> m (Either HttpException (Response LByteString)))
-> IO (Either HttpException (Response LByteString))
-> m (Either HttpException (Response LByteString))
forall a b. (a -> b) -> a -> b
$ IO (Response LByteString)
-> IO (Either HttpException (Response LByteString))
tryHttpEx (IO (Response LByteString)
-> IO (Either HttpException (Response LByteString)))
-> IO (Response LByteString)
-> IO (Either HttpException (Response LByteString))
forall a b. (a -> b) -> a -> b
$ Request -> Manager -> IO (Response LByteString)
forall (m :: * -> *).
MonadIO m =>
Request -> Manager -> m (Response LByteString)
NC.httpLbs Request
req Manager
mgr
Response LByteString
resp <- (HttpException -> m (Response LByteString))
-> (Response LByteString -> m (Response LByteString))
-> Either HttpException (Response LByteString)
-> m (Response LByteString)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either HttpException -> m (Response LByteString)
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO Response LByteString -> m (Response LByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Either HttpException (Response LByteString)
respE
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Status -> Bool
isSuccessStatus (Status -> Bool) -> Status -> Bool
forall a b. (a -> b) -> a -> b
$ Response LByteString -> Status
forall body. Response body -> Status
NC.responseStatus Response LByteString
resp) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
case Response LByteString -> Maybe ByteString
forall body. Response body -> Maybe ByteString
contentTypeMay Response LByteString
resp of
Just ByteString
"application/xml" -> do
ServiceErr
sErr <- LByteString -> m ServiceErr
forall (m :: * -> *). MonadIO m => LByteString -> m ServiceErr
parseErrResponse (LByteString -> m ServiceErr) -> LByteString -> m ServiceErr
forall a b. (a -> b) -> a -> b
$ Response LByteString -> LByteString
forall body. Response body -> body
NC.responseBody Response LByteString
resp
ServiceErr -> m ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO ServiceErr
sErr
Just ByteString
"application/json" -> do
ServiceErr
sErr <- LByteString -> m ServiceErr
forall (m :: * -> *). MonadIO m => LByteString -> m ServiceErr
parseErrResponseJSON (LByteString -> m ServiceErr) -> LByteString -> m ServiceErr
forall a b. (a -> b) -> a -> b
$ Response LByteString -> LByteString
forall body. Response body -> body
NC.responseBody Response LByteString
resp
ServiceErr -> m ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO ServiceErr
sErr
Maybe ByteString
_ ->
HttpException -> m ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (HttpException -> m ()) -> HttpException -> m ()
forall a b. (a -> b) -> a -> b
$
Request -> HttpExceptionContent -> HttpException
NC.HttpExceptionRequest Request
req (HttpExceptionContent -> HttpException)
-> HttpExceptionContent -> HttpException
forall a b. (a -> b) -> a -> b
$
Response () -> ByteString -> HttpExceptionContent
NC.StatusCodeException (Response LByteString -> Response ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Response LByteString
resp) (Response LByteString -> ByteString
forall a. Show a => a -> ByteString
showBS Response LByteString
resp)
Response LByteString -> m (Response LByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Response LByteString
resp
where
tryHttpEx ::
IO (NC.Response LByteString) ->
IO (Either NC.HttpException (NC.Response LByteString))
tryHttpEx :: IO (Response LByteString)
-> IO (Either HttpException (Response LByteString))
tryHttpEx = IO (Response LByteString)
-> IO (Either HttpException (Response LByteString))
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try
contentTypeMay :: Response body -> Maybe ByteString
contentTypeMay Response body
resp =
CI ByteString -> [Header] -> Maybe ByteString
lookupHeader CI ByteString
Hdr.hContentType ([Header] -> Maybe ByteString) -> [Header] -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$
Response body -> [Header]
forall body. Response body -> [Header]
NC.responseHeaders Response body
resp
http ::
(MonadUnliftIO m, R.MonadResource m) =>
NC.Request ->
NC.Manager ->
m (Response (C.ConduitT () ByteString m ()))
http :: Request -> Manager -> m (Response (ConduitT () ByteString m ()))
http Request
req Manager
mgr = do
Either HttpException (Response (ConduitT () ByteString m ()))
respE <- m (Response (ConduitT () ByteString m ()))
-> m (Either
HttpException (Response (ConduitT () ByteString m ())))
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either HttpException a)
tryHttpEx (m (Response (ConduitT () ByteString m ()))
-> m (Either
HttpException (Response (ConduitT () ByteString m ()))))
-> m (Response (ConduitT () ByteString m ()))
-> m (Either
HttpException (Response (ConduitT () ByteString m ())))
forall a b. (a -> b) -> a -> b
$ Request -> Manager -> m (Response (ConduitT () ByteString m ()))
forall (m :: * -> *) i.
MonadResource m =>
Request -> Manager -> m (Response (ConduitM i ByteString m ()))
NC.http Request
req Manager
mgr
Response (ConduitT () ByteString m ())
resp <- (HttpException -> m (Response (ConduitT () ByteString m ())))
-> (Response (ConduitT () ByteString m ())
-> m (Response (ConduitT () ByteString m ())))
-> Either HttpException (Response (ConduitT () ByteString m ()))
-> m (Response (ConduitT () ByteString m ()))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either HttpException -> m (Response (ConduitT () ByteString m ()))
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO Response (ConduitT () ByteString m ())
-> m (Response (ConduitT () ByteString m ()))
forall (m :: * -> *) a. Monad m => a -> m a
return Either HttpException (Response (ConduitT () ByteString m ()))
respE
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Status -> Bool
isSuccessStatus (Status -> Bool) -> Status -> Bool
forall a b. (a -> b) -> a -> b
$ Response (ConduitT () ByteString m ()) -> Status
forall body. Response body -> Status
NC.responseStatus Response (ConduitT () ByteString m ())
resp) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
case Response (ConduitT () ByteString m ()) -> Maybe ByteString
forall body. Response body -> Maybe ByteString
contentTypeMay Response (ConduitT () ByteString m ())
resp of
Just ByteString
"application/xml" -> do
LByteString
respBody <- ConduitT () ByteString m ()
-> ConduitT ByteString Void m LByteString -> m LByteString
forall (m :: * -> *) a r.
Monad m =>
ConduitT () a m () -> ConduitT a Void m r -> m r
C.connect (Response (ConduitT () ByteString m ())
-> ConduitT () ByteString m ()
forall body. Response body -> body
NC.responseBody Response (ConduitT () ByteString m ())
resp) ConduitT ByteString Void m LByteString
forall (m :: * -> *) o.
Monad m =>
ConduitT ByteString o m LByteString
CB.sinkLbs
ServiceErr
sErr <- LByteString -> m ServiceErr
forall (m :: * -> *). MonadIO m => LByteString -> m ServiceErr
parseErrResponse LByteString
respBody
ServiceErr -> m ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO ServiceErr
sErr
Maybe ByteString
_ -> do
ByteString
content <- LByteString -> ByteString
LB.toStrict (LByteString -> ByteString)
-> (Response LByteString -> LByteString)
-> Response LByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response LByteString -> LByteString
forall body. Response body -> body
NC.responseBody (Response LByteString -> ByteString)
-> m (Response LByteString) -> m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Response (ConduitT () ByteString m ()) -> m (Response LByteString)
forall (m :: * -> *).
Monad m =>
Response (ConduitM () ByteString m ()) -> m (Response LByteString)
NC.lbsResponse Response (ConduitT () ByteString m ())
resp
HttpException -> m ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (HttpException -> m ()) -> HttpException -> m ()
forall a b. (a -> b) -> a -> b
$
Request -> HttpExceptionContent -> HttpException
NC.HttpExceptionRequest Request
req (HttpExceptionContent -> HttpException)
-> HttpExceptionContent -> HttpException
forall a b. (a -> b) -> a -> b
$
Response () -> ByteString -> HttpExceptionContent
NC.StatusCodeException (Response (ConduitT () ByteString m ()) -> Response ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Response (ConduitT () ByteString m ())
resp) ByteString
content
Response (ConduitT () ByteString m ())
-> m (Response (ConduitT () ByteString m ()))
forall (m :: * -> *) a. Monad m => a -> m a
return Response (ConduitT () ByteString m ())
resp
where
tryHttpEx ::
(MonadUnliftIO m) =>
m a ->
m (Either NC.HttpException a)
tryHttpEx :: m a -> m (Either HttpException a)
tryHttpEx = m a -> m (Either HttpException a)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try
contentTypeMay :: Response body -> Maybe ByteString
contentTypeMay Response body
resp =
CI ByteString -> [Header] -> Maybe ByteString
lookupHeader CI ByteString
Hdr.hContentType ([Header] -> Maybe ByteString) -> [Header] -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$
Response body -> [Header]
forall body. Response body -> [Header]
NC.responseHeaders Response body
resp
limitedMapConcurrently ::
MonadUnliftIO m =>
Int ->
(t -> m a) ->
[t] ->
m [a]
limitedMapConcurrently :: Int -> (t -> m a) -> [t] -> m [a]
limitedMapConcurrently Int
0 t -> m a
_ [t]
_ = [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
limitedMapConcurrently Int
count t -> m a
act [t]
args = do
TVar Int
t' <- Int -> m (TVar Int)
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
U.newTVarIO Int
count
[Async a]
threads <- (t -> m (Async a)) -> [t] -> m [Async a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (m a -> m (Async a)
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
A.async (m a -> m (Async a)) -> (t -> m a) -> t -> m (Async a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TVar Int -> t -> m a
wThread TVar Int
t') [t]
args
(Async a -> m a) -> [Async a] -> m [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Async a -> m a
forall (m :: * -> *) a. MonadIO m => Async a -> m a
A.wait [Async a]
threads
where
wThread :: TVar Int -> t -> m a
wThread TVar Int
t t
arg =
m () -> m () -> m a -> m a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> m b -> m c -> m c
U.bracket_ (TVar Int -> m ()
forall (m :: * -> *) a. (MonadIO m, Ord a, Num a) => TVar a -> m ()
waitSem TVar Int
t) (TVar Int -> m ()
forall (m :: * -> *) a. (MonadIO m, Num a) => TVar a -> m ()
signalSem TVar Int
t) (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ t -> m a
act t
arg
waitSem :: TVar a -> m ()
waitSem TVar a
t = STM () -> m ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
U.atomically (STM () -> m ()) -> STM () -> m ()
forall a b. (a -> b) -> a -> b
$ do
a
v <- TVar a -> STM a
forall a. TVar a -> STM a
U.readTVar TVar a
t
if a
v a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0
then TVar a -> a -> STM ()
forall a. TVar a -> a -> STM ()
U.writeTVar TVar a
t (a
v a -> a -> a
forall a. Num a => a -> a -> a
- a
1)
else STM ()
forall a. STM a
U.retrySTM
signalSem :: TVar a -> m ()
signalSem TVar a
t = STM () -> m ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
U.atomically (STM () -> m ()) -> STM () -> m ()
forall a b. (a -> b) -> a -> b
$ do
a
v <- TVar a -> STM a
forall a. TVar a -> STM a
U.readTVar TVar a
t
TVar a -> a -> STM ()
forall a. TVar a -> a -> STM ()
U.writeTVar TVar a
t (a
v a -> a -> a
forall a. Num a => a -> a -> a
+ a
1)
mkQuery :: Text -> Maybe Text -> Maybe (Text, Text)
mkQuery :: Text -> Maybe Text -> Maybe (Text, Text)
mkQuery Text
k Maybe Text
mv = (Text
k,) (Text -> (Text, Text)) -> Maybe Text -> Maybe (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
mv
mkOptionalParams :: [(Text, Maybe Text)] -> HT.Query
mkOptionalParams :: [(Text, Maybe Text)] -> Query
mkOptionalParams [(Text, Maybe Text)]
params = [Maybe (Text, Text)] -> Query
forall a. QueryLike a => a -> Query
HT.toQuery ([Maybe (Text, Text)] -> Query) -> [Maybe (Text, Text)] -> Query
forall a b. (a -> b) -> a -> b
$ (Text -> Maybe Text -> Maybe (Text, Text))
-> (Text, Maybe Text) -> Maybe (Text, Text)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Maybe Text -> Maybe (Text, Text)
mkQuery ((Text, Maybe Text) -> Maybe (Text, Text))
-> [(Text, Maybe Text)] -> [Maybe (Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Maybe Text)]
params
chunkBSConduit :: (Monad m) => [Int] -> C.ConduitM ByteString ByteString m ()
chunkBSConduit :: [Int] -> ConduitM ByteString ByteString m ()
chunkBSConduit [] = () -> ConduitM ByteString ByteString m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
chunkBSConduit (Int
s : [Int]
ss) = do
ByteString
bs <- (LByteString -> ByteString)
-> ConduitT ByteString ByteString m LByteString
-> ConduitT ByteString ByteString m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LByteString -> ByteString
LB.toStrict (ConduitT ByteString ByteString m LByteString
-> ConduitT ByteString ByteString m ByteString)
-> ConduitT ByteString ByteString m LByteString
-> ConduitT ByteString ByteString m ByteString
forall a b. (a -> b) -> a -> b
$ Index ByteString -> ConduitM ByteString ByteString m ()
forall (m :: * -> *) seq.
(Monad m, IsSequence seq) =>
Index seq -> ConduitT seq seq m ()
C.takeCE Int
Index ByteString
s ConduitM ByteString ByteString m ()
-> ConduitT ByteString ByteString m LByteString
-> ConduitT ByteString ByteString m LByteString
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
C..| ConduitT ByteString ByteString m LByteString
forall (m :: * -> *) lazy strict o.
(Monad m, LazySequence lazy strict) =>
ConduitT strict o m lazy
C.sinkLazy
if
| ByteString -> Int
B.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
s -> ByteString -> ConduitM ByteString ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
C.yield ByteString
bs ConduitM ByteString ByteString m ()
-> ConduitM ByteString ByteString m ()
-> ConduitM ByteString ByteString m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Int] -> ConduitM ByteString ByteString m ()
forall (m :: * -> *).
Monad m =>
[Int] -> ConduitM ByteString ByteString m ()
chunkBSConduit [Int]
ss
| ByteString -> Int
B.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> ByteString -> ConduitM ByteString ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
C.yield ByteString
bs
| Bool
otherwise -> () -> ConduitM ByteString ByteString m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
selectPartSizes :: Int64 -> [(PartNumber, Int64, Int64)]
selectPartSizes :: Int64 -> [(PartNumber, Int64, Int64)]
selectPartSizes Int64
size =
([Int64] -> [Int64] -> [(PartNumber, Int64, Int64)])
-> ([Int64], [Int64]) -> [(PartNumber, Int64, Int64)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ([PartNumber] -> [Int64] -> [Int64] -> [(PartNumber, Int64, Int64)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
List.zip3 [PartNumber
1 ..]) (([Int64], [Int64]) -> [(PartNumber, Int64, Int64)])
-> ([Int64], [Int64]) -> [(PartNumber, Int64, Int64)]
forall a b. (a -> b) -> a -> b
$
[(Int64, Int64)] -> ([Int64], [Int64])
forall a b. [(a, b)] -> ([a], [b])
List.unzip ([(Int64, Int64)] -> ([Int64], [Int64]))
-> [(Int64, Int64)] -> ([Int64], [Int64])
forall a b. (a -> b) -> a -> b
$
Int64 -> Int64 -> [(Int64, Int64)]
loop Int64
0 Int64
size
where
ceil :: Double -> Int64
ceil :: Double -> Int64
ceil = Double -> Int64
forall a b. (RealFrac a, Integral b) => a -> b
ceiling
partSize :: Int64
partSize =
Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
max
Int64
minPartSize
( Double -> Int64
ceil (Double -> Int64) -> Double -> Int64
forall a b. (a -> b) -> a -> b
$
Int64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
size
Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
maxMultipartParts
)
m :: Int64
m = Int64
partSize
loop :: Int64 -> Int64 -> [(Int64, Int64)]
loop Int64
st Int64
sz
| Int64
st Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
sz = []
| Int64
st Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
m Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
sz = [(Int64
st, Int64
sz Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
st)]
| Bool
otherwise = (Int64
st, Int64
m) (Int64, Int64) -> [(Int64, Int64)] -> [(Int64, Int64)]
forall a. a -> [a] -> [a]
: Int64 -> Int64 -> [(Int64, Int64)]
loop (Int64
st Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
m) Int64
sz
lookupRegionCache :: Bucket -> Minio (Maybe Region)
lookupRegionCache :: Text -> Minio (Maybe Text)
lookupRegionCache Text
b = do
MVar (HashMap Text Text)
rMVar <- (MinioConn -> MVar (HashMap Text Text))
-> Minio (MVar (HashMap Text Text))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks MinioConn -> MVar (HashMap Text Text)
mcRegionMap
HashMap Text Text
rMap <- MVar (HashMap Text Text) -> Minio (HashMap Text Text)
forall (m :: * -> *) a. MonadIO m => MVar a -> m a
UM.readMVar MVar (HashMap Text Text)
rMVar
Maybe Text -> Minio (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> Minio (Maybe Text))
-> Maybe Text -> Minio (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> HashMap Text Text -> Maybe Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
b HashMap Text Text
rMap
addToRegionCache :: Bucket -> Region -> Minio ()
addToRegionCache :: Text -> Text -> Minio ()
addToRegionCache Text
b Text
region = do
MVar (HashMap Text Text)
rMVar <- (MinioConn -> MVar (HashMap Text Text))
-> Minio (MVar (HashMap Text Text))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks MinioConn -> MVar (HashMap Text Text)
mcRegionMap
MVar (HashMap Text Text)
-> (HashMap Text Text -> Minio (HashMap Text Text)) -> Minio ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
MVar a -> (a -> m a) -> m ()
UM.modifyMVar_ MVar (HashMap Text Text)
rMVar ((HashMap Text Text -> Minio (HashMap Text Text)) -> Minio ())
-> (HashMap Text Text -> Minio (HashMap Text Text)) -> Minio ()
forall a b. (a -> b) -> a -> b
$ HashMap Text Text -> Minio (HashMap Text Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (HashMap Text Text -> Minio (HashMap Text Text))
-> (HashMap Text Text -> HashMap Text Text)
-> HashMap Text Text
-> Minio (HashMap Text Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> HashMap Text Text -> HashMap Text Text
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
H.insert Text
b Text
region
deleteFromRegionCache :: Bucket -> Minio ()
deleteFromRegionCache :: Text -> Minio ()
deleteFromRegionCache Text
b = do
MVar (HashMap Text Text)
rMVar <- (MinioConn -> MVar (HashMap Text Text))
-> Minio (MVar (HashMap Text Text))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks MinioConn -> MVar (HashMap Text Text)
mcRegionMap
MVar (HashMap Text Text)
-> (HashMap Text Text -> Minio (HashMap Text Text)) -> Minio ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
MVar a -> (a -> m a) -> m ()
UM.modifyMVar_ MVar (HashMap Text Text)
rMVar ((HashMap Text Text -> Minio (HashMap Text Text)) -> Minio ())
-> (HashMap Text Text -> Minio (HashMap Text Text)) -> Minio ()
forall a b. (a -> b) -> a -> b
$ HashMap Text Text -> Minio (HashMap Text Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (HashMap Text Text -> Minio (HashMap Text Text))
-> (HashMap Text Text -> HashMap Text Text)
-> HashMap Text Text
-> Minio (HashMap Text Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> HashMap Text Text -> HashMap Text Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
H.delete Text
b