module Network.HTTP.Base64
( encode
, decode
, chop72
, Octet
) where
import Data.Array (Array, array, (!))
import Data.Bits (shiftL, shiftR, (.&.), (.|.))
import Data.Char (chr, ord)
import Data.Word (Word8)
type Octet = Word8
encodeArray :: Array Int Char
encodeArray :: Array Int Char
encodeArray = (Int, Int) -> [(Int, Char)] -> Array Int Char
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (0,64)
[ (0,'A'), (1,'B'), (2,'C'), (3,'D'), (4,'E'), (5,'F')
, (6,'G'), (7,'H'), (8,'I'), (9,'J'), (10,'K'), (11,'L')
, (12,'M'), (13,'N'), (14,'O'), (15,'P'), (16,'Q'), (17,'R')
, (18,'S'), (19,'T'), (20,'U'), (21,'V'), (22,'W'), (23,'X')
, (24,'Y'), (25,'Z'), (26,'a'), (27,'b'), (28,'c'), (29,'d')
, (30,'e'), (31,'f'), (32,'g'), (33,'h'), (34,'i'), (35,'j')
, (36,'k'), (37,'l'), (38,'m'), (39,'n'), (40,'o'), (41,'p')
, (42,'q'), (43,'r'), (44,'s'), (45,'t'), (46,'u'), (47,'v')
, (48,'w'), (49,'x'), (50,'y'), (51,'z'), (52,'0'), (53,'1')
, (54,'2'), (55,'3'), (56,'4'), (57,'5'), (58,'6'), (59,'7')
, (60,'8'), (61,'9'), (62,'+'), (63,'/') ]
int4_char3 :: [Int] -> [Char]
int4_char3 :: [Int] -> [Char]
int4_char3 (a :: Int
a:b :: Int
b:c :: Int
c:d :: Int
d:t :: [Int]
t) =
let n :: Int
n = (Int
a Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` 18 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
b Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` 12 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
c Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` 6 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
d)
in (Int -> Char
chr (Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` 16 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. 0xff))
Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: (Int -> Char
chr (Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` 8 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. 0xff))
Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: (Int -> Char
chr (Int
n Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. 0xff)) Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Int] -> [Char]
int4_char3 [Int]
t
int4_char3 [a :: Int
a,b :: Int
b,c :: Int
c] =
let n :: Int
n = (Int
a Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` 18 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
b Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` 12 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
c Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` 6)
in [ (Int -> Char
chr (Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` 16 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. 0xff))
, (Int -> Char
chr (Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` 8 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. 0xff)) ]
int4_char3 [a :: Int
a,b :: Int
b] =
let n :: Int
n = (Int
a Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` 18 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
b Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` 12)
in [ (Int -> Char
chr (Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` 16 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. 0xff)) ]
int4_char3 [_] = [Char] -> [Char]
forall a. HasCallStack => [Char] -> a
error "Network.HTTP.Base64.int4_char3: impossible number of Ints."
int4_char3 [] = []
char3_int4 :: [Char] -> [Int]
char3_int4 :: [Char] -> [Int]
char3_int4 (a :: Char
a:b :: Char
b:c :: Char
c:t :: [Char]
t)
= let n :: Int
n = (Char -> Int
ord Char
a Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` 16 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Char -> Int
ord Char
b Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` 8 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Char -> Int
ord Char
c)
in (Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` 18 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. 0x3f) Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` 12 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. 0x3f) Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` 6 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. 0x3f) Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (Int
n Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. 0x3f) Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Char] -> [Int]
char3_int4 [Char]
t
char3_int4 [a :: Char
a,b :: Char
b]
= let n :: Int
n = (Char -> Int
ord Char
a Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` 16 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Char -> Int
ord Char
b Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` 8)
in [ (Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` 18 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. 0x3f)
, (Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` 12 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. 0x3f)
, (Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` 6 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. 0x3f) ]
char3_int4 [a :: Char
a]
= let n :: Int
n = (Char -> Int
ord Char
a Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` 16)
in [(Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` 18 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. 0x3f),(Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` 12 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. 0x3f)]
char3_int4 [] = []
enc1 :: Int -> Char
enc1 :: Int -> Char
enc1 ch :: Int
ch = Array Int Char
encodeArrayArray Int Char -> Int -> Char
forall i e. Ix i => Array i e -> i -> e
!Int
ch
chop72 :: String -> String
chop72 :: [Char] -> [Char]
chop72 str :: [Char]
str = let (bgn :: [Char]
bgn,end :: [Char]
end) = Int -> [Char] -> ([Char], [Char])
forall a. Int -> [a] -> ([a], [a])
splitAt 70 [Char]
str
in if [Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
end then [Char]
bgn else "\r\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
chop72 [Char]
end
quadruplets :: [Char] -> [Char]
quadruplets :: [Char] -> [Char]
quadruplets (a :: Char
a:b :: Char
b:c :: Char
c:d :: Char
d:t :: [Char]
t) = Char
aChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Char
bChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Char
cChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Char
dChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char] -> [Char]
quadruplets [Char]
t
quadruplets [a :: Char
a,b :: Char
b,c :: Char
c] = [Char
a,Char
b,Char
c,'=']
quadruplets [a :: Char
a,b :: Char
b] = [Char
a,Char
b,'=','=']
quadruplets [_] = [Char] -> [Char]
forall a. HasCallStack => [Char] -> a
error "Network.HTTP.Base64.quadruplets: impossible number of characters."
quadruplets [] = []
enc :: [Int] -> [Char]
enc :: [Int] -> [Char]
enc = [Char] -> [Char]
quadruplets ([Char] -> [Char]) -> ([Int] -> [Char]) -> [Int] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Char) -> [Int] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
enc1
dcd :: String -> [Int]
dcd :: [Char] -> [Int]
dcd [] = []
dcd (h :: Char
h:t :: [Char]
t)
| Char
h Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= 'Z' Bool -> Bool -> Bool
&& Char
h Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= 'A' = Char -> Int
ord Char
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord 'A' Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Char] -> [Int]
dcd [Char]
t
| Char
h Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '0' Bool -> Bool -> Bool
&& Char
h Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '9' = Char -> Int
ord Char
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord '0' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 52 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Char] -> [Int]
dcd [Char]
t
| Char
h Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= 'a' Bool -> Bool -> Bool
&& Char
h Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= 'z' = Char -> Int
ord Char
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord 'a' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 26 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Char] -> [Int]
dcd [Char]
t
| Char
h Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '+' = 62 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Char] -> [Int]
dcd [Char]
t
| Char
h Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '/' = 63 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Char] -> [Int]
dcd [Char]
t
| Char
h Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '=' = []
| Bool
otherwise = [Char] -> [Int]
dcd [Char]
t
encode :: [Octet] -> String
encode :: [Octet] -> [Char]
encode = [Int] -> [Char]
enc ([Int] -> [Char]) -> ([Octet] -> [Int]) -> [Octet] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Int]
char3_int4 ([Char] -> [Int]) -> ([Octet] -> [Char]) -> [Octet] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Octet -> Char) -> [Octet] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
chr (Int -> Char) -> (Octet -> Int) -> Octet -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Octet -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral))
decode :: String -> [Octet]
decode :: [Char] -> [Octet]
decode = ((Char -> Octet) -> [Char] -> [Octet]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Octet
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Octet) -> (Char -> Int) -> Char -> Octet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord)) ([Char] -> [Octet]) -> ([Char] -> [Char]) -> [Char] -> [Octet]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Char]
int4_char3 ([Int] -> [Char]) -> ([Char] -> [Int]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Int]
dcd