1module Distribution.Utils.MD5 ( 2 MD5, 3 showMD5, 4 md5, 5 -- * Helpers 6 md5FromInteger, 7 -- * Binary 8 binaryPutMD5, 9 binaryGetMD5, 10 ) where 11 12import Data.Binary (Get, Put) 13import Data.Binary.Get (getWord64le) 14import Data.Binary.Put (putWord64le) 15import Data.Bits (complement, shiftR, (.&.)) 16import Foreign.Ptr (castPtr) 17import GHC.Fingerprint (Fingerprint (..), fingerprintData) 18import Numeric (showHex) 19import System.IO.Unsafe (unsafeDupablePerformIO) 20 21import qualified Data.ByteString as BS 22import qualified Data.ByteString.Unsafe as BS 23 24type MD5 = Fingerprint 25 26-- | Show 'MD5' in human readable form 27-- 28-- >>> showMD5 (Fingerprint 123 456) 29-- "000000000000007b00000000000001c8" 30-- 31-- >>> showMD5 $ md5 $ BS.pack [0..127] 32-- "37eff01866ba3f538421b30b7cbefcac" 33-- 34-- @since 3.2.0.0 35showMD5 :: MD5 -> String 36showMD5 (Fingerprint a b) = pad a' ++ pad b' where 37 a' = showHex a "" 38 b' = showHex b "" 39 pad s = replicate (16 - length s) '0' ++ s 40 41-- | @since 3.2.0.0 42md5 :: BS.ByteString -> MD5 43md5 bs = unsafeDupablePerformIO $ BS.unsafeUseAsCStringLen bs $ \(ptr, len) -> 44 fingerprintData (castPtr ptr) len 45 46-- | @since 3.2.0.0 47binaryPutMD5 :: MD5 -> Put 48binaryPutMD5 (Fingerprint a b) = do 49 putWord64le a 50 putWord64le b 51 52-- | @since 3.2.0.0 53binaryGetMD5 :: Get MD5 54binaryGetMD5 = do 55 a <- getWord64le 56 b <- getWord64le 57 return (Fingerprint a b) 58 59-- | 60-- 61-- >>> showMD5 $ md5FromInteger 0x37eff01866ba3f538421b30b7cbefcac 62-- "37eff01866ba3f538421b30b7cbefcac" 63-- 64-- Note: the input is truncated: 65-- 66-- >>> showMD5 $ md5FromInteger 0x1230000037eff01866ba3f538421b30b7cbefcac 67-- "37eff01866ba3f538421b30b7cbefcac" 68-- 69-- Yet, negative numbers are not a problem... 70-- 71-- >>> showMD5 $ md5FromInteger (-1) 72-- "ffffffffffffffffffffffffffffffff" 73-- 74-- @since 3.4.0.0 75md5FromInteger :: Integer -> MD5 76md5FromInteger i = Fingerprint hi lo where 77 mask = complement 0 78 lo = mask .&. fromInteger i 79 hi = mask .&. fromInteger (i `shiftR` 64) 80