--
-- MinIO Haskell SDK, (C) 2017 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.
--
{-# LANGUAGE FlexibleInstances #-}

module Network.Minio.Data.ByteString
  ( stripBS,
    UriEncodable (..),
  )
where

import qualified Data.ByteString as B
import qualified Data.ByteString.Builder as BB
import qualified Data.ByteString.Char8 as BC8
import qualified Data.ByteString.Lazy as LB
import Data.Char (isAsciiLower, isAsciiUpper, isDigit, isSpace, toUpper)
import qualified Data.Text as T
import Numeric (showHex)

stripBS :: ByteString -> ByteString
stripBS :: ByteString -> ByteString
stripBS = (Char -> Bool) -> ByteString -> ByteString
BC8.dropWhile Char -> Bool
isSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BC8.spanEnd Char -> Bool
isSpace

class UriEncodable s where
  uriEncode :: Bool -> s -> ByteString

instance UriEncodable [Char] where
  uriEncode :: Bool -> [Char] -> ByteString
uriEncode Bool
encodeSlash [Char]
payload =
    ByteString -> ByteString
LB.toStrict forall a b. (a -> b) -> a -> b
$
      Builder -> ByteString
BB.toLazyByteString forall a b. (a -> b) -> a -> b
$
        forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$
          forall a b. (a -> b) -> [a] -> [b]
map (Char -> Bool -> Builder
`uriEncodeChar` Bool
encodeSlash) [Char]
payload

instance UriEncodable ByteString where
  -- assumes that uriEncode is passed ASCII encoded strings.
  uriEncode :: Bool -> ByteString -> ByteString
uriEncode Bool
encodeSlash ByteString
bs =
    forall s. UriEncodable s => Bool -> s -> ByteString
uriEncode Bool
encodeSlash forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
BC8.unpack ByteString
bs

instance UriEncodable Text where
  uriEncode :: Bool -> Text -> ByteString
uriEncode Bool
encodeSlash Text
txt =
    forall s. UriEncodable s => Bool -> s -> ByteString
uriEncode Bool
encodeSlash forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
txt

-- | URI encode a char according to AWS S3 signing rules - see
-- UriEncode() at
-- https://docs.aws.amazon.com/AmazonS3/latest/API/sig-v4-header-based-auth.html
uriEncodeChar :: Char -> Bool -> BB.Builder
uriEncodeChar :: Char -> Bool -> Builder
uriEncodeChar Char
'/' Bool
True = ByteString -> Builder
BB.byteString ByteString
"%2F"
uriEncodeChar Char
'/' Bool
False = Char -> Builder
BB.char7 Char
'/'
uriEncodeChar Char
ch Bool
_
  | Char -> Bool
isAsciiUpper Char
ch
      Bool -> Bool -> Bool
|| Char -> Bool
isAsciiLower Char
ch
      Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
ch
      Bool -> Bool -> Bool
|| (Char
ch forall a. Eq a => a -> a -> Bool
== Char
'_')
      Bool -> Bool -> Bool
|| (Char
ch forall a. Eq a => a -> a -> Bool
== Char
'-')
      Bool -> Bool -> Bool
|| (Char
ch forall a. Eq a => a -> a -> Bool
== Char
'.')
      Bool -> Bool -> Bool
|| (Char
ch forall a. Eq a => a -> a -> Bool
== Char
'~') =
      Char -> Builder
BB.char7 Char
ch
  | Bool
otherwise = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Builder
f forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
B.unpack forall a b. (a -> b) -> a -> b
$ forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
ch
  where
    f :: Word8 -> BB.Builder
    f :: Word8 -> Builder
f Word8
n = Char -> Builder
BB.char7 Char
'%' forall a. Semigroup a => a -> a -> a
<> [Char] -> Builder
BB.string7 [Char]
hexStr
      where
        hexStr :: [Char]
hexStr = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper forall a b. (a -> b) -> a -> b
$ forall a. (Integral a, Show a) => a -> ShowS
showHex Word8
q forall a b. (a -> b) -> a -> b
$ forall a. (Integral a, Show a) => a -> ShowS
showHex Word8
r [Char]
""
        (Word8
q, Word8
r) = forall a. Integral a => a -> a -> (a, a)
divMod Word8
n (Word8
16 :: Word8)