-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Digest.MD5
-- Copyright   :  (c) Dominic Steinitz 2004
-- License     :  BSD-style (see the file ReadMe.tex)
--
-- Stability   :  experimental
-- Portability :  portable
--
-- Takes the MD5 module supplied by Ian Lynagh and wraps it so it
-- takes [Octet] and returns [Octet] where the length of the result
-- is always 16.
-- See <http://web.comlab.ox.ac.uk/oucl/work/ian.lynagh/>
-- and <http://www.ietf.org/rfc/rfc1321.txt>.
--
-----------------------------------------------------------------------------

module Data.Digest.MD5 (
   -- * Function Types
   hash) where

import Data.Digest.MD5Aux
import Codec.Utils
import Data.Char(chr)
import Data.List(unfoldr)
import Numeric(readHex)

-- | Take [Octet] and return [Octet] according to the standard.
--   The length of the result is always 16 octets or 128 bits as required
--   by the standard.

hash :: [Octet] -> [Octet]
hash :: [Octet] -> [Octet]
hash [Octet]
xs =
   forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr String -> Maybe (Octet, String)
f forall a b. (a -> b) -> a -> b
$ forall a. MD5 a => a -> String
md5s forall a b. (a -> b) -> a -> b
$ String -> Str
Str forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
chr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) [Octet]
xs
      where f :: String -> Maybe (Octet,String)
            f :: String -> Maybe (Octet, String)
f [] =
               forall a. Maybe a
Nothing
            f (Char
x:Char
y:String
zs) =
               forall a. a -> Maybe a
Just (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
a,String
zs)
               where [(Integer
a,String
_)] = forall a. (Eq a, Num a) => ReadS a
readHex (Char
xforall a. a -> [a] -> [a]
:Char
yforall a. a -> [a] -> [a]
:[])