--
-- MinIO Haskell SDK, (C) 2018 MinIO, Inc.
--
-- Licensed under the Apache License, Version 2.0 (the "License");
-- you may not use this file except in compliance with the License.
-- You may obtain a copy of the License at
--
--     http://www.apache.org/licenses/LICENSE-2.0
--
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS,
-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-- See the License for the specific language governing permissions and
-- limitations under the License.
--

module Network.Minio.APICommon where

import qualified Conduit as C
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LB
import Data.Conduit.Binary (sourceHandleRange)
import qualified Data.Text as T
import Lib.Prelude
import qualified Network.HTTP.Conduit as NC
import qualified Network.HTTP.Types as HT
import Network.Minio.Data
import Network.Minio.Data.Crypto
import Network.Minio.Errors

sha256Header :: ByteString -> HT.Header
sha256Header :: ByteString -> Header
sha256Header = (HeaderName
"x-amz-content-sha256",)

-- | This function throws an error if the payload is a conduit (as it
-- will not be possible to re-read the conduit after it is consumed).
getPayloadSHA256Hash :: Payload -> Minio ByteString
getPayloadSHA256Hash :: Payload -> Minio ByteString
getPayloadSHA256Hash (PayloadBS ByteString
bs) = ByteString -> Minio ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Minio ByteString) -> ByteString -> Minio ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
hashSHA256 ByteString
bs
getPayloadSHA256Hash (PayloadH Handle
h Int64
off Int64
size) =
  ConduitM () ByteString Minio () -> Minio ByteString
forall (m :: * -> *).
Monad m =>
ConduitM () ByteString m () -> m ByteString
hashSHA256FromSource (ConduitM () ByteString Minio () -> Minio ByteString)
-> ConduitM () ByteString Minio () -> Minio ByteString
forall a b. (a -> b) -> a -> b
$
    Handle
-> Maybe Integer
-> Maybe Integer
-> ConduitM () ByteString Minio ()
forall (m :: * -> *) i.
MonadIO m =>
Handle
-> Maybe Integer -> Maybe Integer -> ConduitT i ByteString m ()
sourceHandleRange
      Handle
h
      (Integer -> Maybe Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Maybe Integer)
-> (Int64 -> Integer) -> Int64 -> Maybe Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Maybe Integer) -> Int64 -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ Int64
off)
      (Integer -> Maybe Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Maybe Integer)
-> (Int64 -> Integer) -> Int64 -> Maybe Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Maybe Integer) -> Int64 -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ Int64
size)
getPayloadSHA256Hash (PayloadC Int64
_ ConduitT () ByteString (ResourceT IO) ()
_) = MErrV -> Minio ByteString
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO MErrV
MErrVUnexpectedPayload

getRequestBody :: Payload -> NC.RequestBody
getRequestBody :: Payload -> RequestBody
getRequestBody (PayloadBS ByteString
bs) = ByteString -> RequestBody
NC.RequestBodyBS ByteString
bs
getRequestBody (PayloadH Handle
h Int64
off Int64
size) =
  Int64 -> ConduitT () ByteString (ResourceT IO) () -> RequestBody
NC.requestBodySource Int64
size (ConduitT () ByteString (ResourceT IO) () -> RequestBody)
-> ConduitT () ByteString (ResourceT IO) () -> RequestBody
forall a b. (a -> b) -> a -> b
$
    Handle
-> Maybe Integer
-> Maybe Integer
-> ConduitT () ByteString (ResourceT IO) ()
forall (m :: * -> *) i.
MonadIO m =>
Handle
-> Maybe Integer -> Maybe Integer -> ConduitT i ByteString m ()
sourceHandleRange
      Handle
h
      (Integer -> Maybe Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Maybe Integer)
-> (Int64 -> Integer) -> Int64 -> Maybe Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Maybe Integer) -> Int64 -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ Int64
off)
      (Integer -> Maybe Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Maybe Integer)
-> (Int64 -> Integer) -> Int64 -> Maybe Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Maybe Integer) -> Int64 -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ Int64
size)
getRequestBody (PayloadC Int64
n ConduitT () ByteString (ResourceT IO) ()
src) = Int64 -> ConduitT () ByteString (ResourceT IO) () -> RequestBody
NC.requestBodySource Int64
n ConduitT () ByteString (ResourceT IO) ()
src

mkStreamingPayload :: Payload -> Payload
mkStreamingPayload :: Payload -> Payload
mkStreamingPayload Payload
payload =
  case Payload
payload of
    PayloadBS ByteString
bs ->
      Int64 -> ConduitT () ByteString (ResourceT IO) () -> Payload
PayloadC
        (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> Int -> Int64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
bs)
        (ByteString -> ConduitT () ByteString (ResourceT IO) ()
forall (m :: * -> *) lazy strict i.
(Monad m, LazySequence lazy strict) =>
lazy -> ConduitT i strict m ()
C.sourceLazy (ByteString -> ConduitT () ByteString (ResourceT IO) ())
-> ByteString -> ConduitT () ByteString (ResourceT IO) ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LB.fromStrict ByteString
bs)
    PayloadH Handle
h Int64
off Int64
len ->
      Int64 -> ConduitT () ByteString (ResourceT IO) () -> Payload
PayloadC Int64
len (ConduitT () ByteString (ResourceT IO) () -> Payload)
-> ConduitT () ByteString (ResourceT IO) () -> Payload
forall a b. (a -> b) -> a -> b
$
        Handle
-> Maybe Integer
-> Maybe Integer
-> ConduitT () ByteString (ResourceT IO) ()
forall (m :: * -> *) i.
MonadIO m =>
Handle
-> Maybe Integer -> Maybe Integer -> ConduitT i ByteString m ()
sourceHandleRange
          Handle
h
          (Integer -> Maybe Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Maybe Integer)
-> (Int64 -> Integer) -> Int64 -> Maybe Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Maybe Integer) -> Int64 -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ Int64
off)
          (Integer -> Maybe Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Maybe Integer)
-> (Int64 -> Integer) -> Int64 -> Maybe Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Maybe Integer) -> Int64 -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ Int64
len)
    Payload
_ -> Payload
payload

isStreamingPayload :: Payload -> Bool
isStreamingPayload :: Payload -> Bool
isStreamingPayload (PayloadC Int64
_ ConduitT () ByteString (ResourceT IO) ()
_) = Bool
True
isStreamingPayload Payload
_ = Bool
False

-- | Checks if the connect info is for Amazon S3.
isAWSConnectInfo :: ConnectInfo -> Bool
isAWSConnectInfo :: ConnectInfo -> Bool
isAWSConnectInfo ConnectInfo
ci = Text
".amazonaws.com" Text -> Text -> Bool
`T.isSuffixOf` ConnectInfo -> Text
connectHost ConnectInfo
ci

bucketHasPeriods :: Bucket -> Bool
bucketHasPeriods :: Text -> Bool
bucketHasPeriods Text
b = Maybe Char -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Char -> Bool) -> Maybe Char -> Bool
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Maybe Char
T.find (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') Text
b