summaryrefslogtreecommitdiff
path: root/base64/base64.hs
diff options
context:
space:
mode:
Diffstat (limited to 'base64/base64.hs')
-rw-r--r--base64/base64.hs80
1 files changed, 41 insertions, 39 deletions
diff --git a/base64/base64.hs b/base64/base64.hs
index 13f12bb..2443d07 100644
--- a/base64/base64.hs
+++ b/base64/base64.hs
@@ -1,45 +1,47 @@
---
--- Miguel's Naive
--- Base64 Encoder -- Coded on a winter afterfnoon on 19th Feb 2018 A.D.
--- to fully understand base64 encoding and play with
--- haskell, which is always an indisputable pleasure.
---
--- The following lines were written in full awareness
--- that 'libraries' for this purpose, which perform way
--- better, are in existence.
---
--- Coded in big anger due to nick's stories about saving his binary
--- format, encrypted passwords in an ascii config file, featuring
--- strange letters and characters.
---
--- Example Usage: echo "just testing" | stack runghc base64.hs | stack runghc base64 -- -d
--- (You can cross check with base64 / base64 -d)
-
-import System.Environment
-import qualified Data.List.Split as T
-import qualified Data.List as L
-import qualified Data.Map.Strict as M
+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 B
-import Text.Printf
-import Data.Maybe
-import Data.Char
-import Control.Monad
+import qualified Data.ByteString.Lazy.Char8 as C
+import qualified Data.Map as M
-main = do args<-getArgs
- if length args == 0 then go encode64
- else when (args!!0 == "-d") $ go decode64
- where go f = getContents >>= putStr.(++"\n").f
+-- Example Usage: echo "hello world" | ./base64 | ./base64 -d
-fromBase64 x = (['A'..'Z']++['a'..'z']++['0'..'9']++['+','/']) !! x
-mapBase64 = M.fromList $ map (\x-> (fromBase64 x,x)) [0..63]
-binToDec = sum . map (2^) . L.findIndices (=='1') . reverse
+-- 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?
-encode64 x = pad64 (length x) . map (fromBase64 . binToDec) . T.chunksOf 6 .
- concat . map (printf "%08b" ) $ x ++ cycle "\000"
+main = do arg<-getArgs
+ dat<-B.getContents
+ B.putStr.B.pack.encode.B.unpack $ dat
+{-
+ if length arg == 0
+ then putStr . (++"\n") . encode64 . map fromIntegral . B.unpack $ dat
+ else B.putStr. B.pack . map fromIntegral . decode64 . C.unpack $ dat
+-}
-decode64 x = map (chr . binToDec) . T.chunksOf 8 .
- concat . map ( printf "%06b" . fromJust) . filter isJust .
- map (flip M.lookup mapBase64) $ x
+encode = map ((+65).(`mod` 24))
-pad64 l = (++(take m ((cycle "=")))) . take ((l+m)*3 `div` 2 -3-m)
- where m = mod (3 - mod l 3) 3
+table64 = zip [0..] (['A'..'Z']++['a'..'z']++['0'..'9']++['+','/'])
+
+enc64 k = M.lookup k mp where mp = M.fromList table64
+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
+ pad (v,l) =take 4 $ take (1+l) v ++ "==="
+ 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)
+
+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