1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
|
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ViewPatterns #-}
import Data.Maybe (fromJust,isJust)
import Data.List.Split (chunksOf)
import Data.Tuple (swap)
import Data.Tuple.Extra (first,second,dupe)
import System.Environment (getArgs)
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString as B
import qualified Data.Map.Strict as M
import Data.Char
import Data.Maybe
import Data.Word
import Data.Array
import Data.Bits
--import Data.ByteString.Base64.Lazy as B64
import Data.ByteString.Base64 as B64
import GHC.Int
import Control.Parallel
import Control.Parallel.Strategies
main :: IO()
main = BL.getContents >>= BL.putStr . chunkBL 3 (fromNum 6 4.toNum 8)
table64 :: Array Int Word8
table64 = array (0,63) $ zip [0..] $ map (fromIntegral.ord) $
['A'..'Z']++['a'..'z']++['0'..'9']++['+','/']
toNum :: Int->BL.ByteString->Int
toNum s = BL.foldl' f 0 where f a v = a `shiftL` s + fromIntegral v
fromNum :: Int->Int->Int->BL.ByteString
fromNum s l x = BL.pack $ map f (reverse [0..l-1])
where f v = table64 ! (x `shiftR` (v*s) .&. (2^s-1))
chunkBL :: Int64->(BL.ByteString->BL.ByteString)->BL.ByteString->BL.ByteString
chunkBL n f b | BL.null b = b
| otherwise = let l = f . BL.take n $ b
r = chunkBL n f . BL.drop n $ b
in BL.append l r
chunkB :: Int64->BL.ByteString->[BL.ByteString]
chunkB n b | BL.null b = []
| otherwise = let l = BL.take n $ b
r = chunkB n . BL.drop n $ b
in l:r
{-
let arr=reverse $ BL.foldr f (0,0:[]) b
in arr --BL.unfoldr uf (0,snd arr)
where uf (_,[]) = Nothing
uf (3,x:xs) = Just (table64 ! x,(0,xs))
uf (c,x:xs) = Just (table64 ! (x.&.63),(c+1,x `shiftR` 6:xs))
f :: (Int,[Int]) -> Word8 -> (Int,[Int])
f (_,[]) v = (0,[])
f (2,x:xs) v = (0,0:(x `shiftL` 8) + fromIntegral v:xs)
f (c,x:xs) v = (c+1,(x `shiftL` 8) + fromIntegral v:xs)
-- BL.unfoldr uf . (,)3 . snd . BL.foldl' f (0,0:[])
-- -}
{-
-}
--main = B.getContents >>= B.putStr . B64.encode
-- Example Usage: echo "hello world" | ./base64 | ./base64 -d
-- TODO
-- cleanup/simplify
-- unit testing (cross check with cli base64, different lengths)
-- flag for line widht / check flags / filename on command-line
-- (see man base64)
-- compare performance . named map? array?
-- arg<-getArgs
{-
enc64 x = B.reverse $ B.unfoldr unf $ (4, (B.foldl' (\a b->a `shiftL` 8 + fromIntegral b) (0::Int) x))
unf (c,v) = if c==0 then Nothing else let r = v .&. 63 in Just (table64 ! r,(c-1,v`shiftR` 6))
if length arg == 0
then putStr . (++"\n") . encode64 . map fromIntegral . B.unpack $ dat
else B.putStr. B.pack . map fromIntegral . decode64 . C.unpack $ dat
-}
--t1 = BL.getContents >>= BL.putStr . BL.fromChunks . map (B.map f) . BL.toChunks
--enc=B.map (\x->table64 ! (x `shiftR` 4))
-- -- reChunkIn :: Int -> [B.ByteString] -> [B.ByteString]
-- -- reChunkIn !n = go
-- -- where
-- -- go [] = []
-- -- go (y : ys) = case B.length y `divMod` n of
-- -- (_, 0) -> y : go ys
-- -- (d, _) -> case B.splitAt (d * n) y of
-- -- (prefix, suffix) -> prefix : fixup suffix ys
-- -- fixup acc [] = [acc]
-- -- fixup acc (z : zs) = case B.splitAt (n - B.length acc) z of
-- -- (prefix, suffix) ->
-- -- let acc' = acc `B.append` prefix
-- -- in if B.length acc' == n
-- -- then let zs' = if B.null suffix
-- -- then zs
-- -- else suffix : zs
-- -- in acc' : go zs'
-- -- else -- suffix must be null
-- -- fixup acc' zs
--
--dec64 k = M.lookup k mp where mp = M.fromList $ map swap table64
{-
encode64 :: [Int] -> [Char]
encode64 = map (fromJust.enc64.flip mod 64) -- concat . map (pad . first enc . second length . dupe) . chunksOf 3
where enc = map (fromJust . enc64) . sumC
sumC = map fst . reverse . take 4 . drop 1 .iterate to64 . (,) 0 . sum . map (uncurry (*)) . zip mult
mult = map (256^) [2,1,0]
to64 (r,v) = let r' = v `mod` 64 in (r',(v-r')`div`64)
pad (v,l) =take 4 $ take (1+l) v ++ "==="
decode64 :: [Char]->[Int]
decode64 = map fst . concat . map (rem . first (reverse . take 3 . drop 1 . iterate to256 . (,) 0 . dec. map (fromJust) . filter (isJust) . map dec64).second (length.filter(=='=')). dupe) . chunksOf 4 . filter (/='\n')
where dec = sum . map (uncurry (*)) . zip (map (64^) [3,2..])
to256 (r,v) = let r' = v `mod` 256 in (r',(v-r')`div`256)
rem (v,l) = take (3-l) v
-}
|
