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