This is my take on the first challenge on the cryptopals crypto challenges list. I think that i made it quite simple but i feel like it is possible to optimize it further. Any suggestion?

The code:

import qualified Data.HashMap.Strict as HM
import qualified Data.IntMap.Strict as IM
import Data.Maybe
import Data.Char (digitToInt)
import Numeric (readInt)

type BinString = String
type HexString = String
type Base64String = String

base64 = IM.fromList (zip [0..63] (['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ ['+','/']))

hexToBinDict = HM.fromList [('0',"0000"),('1',"0001"),('2',"0010"),('3',"0011"),('4',"0100"),('5',"0101"),

hexToBase64 :: HexString -> Base64String
hexToBase64 xs = map fromJust [IM.lookup x base64 | x <- base10] ++ padMissingSextets sextets
    where base10 = map (fromJust) (map (binToDec) sextets)
          sextets = binToSextets (hexToBin xs)

--returns a list of the 4-digit binary encodings of the given string's hex codes
hexToQuartets :: HexString -> [BinString]
hexToQuartets [] = []
hexToQuartets hexCode = fromJust (HM.lookup (head hexCode) hexToBinDict) : hexToQuartets (tail hexCode)

--converts an hex string into a binary string
hexToBin :: HexString -> BinString
hexToBin xs = concat (hexToQuartets xs)

--pads the string with 0's on the right until its a sextet
padRight :: BinString -> BinString
padRight xs = xs ++ (replicate n '0')
    where n = 6 - length xs

--returns a list of all full sextets on the string
binToSextets :: BinString -> [BinString]
binToSextets xs = binToSextetsAux (tail xs) [] [head xs] 1

--recursiverly find sextets and pad the last one if necessary
binToSextetsAux :: BinString -> [BinString] -> BinString -> Int -> [String]
binToSextetsAux [] sextets ys _
    |length ys == 6     = sextets ++ [ys]
    |otherwise          = sextets ++ [padRight ys]
binToSextetsAux xs sextets ys i
    |i == 6     = binToSextetsAux (tail xs) (sextets ++ [ys]) [head xs] 1
    |otherwise  = binToSextetsAux (tail xs) sextets (ys ++ [head xs]) (i+1)

--binary string to decimal conversion
binToDec :: Integral a => BinString -> Maybe a
binToDec = fmap fst . listToMaybe . readInt 2 (`elem` "01") digitToInt

--pads with "=" on the right for each empty sextet
--if the length is not divisible by 4, then theres 1 or 2 empty sextets
padMissingSextets :: [BinString] -> BinString
padMissingSextets sextets
    |(length sextets) `mod` 4 /= 0      = if (length sextets) `mod` 4 == 2 then "=="
                                            else "="
    |otherwise                          = ""


Ok, for starters, it mentions on the first challenge:

Always operate on raw bytes, never on encoded strings. Only use hex and base64 for pretty-printing.

Since String is actually a list of encoded Chars, it would make more sense to migrate to an implementation that uses ByteString instead. This data structure is suited for handling raw data, like we will be doing here. There is also a very helpful parser library called attoparsec. It is a parser combinator library, similar to parsec, but specialized for ByteString. Using it to parse the input as a ByteString makes the most sense in this situation.

Parsing ByteStrings

A ByteString can be formed from [Word8] using pack, and it can also be broken apart again using unpack. Word8 is just an 8-bit unsigned integer, and interestingly, an 8-bit unsigned integer is also what is needed for holding the value a single hex-digit! This means that we can parse two Word8s from '0' to 'f' and get a single Word8 which holds the encoded number.

import Control.Applicative (liftA2, liftA3, many)
import Data.Attoparsec.ByteString.Char8
import qualified Data.ByteString as B
import           Data.ByteString (ByteString, pack, uncons)
import Data.Bits (shift)
import Data.Char (ord)
-- The strict version is suitable here
import Data.IntMap.Strict (IntMap, fromAscList, (!))
import Data.Word8

hexMap :: IntMap Word8
hexMap = fromAscList $ zip (map ord $ ['0'..'9'] ++ ['a'..'f']) [0..]

hex :: Parser Word8
hex = liftA2 mkWord8 hexChar hexChar
    hexChar :: Parser Word8
    hexChar = choice $ map char8 $ ['0'..'9'] ++ ['a'..'f']

    mkWord8 :: Word8 -> Word8 -> Word8
    mkWord8 a b =
          (hexMap ! fromIntegral a) `shift` 4
        + (hexMap ! fromIntegral b)

hexStr :: Parser ByteString
hexStr = fmap pack (many hex)  -- Parser is a Functor

parseHex :: ByteString -> Either String ByteString
parseHex = parseOnly hexStr

Let's take a look at how the hex parser is put together. First, look at the inner functions. mkWord8 takes two Word8 values and looks both of them up in hexMap. Then, it bit shifts the first result by four bits to the left and adds it to the second result. This means that if the first and second arguments to mkWord8 are "f2", then we will have 11110010 stored in the resulting Word8.

hexChar is a Parser that matches a single character in the range of ['0'..'9'] or ['a'..'f']. This works by mapping char8 :: Char -> Parser Word8 over the list of acceptable characters and then calling choice :: [Parser Word8] -> Parser Word8 to indicate that any of the generated parsers will work.

Now, it is easy to understand how hex works. It is a parser that takes two characters and calls mkWord8 on the results, assuming both characters match. To extend hex in order to allow for arbitrary numbers of hex-digits, we just need to utilize many :: Parser Word8 -> Parser [Word8], as in many hex. To actually use hex, we can utilize parseOnly which will run a parser and return either the results or a String containing an error message if it fails.

Converting bytes to Base64

We are halfway to a working solution now that we can parse an incoming hex string into a ByteString. To make it all the way, we need to convert the ByteString into Base64 and print it. This can be done by first converting to something that we are more familiar with, such as decimals, but it may be possible to convert more directly using a little math. Since we know that Base64 uses 6 bits (64 = 2^6) and Word8 uses 8 bits, we can conclude that both formats will line up every 24 bits. When this happens, we can convert 3 bytes into 4 Base64 characters. If there aren't 3 bytes left to use, we will have to utilize as much as we can before giving up.

-- These two functions pull 3 items or 2 items from the front of the ByteString,
-- respectively. (`uncons` pulls one off)

uncons3 :: ByteString -> Maybe ((Word8,Word8,Word8), ByteString)
uncons3 b = do -- We will use the Monad instance of Maybe by using `do`
    (w1,b1) <- uncons b
    (w2,b2) <- uncons b1
    (w3,b3) <- uncons b2
    Just ((w1,w2,w3), b3)

uncons2 :: ByteString -> Maybe ((Word8,Word8), ByteString)
uncons2 b = do
    (w1,b1) <- uncons b
    (w2,b2) <- uncons b1
    Just ((w1,w2), b2)


type Base64 = Char -- Might as well use good 'ol Strings again...

toBase64 :: ByteString -> [Base64] -- [Base64] is equivalent to String
toBase64 b =
    case uncons3 b of
        Just ((w1,w2,w3),b') -> from3Bytes w1 w2 w3 ++ toBase64 b' -- loop
        Nothing -> -- Less than 3 bytes left...
            case uncons2 b of
                Just ((w1,w2),b') -> from2Bytes w1 w2
                Nothing -> -- Less than 2 bytes left...
                    case uncons b of
                        Just (w,b') -> from1Byte w
                        Nothing -> [] -- No more data, so end the string

base64Map :: IntMap Base64
base64Map = undefined

-- Convert 3 Word8's to 4 Chars
from3Bytes :: Word8 -> Word8 -> Word8 -> [Base64]
from3Bytes = undefined

-- Convert 2 Word8's to 2 Chars (drop the remainder)
from2Bytes :: Word8 -> Word8 -> [Base64]
from2Bytes = undefined

-- Convert 1 Word8 to 1 Char (drop the remainder)
from1Byte :: Word8 -> [Base64]
from1Byte = undefined

I'll leave it up to you to finish up by filling in the undefined portions. Keep in mind that you can do bitwise manipulations with Data.Bits. Obviously you will need to break up the 8-bit ByteStrings into smaller chunks in order to reassemble them into 6-bit pieces, and have some mapping from these pieces to their Base64 character representation. I left the stub for base64Map as a reminder of one possible solution here.

There's a lot to digest here, but I think this will give you some other strategies to consider. Good luck and happy coding!


Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.