--
-- 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 (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, ByteString) -> ByteString)
-> (ByteString -> (ByteString, ByteString))
-> ByteString
-> ByteString
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 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
      Builder -> ByteString
BB.toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$
        [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$
          (Char -> Builder) -> [Char] -> [Builder]
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 =
    Bool -> [Char] -> ByteString
forall s. UriEncodable s => Bool -> s -> ByteString
uriEncode Bool
encodeSlash ([Char] -> ByteString) -> [Char] -> ByteString
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 =
    Bool -> [Char] -> ByteString
forall s. UriEncodable s => Bool -> s -> ByteString
uriEncode Bool
encodeSlash ([Char] -> ByteString) -> [Char] -> ByteString
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 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_')
      Bool -> Bool -> Bool
|| (Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-')
      Bool -> Bool -> Bool
|| (Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.')
      Bool -> Bool -> Bool
|| (Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'~') =
      Char -> Builder
BB.char7 Char
ch
  | Bool
otherwise = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ (Word8 -> Builder) -> [Word8] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Builder
f ([Word8] -> [Builder]) -> [Word8] -> [Builder]
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
B.unpack (ByteString -> [Word8]) -> ByteString -> [Word8]
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
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
'%' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Builder
BB.string7 [Char]
hexStr
      where
        hexStr :: [Char]
hexStr = (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Word8 -> [Char] -> [Char]
forall a. (Integral a, Show a) => a -> [Char] -> [Char]
showHex Word8
q ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Word8 -> [Char] -> [Char]
forall a. (Integral a, Show a) => a -> [Char] -> [Char]
showHex Word8
r [Char]
""
        (Word8
q, Word8
r) = Word8 -> Word8 -> (Word8, Word8)
forall a. Integral a => a -> a -> (a, a)
divMod Word8
n (Word8
16 :: Word8)