MD5.hs

module Distribution.Utils.MD5
  ( MD5
  , showMD5
  , md5

    -- * Helpers
  , md5FromInteger

    -- * Binary
  , binaryPutMD5
  , binaryGetMD5
  ) where

import Data.Binary (Get, Put)
import Data.Binary.Get (getWord64le)
import Data.Binary.Put (putWord64le)
import Data.Bits (complement, shiftR, (.&.))
import Foreign.Ptr (castPtr)
import GHC.Fingerprint (Fingerprint (..), fingerprintData)
import Numeric (showHex)
import System.IO.Unsafe (unsafeDupablePerformIO)

import qualified Data.ByteString as BS
import qualified Data.ByteString.Unsafe as BS

type MD5 = Fingerprint

-- | Show 'MD5' in human readable form
--
-- >>> showMD5 (Fingerprint 123 456)
-- "000000000000007b00000000000001c8"
--
-- >>> showMD5 $ md5 $ BS.pack [0..127]
-- "37eff01866ba3f538421b30b7cbefcac"
--
-- @since  3.2.0.0
showMD5 :: MD5 -> String
showMD5 (Fingerprint a b) = pad a' ++ pad b'
  where
    a' = showHex a ""
    b' = showHex b ""
    pad s = replicate (16 - length s) '0' ++ s

-- | @since  3.2.0.0
md5 :: BS.ByteString -> MD5
md5 bs = unsafeDupablePerformIO $ BS.unsafeUseAsCStringLen bs $ \(ptr, len) ->
  fingerprintData (castPtr ptr) len

-- | @since  3.2.0.0
binaryPutMD5 :: MD5 -> Put
binaryPutMD5 (Fingerprint a b) = do
  putWord64le a
  putWord64le b

-- | @since  3.2.0.0
binaryGetMD5 :: Get MD5
binaryGetMD5 = do
  a <- getWord64le
  b <- getWord64le
  return (Fingerprint a b)

-- |
--
-- >>> showMD5 $ md5FromInteger 0x37eff01866ba3f538421b30b7cbefcac
-- "37eff01866ba3f538421b30b7cbefcac"
--
-- Note: the input is truncated:
--
-- >>> showMD5 $ md5FromInteger 0x1230000037eff01866ba3f538421b30b7cbefcac
-- "37eff01866ba3f538421b30b7cbefcac"
--
-- Yet, negative numbers are not a problem...
--
-- >>> showMD5 $ md5FromInteger (-1)
-- "ffffffffffffffffffffffffffffffff"
--
-- @since 3.4.0.0
md5FromInteger :: Integer -> MD5
md5FromInteger i = Fingerprint hi lo
  where
    mask = complement 0
    lo = mask .&. fromInteger i
    hi = mask .&. fromInteger (i `shiftR` 64)