diff options
Diffstat (limited to 'base64')
| -rw-r--r-- | base64/Makefile | 13 | ||||
| -rw-r--r-- | base64/base64_0.hs | 25 | ||||
| -rw-r--r-- | base64/base64_3.hs | 127 | ||||
| -rw-r--r-- | base64/base64_4.hs | 55 |
4 files changed, 207 insertions, 13 deletions
diff --git a/base64/Makefile b/base64/Makefile deleted file mode 100644 index 71b16ec..0000000 --- a/base64/Makefile +++ /dev/null @@ -1,13 +0,0 @@ -base64: base64.hs - #stack ghc -- -O2 base64.hs -rtsopts -prof -fprof-cafs -fprof-auto - stack ghc -- -O2 base64.hs - -run: base64 - ./base64 10 100 +RTS -N2 - #cat /tmp/random.bin | ./base64 +RTS -N6 > /dev/null -run-prof: base64prof - cat /tmp/random.bin | ./base64prof +RTS -N6 -p -s > /dev/null -base64prof: base64.hs - stack ghc -- -threaded -rtsopts -prof -fprof-auto -fprof-cafs -O2 base64.hs -o base64prof -genrandom: - dd if=/dev/urandom of=/tmp/random.bin bs=1M count=64 diff --git a/base64/base64_0.hs b/base64/base64_0.hs new file mode 100644 index 0000000..f7673b8 --- /dev/null +++ b/base64/base64_0.hs @@ -0,0 +1,25 @@ +-- File: base64.hs -- + +import Data.Char +import Text.Printf +import qualified Data.List as L +import qualified Data.List.Split as T + +toBase64 x = maskBase64 x . toBase64core . asciiToBin . binFill $ x +toBase64core = map base64toDigit . map binToDec . T.chunksOf 6 + +base64toDigit x = (['A'..'Z']++['a'..'z']++['0'..'9']++['+','/']) !! x +binToDec = sum . map (2^) . L.findIndices (=='1') . reverse +asciiToBin = concat . map (\y -> printf "%08b" y) . map ord +binFill x = x ++ (take (fill64length x) $ cycle "\000") + +maskBase64 o x = take (length x - l ) x ++ (take l $ cycle "=") + where l = (fill64length o) + +fill64length x | m==0 = 0 + | otherwise = 3-m + where m=mod (length x) 3 + +main = do + line <- getLine + putStrLn $ toBase64 line diff --git a/base64/base64_3.hs b/base64/base64_3.hs new file mode 100644 index 0000000..5fddf5b --- /dev/null +++ b/base64/base64_3.hs @@ -0,0 +1,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 +-} diff --git a/base64/base64_4.hs b/base64/base64_4.hs new file mode 100644 index 0000000..5c9a43e --- /dev/null +++ b/base64/base64_4.hs @@ -0,0 +1,55 @@ +import Data.Char (ord) +import Data.Word (Word8) +import Data.Tuple.Extra +import Data.Tuple (swap) +import Data.Array (array,(!),Array) +import Data.Bits (shiftL,shiftR,(.&.)) +import System.Environment (getArgs,getProgName,withArgs) +import Test.Hspec (hspec,describe,it,shouldBe) +import qualified Data.ByteString.Lazy as BL +import qualified Data.ByteString.Lazy.Char8 as Char8 + +main = do args<-getArgs + let arg=args!!0 + prg<-getProgName + if length args == 0 + then BL.getContents >>= BL.putStr . encode64 + else if length args == 1 && arg == "-t" + then withArgs [] test + else if length args == 1 && arg == "-d" + then BL.getContents >>= BL.putStr . decode64 + else putStrLn $ unlines + [ "usage: "++prg++" [FLAG]" + ,"reads from stdin" + ,"default mode is encode" + ,"flags: -d decode, -t unit test"] + +encode64 = chunkBL 76 (flip BL.append (Char8.pack "\n")) . chunkBL 3 (from 6 4.to 8) +decode64 = chunkBL 4 (from 8 3.to 6) + +tab64enc :: Array Int Word8 +tab64enc = array (0,63) $ zip [0..] $ map (fromIntegral.ord) $ + ['A'..'Z']++['a'..'z']++['0'..'9']++['+','/'] + +to s = (\(v,l)->(v`shiftL`((3-fromIntegral l)*s),l+1)) . first (BL.foldl' f 0) . second (BL.length) . dupe + where f a v = a `shiftL` s + fromIntegral v + +from s l (x,m) = BL.take (fromIntegral l) . BL.pack $ (++repeat 61) $ map f (take (fromIntegral m) $ reverse [0..l-1]) + where f v = tab64enc ! (x `shiftR` (v*s) .&. (2^s-1)) + +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 + +-- |Unit Testing +tests=[ ("any carnal pleasure.","YW55IGNhcm5hbCBwbGVhc3VyZS4=\n") + ,("any carnal pleasure","YW55IGNhcm5hbCBwbGVhc3VyZQ==\n") + ,("any carnal pleasur","YW55IGNhcm5hbCBwbGVhc3Vy\n") + ,("any carnal pleasu","YW55IGNhcm5hbCBwbGVhc3U=\n") + ,("any carnal pleas","YW55IGNhcm5hbCBwbGVhcw==\n") ] + +test = hspec $ do describe "Base64" $ do + it "encode" $ do mapM_ (tst encode64) tests + it "decode" $ do mapM_ (tst decode64) (map swap tests) + where tst f (d,e) = (f (Char8.pack d)) `shouldBe` (Char8.pack e) |