[Haskell-cafe] String to Word64 Conversion

Dominic Steinitz dominic.steinitz at blueyonder.co.uk
Mon Apr 2 12:57:41 EDT 2007


> [Haskell-cafe] String to Word64 Conversion
> Ian Sefferman iseff at iseff.com
>  Sun Apr 1 15:42:07 EDT 2007
> Previous message: [Haskell-cafe] Josephus problem and style
> Next message: [Haskell-cafe] Data.ByteStream.Char8.words performance
> Messages sorted by: [ date ] [ thread ] [ subject ] [ author ]
> I've been spending a lot of time trying to find a clean way to convert
> from a String to a Word64 for the Crypto library.
>
> Specifically, we're trying to encrypt the strings with Blowfish. The
> type for the encrypt function is:
>
> encrypt :: (Integral a) => a -> Word64 -> Word64
>
> I assume I would want something like:
> toWord64s :: String -> [Word64]
> toWord64s = ....
>
> myEncrypt string = map (Blowfish.encrypt myKey) (toWord64s string)
>
> I would have to imagine that encrypting strings is a fairly common
> thing to do, so a conversion should be trivial, but I can't seem to
> find anything on it. I feel like I must be missing something rather
> obvious here. Am I?
>
> Thanks,
> Ian

Ian,

Maybe something like this. I've pretty much taken it from 
http://darcs.haskell.org/crypto/Data/Digest/SHA1.hs.

fromBytes :: (Bits a) => [a] -> a
fromBytes input =
    let dofb accum [] = accum
        dofb accum (x:xs) = dofb ((shiftL accum 8) .|. x) xs
        in
        dofb 0 input

blockWord8sIn64 :: [Word8] -> [[Word8]]
blockWord8sIn64 =
   unfoldr g
   where
      g [] = Nothing
      g xs = Just (splitAt 8 xs)

getWord64s :: [Word8] -> [Word64]
getWord64s =
   map fromBytes . map (map fromIntegral) .  blockWord8sIn64

Don't forget you will need to pad 
http://www.haskell.org/crypto/doc/html/Codec.Encryption.Padding.html. I don't 
know what your application is but I suggest NOT using ECB mode which your 
code suggests you are thinking of doing. The only mode currently supported in 
the crypto library is CBC but other modes should be trivial to add.

Dominic.



More information about the Haskell-Cafe mailing list