module Codec.Binary.Base85
( EncIncData(..)
, EncIncRes(..)
, encodeInc
, encode
, DecIncData(..)
, DecIncRes(..)
, decodeInc
, decode
, chop
, unchop
) where
import Codec.Binary.Util
import Data.Array
import Data.Bits
import Data.Char
import Data.Maybe
import Data.Word
import qualified Data.Map as M
_encMap :: [(Word8, Char)]
_encMap :: [(Word8, Char)]
_encMap = [(Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i, Int -> Char
chr Int
i) | Int
i <- [Int
33..Int
117]]
encodeArray :: Array Word8 Char
encodeArray :: Array Word8 Char
encodeArray = (Word8, Word8) -> [(Word8, Char)] -> Array Word8 Char
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (Word8
33, Word8
117) [(Word8, Char)]
_encMap
decodeMap :: M.Map Char Word8
decodeMap :: Map Char Word8
decodeMap = [(Char, Word8)] -> Map Char Word8
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [((Word8, Char) -> Char
forall a b. (a, b) -> b
snd (Word8, Char)
i, (Word8, Char) -> Word8
forall a b. (a, b) -> a
fst (Word8, Char)
i) | (Word8, Char)
i <- [(Word8, Char)]
_encMap]
encodeInc :: EncIncData -> EncIncRes String
encodeInc :: EncIncData -> EncIncRes String
encodeInc EncIncData
e = [Word8] -> EncIncData -> EncIncRes String
eI [] EncIncData
e
where
enc4 :: [a] -> String
enc4 [a
0, a
0, a
0, a
0] = String
"z"
enc4 [a
0x20, a
0x20, a
0x20, a
0x20] = String
"y"
enc4 os :: [a]
os@[a
o1, a
o2, a
o3, a
o4] = (Word8 -> Char) -> [Word8] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Array Word8 Char
encodeArray Array Word8 Char -> Word8 -> Char
forall i e. Ix i => Array i e -> i -> e
!) [Word8]
group
where
group2Word32 :: Word32
group2Word32 = (Word32 -> a -> Word32) -> Word32 -> [a] -> Word32
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\ Word32
a a
b -> Word32
a Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
8 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ a -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
b) Word32
0 [a]
os
encodeWord32ToWord8s :: Word32 -> [Word8]
encodeWord32ToWord8s :: Word32 -> [Word8]
encodeWord32ToWord8s =
(Word32 -> Word8) -> [Word32] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word8) -> (Word32 -> Word32) -> Word32 -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`mod` Word32
85)) ([Word32] -> [Word8]) -> (Word32 -> [Word32]) -> Word32 -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Word32] -> [Word32]
forall a. Int -> [a] -> [a]
take Int
5 ([Word32] -> [Word32])
-> (Word32 -> [Word32]) -> Word32 -> [Word32]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Word32) -> Word32 -> [Word32]
forall a. (a -> a) -> a -> [a]
iterate (Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`div` Word32
85)
adjustNReverse :: [Word8] -> [Word8]
adjustNReverse = [Word8] -> [Word8]
forall a. [a] -> [a]
reverse ([Word8] -> [Word8]) -> ([Word8] -> [Word8]) -> [Word8] -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Word8) -> [Word8] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map (Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
33)
group :: [Word8]
group = ([Word8] -> [Word8]
adjustNReverse ([Word8] -> [Word8]) -> (Word32 -> [Word8]) -> Word32 -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Word32 -> [Word8]
encodeWord32ToWord8s) Word32
group2Word32
eI :: [Word8] -> EncIncData -> EncIncRes String
eI [] EncIncData
EDone = String -> EncIncRes String
forall i. i -> EncIncRes i
EFinal []
eI [Word8
o1] EncIncData
EDone = String -> EncIncRes String
forall i. i -> EncIncRes i
EFinal (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
2 String
cs)
where
cs :: String
cs = [Word8] -> String
forall {a}. Integral a => [a] -> String
enc4 [Word8
o1, Word8
0, Word8
0, Word8
1]
eI [Word8
o1, Word8
o2] EncIncData
EDone = String -> EncIncRes String
forall i. i -> EncIncRes i
EFinal (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 String
cs)
where
cs :: String
cs = [Word8] -> String
forall {a}. Integral a => [a] -> String
enc4 [Word8
o1, Word8
o2, Word8
0, Word8
1]
eI [Word8
o1, Word8
o2, Word8
o3] EncIncData
EDone = String -> EncIncRes String
forall i. i -> EncIncRes i
EFinal (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
4 String
cs)
where
cs :: String
cs = [Word8] -> String
forall {a}. Integral a => [a] -> String
enc4 [Word8
o1, Word8
o2, Word8
o3, Word8
1]
eI [Word8]
lo (EChunk [Word8]
bs) = String -> [Word8] -> EncIncRes String
doEnc [] ([Word8]
lo [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ [Word8]
bs)
where
doEnc :: String -> [Word8] -> EncIncRes String
doEnc String
acc (Word8
o1:Word8
o2:Word8
o3:Word8
o4:[Word8]
os) = String -> [Word8] -> EncIncRes String
doEnc (String
acc String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Word8] -> String
forall {a}. Integral a => [a] -> String
enc4 [Word8
o1, Word8
o2, Word8
o3, Word8
o4]) [Word8]
os
doEnc String
acc [Word8]
os = String -> (EncIncData -> EncIncRes String) -> EncIncRes String
forall i. i -> (EncIncData -> EncIncRes i) -> EncIncRes i
EPart String
acc ([Word8] -> EncIncData -> EncIncRes String
eI [Word8]
os)
encode :: [Word8] -> String
encode :: [Word8] -> String
encode = (EncIncData -> EncIncRes String) -> [Word8] -> String
forall {a}. (EncIncData -> EncIncRes [a]) -> [Word8] -> [a]
encoder EncIncData -> EncIncRes String
encodeInc
decodeInc :: DecIncData String -> DecIncRes String
decodeInc :: DecIncData String -> DecIncRes String
decodeInc DecIncData String
d = String -> DecIncData String -> DecIncRes String
dI [] DecIncData String
d
where
dec5 :: String -> Maybe [Word8]
dec5 String
cs = let
ds :: [Maybe Word8]
ds = (Char -> Maybe Word8) -> String -> [Maybe Word8]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Map Char Word8 -> Maybe Word8)
-> Map Char Word8 -> Char -> Maybe Word8
forall a b c. (a -> b -> c) -> b -> a -> c
flip Char -> Map Char Word8 -> Maybe Word8
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Map Char Word8
decodeMap) String
cs
es :: [Word8]
es@[Word8
e1, Word8
e2, Word8
e3, Word8
e4, Word8
e5] = (Maybe Word8 -> Word8) -> [Maybe Word8] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Maybe Word8 -> Word8
forall a. HasCallStack => Maybe a -> a
fromJust [Maybe Word8]
ds
adjRev :: [Word8]
adjRev = (Word8 -> Word8) -> [Word8] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map (\ Word8
i -> Word8
i Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
33) [Word8
e5, Word8
e4, Word8
e3, Word8
e2, Word8
e1]
group2Word32 :: [Word8] -> Word32
group2Word32 = (Word32 -> Word32 -> Word32) -> [Word32] -> Word32
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
(+) ([Word32] -> Word32) -> ([Word8] -> [Word32]) -> [Word8] -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Word32 -> Word32) -> [Word32] -> [Word32] -> [Word32]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
(*) ((Integer -> Word32) -> [Integer] -> [Word32]
forall a b. (a -> b) -> [a] -> [b]
map (Word32
85 Word32 -> Integer -> Word32
forall a b. (Num a, Integral b) => a -> b -> a
^) [Integer
0..Integer
4]) ([Word32] -> [Word32])
-> ([Word8] -> [Word32]) -> [Word8] -> [Word32]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Word32) -> [Word8] -> [Word32]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
word32ToGroup :: Word32 -> [Word8]
word32ToGroup :: Word32 -> [Word8]
word32ToGroup = (Word32 -> Word8) -> [Word32] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Word32] -> [Word8]) -> (Word32 -> [Word32]) -> Word32 -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word32] -> [Word32]
forall a. [a] -> [a]
reverse ([Word32] -> [Word32])
-> (Word32 -> [Word32]) -> Word32 -> [Word32]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Word32] -> [Word32]
forall a. Int -> [a] -> [a]
take Int
4 ([Word32] -> [Word32])
-> (Word32 -> [Word32]) -> Word32 -> [Word32]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Word32) -> Word32 -> [Word32]
forall a. (a -> a) -> a -> [a]
iterate (Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`div` Word32
256)
allJust :: [Maybe a] -> Bool
allJust = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> ([Maybe a] -> [Bool]) -> [Maybe a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe a -> Bool) -> [Maybe a] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map Maybe a -> Bool
forall a. Maybe a -> Bool
isJust
in if [Maybe Word8] -> Bool
forall {a}. [Maybe a] -> Bool
allJust [Maybe Word8]
ds
then [Word8] -> Maybe [Word8]
forall a. a -> Maybe a
Just ([Word8] -> Maybe [Word8]) -> [Word8] -> Maybe [Word8]
forall a b. (a -> b) -> a -> b
$ Word32 -> [Word8]
word32ToGroup (Word32 -> [Word8]) -> Word32 -> [Word8]
forall a b. (a -> b) -> a -> b
$ [Word8] -> Word32
group2Word32 [Word8]
adjRev
else Maybe [Word8]
forall a. Maybe a
Nothing
dI :: String -> DecIncData String -> DecIncRes String
dI String
lo (DChunk String
s) = [Word8] -> String -> DecIncRes String
doDec [] (String
lo String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s)
dI [] DecIncData String
DDone = [Word8] -> String -> DecIncRes String
forall i. [Word8] -> i -> DecIncRes i
DFinal [] []
dI cs :: String
cs@[Char
c1, Char
c2] DecIncData String
DDone = case [Word8] -> String -> DecIncRes String
doDec [] (String
cs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"uuu") of
(DPart [Word8]
r DecIncData String -> DecIncRes String
_) -> [Word8] -> String -> DecIncRes String
forall i. [Word8] -> i -> DecIncRes i
DFinal (Int -> [Word8] -> [Word8]
forall a. Int -> [a] -> [a]
take Int
1 [Word8]
r) []
DecIncRes String
f -> DecIncRes String
f
dI cs :: String
cs@[Char
c1, Char
c2, Char
c3] DecIncData String
DDone = case [Word8] -> String -> DecIncRes String
doDec [] (String
cs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"uu") of
(DPart [Word8]
r DecIncData String -> DecIncRes String
_) -> [Word8] -> String -> DecIncRes String
forall i. [Word8] -> i -> DecIncRes i
DFinal (Int -> [Word8] -> [Word8]
forall a. Int -> [a] -> [a]
take Int
2 [Word8]
r) []
DecIncRes String
f -> DecIncRes String
f
dI cs :: String
cs@[Char
c1, Char
c2, Char
c3, Char
c4] DecIncData String
DDone = case [Word8] -> String -> DecIncRes String
doDec [] (String
cs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"u") of
(DPart [Word8]
r DecIncData String -> DecIncRes String
_) -> [Word8] -> String -> DecIncRes String
forall i. [Word8] -> i -> DecIncRes i
DFinal (Int -> [Word8] -> [Word8]
forall a. Int -> [a] -> [a]
take Int
3 [Word8]
r) []
DecIncRes String
f -> DecIncRes String
f
dI String
lo DecIncData String
DDone = [Word8] -> String -> DecIncRes String
forall i. [Word8] -> i -> DecIncRes i
DFail [] String
lo
doDec :: [Word8] -> String -> DecIncRes String
doDec [Word8]
acc (Char
'z':String
cs) = [Word8] -> String -> DecIncRes String
doDec ([Word8]
acc [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ [Word8
0, Word8
0, Word8
0, Word8
0]) String
cs
doDec [Word8]
acc (Char
'y':String
cs) = [Word8] -> String -> DecIncRes String
doDec ([Word8]
acc [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ [Word8
0x20, Word8
0x20, Word8
0x20, Word8
0x20]) String
cs
doDec [Word8]
acc s :: String
s@(Char
c1:Char
c2:Char
c3:Char
c4:Char
c5:String
cs) = DecIncRes String
-> ([Word8] -> DecIncRes String)
-> Maybe [Word8]
-> DecIncRes String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
([Word8] -> String -> DecIncRes String
forall i. [Word8] -> i -> DecIncRes i
DFail [Word8]
acc String
s)
(\ [Word8]
bs -> [Word8] -> String -> DecIncRes String
doDec ([Word8]
acc [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ [Word8]
bs) String
cs)
(String -> Maybe [Word8]
dec5 [Char
c1, Char
c2, Char
c3, Char
c4, Char
c5])
doDec [Word8]
acc String
cs = [Word8]
-> (DecIncData String -> DecIncRes String) -> DecIncRes String
forall i. [Word8] -> (DecIncData i -> DecIncRes i) -> DecIncRes i
DPart [Word8]
acc (String -> DecIncData String -> DecIncRes String
dI String
cs)
decode :: String -> Maybe [Word8]
decode :: String -> Maybe [Word8]
decode = (DecIncData String -> DecIncRes String) -> String -> Maybe [Word8]
forall i. (DecIncData i -> DecIncRes i) -> i -> Maybe [Word8]
decoder DecIncData String -> DecIncRes String
decodeInc
chop :: Int
-> String
-> [String]
chop :: Int -> String -> [String]
chop Int
_ String
"" = []
chop Int
n String
s = let
enc_len :: Int
enc_len | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
5 = Int
5
| Bool
otherwise = Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
5
in Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
enc_len String
s String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Int -> String -> [String]
chop Int
n (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
enc_len String
s)
unchop :: [String]
-> String
unchop :: [String] -> String
unchop = (String -> String -> String) -> String -> [String] -> String
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr String -> String -> String
forall a. [a] -> [a] -> [a]
(++) String
""