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 :: MD5 -> String
showMD5 (Fingerprint Word64
a Word64
b) = String -> String
pad String
a' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
pad String
b'
  where
    a' :: String
a' = Word64 -> String -> String
forall a. Integral a => a -> String -> String
showHex Word64
a String
""
    b' :: String
b' = Word64 -> String -> String
forall a. Integral a => a -> String -> String
showHex Word64
b String
""
    pad :: String -> String
pad String
s = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) Char
'0' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s

-- | @since  3.2.0.0
md5 :: BS.ByteString -> MD5
md5 :: ByteString -> MD5
md5 ByteString
bs = IO MD5 -> MD5
forall a. IO a -> a
unsafeDupablePerformIO (IO MD5 -> MD5) -> IO MD5 -> MD5
forall a b. (a -> b) -> a -> b
$ ByteString -> (CStringLen -> IO MD5) -> IO MD5
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen ByteString
bs ((CStringLen -> IO MD5) -> IO MD5)
-> (CStringLen -> IO MD5) -> IO MD5
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
ptr, Int
len) ->
  Ptr Word8 -> Int -> IO MD5
fingerprintData (Ptr CChar -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
ptr) Int
len

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

-- | @since  3.2.0.0
binaryGetMD5 :: Get MD5
binaryGetMD5 :: Get MD5
binaryGetMD5 = do
  a <- Get Word64
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 :: Integer -> MD5
md5FromInteger Integer
i = Word64 -> Word64 -> MD5
Fingerprint Word64
hi Word64
lo
  where
    mask :: Word64
mask = Word64 -> Word64
forall a. Bits a => a -> a
complement Word64
0
    lo :: Word64
lo = Word64
mask Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Integer -> Word64
forall a. Num a => Integer -> a
fromInteger Integer
i
    hi :: Word64
hi = Word64
mask Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Integer -> Word64
forall a. Num a => Integer -> a
fromInteger (Integer
i Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
64)