module Network.GRPC.Spec.PercentEncoding (
encode
, decode
) where
import Control.Exception
import Data.Bifunctor
import Data.Bits
import Data.ByteString qualified as BS.Strict
import Data.ByteString qualified as Strict (ByteString)
import Data.ByteString.Builder (Builder)
import Data.ByteString.Builder qualified as Builder
import Data.ByteString.Lazy qualified as BS.Lazy
import Data.Text (Text)
import Data.Text.Encoding qualified as Text
import Data.Text.Encoding.Error qualified as Text
import Data.Word
import Network.GRPC.Spec.Util.ByteString (ascii)
encode :: Text -> Strict.ByteString
encode :: Text -> ByteString
encode =
LazyByteString -> ByteString
BS.Lazy.toStrict
(LazyByteString -> ByteString)
-> (Text -> LazyByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> LazyByteString
Builder.toLazyByteString
(Builder -> LazyByteString)
-> (Text -> Builder) -> Text -> LazyByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Builder) -> [Word8] -> Builder
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Word8 -> Builder
encodeChar
([Word8] -> Builder) -> (Text -> [Word8]) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BS.Strict.unpack
(ByteString -> [Word8]) -> (Text -> ByteString) -> Text -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8
encodeChar :: Word8 -> Builder
encodeChar :: Word8 -> Builder
encodeChar Word8
c
| Word8 -> Bool
needsEncoding Word8
c = let (Word8
hi, Word8
lo) = Word8 -> (Word8, Word8)
toBase16 Word8
c
in [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [
Char -> Builder
Builder.char7 Char
'%'
, Word8 -> Builder
Builder.word8 Word8
hi
, Word8 -> Builder
Builder.word8 Word8
lo
]
| Bool
otherwise = Word8 -> Builder
Builder.word8 Word8
c
needsEncoding :: Word8 -> Bool
needsEncoding :: Word8 -> Bool
needsEncoding Word8
c
| Word8
0x20 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
c Bool -> Bool -> Bool
&& Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
0x24 = Bool
False
| Word8
0x26 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
c Bool -> Bool -> Bool
&& Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
0x7E = Bool
False
| Bool
otherwise = Bool
True
data DecodeException =
InvalidHexDigit Word8
| MissingHexDigits
| InvalidUtf8 Text.UnicodeException
deriving stock (Int -> DecodeException -> ShowS
[DecodeException] -> ShowS
DecodeException -> String
(Int -> DecodeException -> ShowS)
-> (DecodeException -> String)
-> ([DecodeException] -> ShowS)
-> Show DecodeException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DecodeException -> ShowS
showsPrec :: Int -> DecodeException -> ShowS
$cshow :: DecodeException -> String
show :: DecodeException -> String
$cshowList :: [DecodeException] -> ShowS
showList :: [DecodeException] -> ShowS
Show)
instance Exception DecodeException where
displayException :: DecodeException -> String
displayException (InvalidHexDigit Word8
w) =
String
"invalid hex digit '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
w String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'"
displayException DecodeException
MissingHexDigits =
String
"'%' not followed by two hex digits"
displayException (InvalidUtf8 UnicodeException
err) =
UnicodeException -> String
forall e. Exception e => e -> String
displayException UnicodeException
err
decode :: Strict.ByteString -> Either DecodeException Text
decode :: ByteString -> Either DecodeException Text
decode =
(Either DecodeException ByteString
-> (ByteString -> Either DecodeException Text)
-> Either DecodeException Text
forall a b.
Either DecodeException a
-> (a -> Either DecodeException b) -> Either DecodeException b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (UnicodeException -> DecodeException)
-> Either UnicodeException Text -> Either DecodeException Text
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first UnicodeException -> DecodeException
InvalidUtf8 (Either UnicodeException Text -> Either DecodeException Text)
-> (ByteString -> Either UnicodeException Text)
-> ByteString
-> Either DecodeException Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
Text.decodeUtf8')
(Either DecodeException ByteString -> Either DecodeException Text)
-> (ByteString -> Either DecodeException ByteString)
-> ByteString
-> Either DecodeException Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Word8] -> ByteString)
-> Either DecodeException [Word8]
-> Either DecodeException ByteString
forall a b.
(a -> b) -> Either DecodeException a -> Either DecodeException b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Word8] -> ByteString
BS.Strict.pack
(Either DecodeException [Word8]
-> Either DecodeException ByteString)
-> (ByteString -> Either DecodeException [Word8])
-> ByteString
-> Either DecodeException ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> [Word8] -> Either DecodeException [Word8]
go []
([Word8] -> Either DecodeException [Word8])
-> (ByteString -> [Word8])
-> ByteString
-> Either DecodeException [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BS.Strict.unpack
where
go :: [Word8] -> [Word8] -> Either DecodeException [Word8]
go :: [Word8] -> [Word8] -> Either DecodeException [Word8]
go [Word8]
acc (Word8
c:[Word8]
cs)
| Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== HasCallStack => Char -> Word8
Char -> Word8
ascii Char
'%' = case [Word8]
cs of
Word8
hi:Word8
lo:[Word8]
cs' -> do
c' <- (Word8, Word8) -> Either DecodeException Word8
fromBase16 (Word8
hi, Word8
lo)
go (c':acc) cs'
[Word8]
_otherwise ->
DecodeException -> Either DecodeException [Word8]
forall a b. a -> Either a b
Left (DecodeException -> Either DecodeException [Word8])
-> DecodeException -> Either DecodeException [Word8]
forall a b. (a -> b) -> a -> b
$ DecodeException
MissingHexDigits
| Bool
otherwise = [Word8] -> [Word8] -> Either DecodeException [Word8]
go (Word8
cWord8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
:[Word8]
acc) [Word8]
cs
go [Word8]
acc [] = [Word8] -> Either DecodeException [Word8]
forall a b. b -> Either a b
Right ([Word8] -> [Word8]
forall a. [a] -> [a]
reverse [Word8]
acc)
toBase16 :: Word8 -> (Word8, Word8)
toBase16 :: Word8 -> (Word8, Word8)
toBase16 Word8
c = (Word8 -> Word8
toHexDigit Word8
hi, Word8 -> Word8
toHexDigit Word8
lo)
where
hi, lo :: Word8
hi :: Word8
hi = Word8
c Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
4
lo :: Word8
lo = Word8
c Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x0F;
fromBase16 :: (Word8, Word8) -> Either DecodeException Word8
fromBase16 :: (Word8, Word8) -> Either DecodeException Word8
fromBase16 = \(Word8
hi, Word8
lo) -> Word8 -> Word8 -> Word8
aux (Word8 -> Word8 -> Word8)
-> Either DecodeException Word8
-> Either DecodeException (Word8 -> Word8)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word8 -> Either DecodeException Word8
fromHexDigit Word8
hi Either DecodeException (Word8 -> Word8)
-> Either DecodeException Word8 -> Either DecodeException Word8
forall a b.
Either DecodeException (a -> b)
-> Either DecodeException a -> Either DecodeException b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Word8 -> Either DecodeException Word8
fromHexDigit Word8
lo
where
aux :: Word8 -> Word8 -> Word8
aux :: Word8 -> Word8 -> Word8
aux Word8
hi Word8
lo = (Word8
hi Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
4) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
lo
toHexDigit :: Word8 -> Word8
toHexDigit :: Word8 -> Word8
toHexDigit Word8
c
| Word8
0 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
c Bool -> Bool -> Bool
&& Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
9 = HasCallStack => Char -> Word8
Char -> Word8
ascii Char
'0' Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
c
| Word8
10 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
c Bool -> Bool -> Bool
&& Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
15 = HasCallStack => Char -> Word8
Char -> Word8
ascii Char
'A' Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ (Word8
c Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
10)
| Bool
otherwise = String -> Word8
forall a. HasCallStack => String -> a
error String
"toHexDigit: out of range"
fromHexDigit :: Word8 -> Either DecodeException Word8
fromHexDigit :: Word8 -> Either DecodeException Word8
fromHexDigit Word8
c
| HasCallStack => Char -> Word8
Char -> Word8
ascii Char
'0' Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
c Bool -> Bool -> Bool
&& Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= HasCallStack => Char -> Word8
Char -> Word8
ascii Char
'9' = Word8 -> Either DecodeException Word8
forall a b. b -> Either a b
Right (Word8 -> Either DecodeException Word8)
-> Word8 -> Either DecodeException Word8
forall a b. (a -> b) -> a -> b
$ Word8
c Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- HasCallStack => Char -> Word8
Char -> Word8
ascii Char
'0'
| HasCallStack => Char -> Word8
Char -> Word8
ascii Char
'A' Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
c Bool -> Bool -> Bool
&& Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= HasCallStack => Char -> Word8
Char -> Word8
ascii Char
'F' = Word8 -> Either DecodeException Word8
forall a b. b -> Either a b
Right (Word8 -> Either DecodeException Word8)
-> Word8 -> Either DecodeException Word8
forall a b. (a -> b) -> a -> b
$ Word8
10 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
c Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- HasCallStack => Char -> Word8
Char -> Word8
ascii Char
'A'
| HasCallStack => Char -> Word8
Char -> Word8
ascii Char
'a' Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
c Bool -> Bool -> Bool
&& Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= HasCallStack => Char -> Word8
Char -> Word8
ascii Char
'f' = Word8 -> Either DecodeException Word8
forall a b. b -> Either a b
Right (Word8 -> Either DecodeException Word8)
-> Word8 -> Either DecodeException Word8
forall a b. (a -> b) -> a -> b
$ Word8
10 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
c Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- HasCallStack => Char -> Word8
Char -> Word8
ascii Char
'a'
| Bool
otherwise = DecodeException -> Either DecodeException Word8
forall a b. a -> Either a b
Left (DecodeException -> Either DecodeException Word8)
-> DecodeException -> Either DecodeException Word8
forall a b. (a -> b) -> a -> b
$ Word8 -> DecodeException
InvalidHexDigit Word8
c