{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif
module Data.ByteString.Base64.URL.Lazy
(
encode
, encodeUnpadded
, decode
, decodeUnpadded
, decodePadded
, decodeLenient
) where
import Data.ByteString.Base64.Internal
import qualified Data.ByteString.Base64.URL as B64
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Char8 as LC
import Data.Char
encode :: L.ByteString -> L.ByteString
encode :: ByteString -> ByteString
encode = [ByteString] -> ByteString
L.fromChunks forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ByteString -> ByteString
B64.encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [ByteString] -> [ByteString]
reChunkIn Int
3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
L.toChunks
encodeUnpadded :: L.ByteString -> L.ByteString
encodeUnpadded :: ByteString -> ByteString
encodeUnpadded = [ByteString] -> ByteString
L.fromChunks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ByteString -> ByteString
B64.encodeUnpadded
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [ByteString] -> [ByteString]
reChunkIn Int
3
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
L.toChunks
decode :: L.ByteString -> Either String L.ByteString
decode :: ByteString -> Either String ByteString
decode ByteString
b =
case ByteString -> Either String ByteString
B64.decode forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
S.concat forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
L.toChunks ByteString
b of
Left String
err -> forall a b. a -> Either a b
Left String
err
Right ByteString
b' -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
L.fromChunks [ByteString
b']
decodeUnpadded :: L.ByteString -> Either String L.ByteString
decodeUnpadded :: ByteString -> Either String ByteString
decodeUnpadded ByteString
bs = case ByteString -> Either String ByteString
B64.decodeUnpadded forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
S.concat forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
L.toChunks ByteString
bs of
Right ByteString
b -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
L.fromChunks [ByteString
b]
Left String
e -> forall a b. a -> Either a b
Left String
e
decodePadded :: L.ByteString -> Either String L.ByteString
decodePadded :: ByteString -> Either String ByteString
decodePadded ByteString
bs = case ByteString -> Either String ByteString
B64.decodePadded forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
S.concat forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
L.toChunks ByteString
bs of
Right ByteString
b -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
L.fromChunks [ByteString
b]
Left String
e -> forall a b. a -> Either a b
Left String
e
decodeLenient :: L.ByteString -> L.ByteString
decodeLenient :: ByteString -> ByteString
decodeLenient = [ByteString] -> ByteString
L.fromChunks forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ByteString -> ByteString
B64.decodeLenient forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [ByteString] -> [ByteString]
reChunkIn Int
4 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
L.toChunks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> ByteString
LC.filter Char -> Bool
goodChar
where
goodChar :: Char -> Bool
goodChar Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'_'