{-# 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
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
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)