    {-# LANGUAGE CPP               #-}
    {-# LANGUAGE NoImplicitPrelude #-}
    {-# LANGUAGE Trustworthy       #-}

    -- ----------------------------------------------------------------------------
    --
    --  (c) The University of Glasgow 2006
    --
    -- Fingerprints for recompilation checking and ABI versioning, and
    -- implementing fast comparison of Typeable.
    --
    -- ----------------------------------------------------------------------------

    module GHC.Internal.Fingerprint (
            Fingerprint(..), fingerprint0,
            fingerprintData,
            fingerprintString,
            fingerprintFingerprints,
            getFileHash
       ) where

    import GHC.Internal.IO
    import GHC.Internal.Base
    import GHC.Internal.Bits
    import GHC.Internal.Num
    import GHC.Internal.List
    import GHC.Internal.Real
    import GHC.Internal.Word
    import GHC.Internal.Show
    import GHC.Internal.Ptr
    import GHC.Internal.Foreign.C.Types
    import GHC.Internal.Foreign.Marshal.Alloc
    import GHC.Internal.Foreign.Marshal.Array
    import GHC.Internal.Foreign.Storable
    import GHC.Internal.System.IO

    import GHC.Internal.Fingerprint.Type

    -- for SIZEOF_STRUCT_MD5CONTEXT:
    #include "HsBaseConfig.h"

    -- XXX instance Storable Fingerprint
    -- defined in GHC.Internal.Foreign.Storable to avoid orphan instance

    fingerprint0 :: Fingerprint
    fingerprint0 :: Fingerprint
    fingerprint0 = Word64 -> Word64 -> Fingerprint
    Fingerprint Word64
    0 Word64
    0

    fingerprintFingerprints :: [Fingerprint] -> Fingerprint
    fingerprintFingerprints :: [Fingerprint] -> Fingerprint
    fingerprintFingerprints [Fingerprint]
    fs = IO Fingerprint -> Fingerprint
    forall a. IO a -> a
    unsafeDupablePerformIO (IO Fingerprint -> Fingerprint) -> IO Fingerprint -> Fingerprint
    forall a b. (a -> b) -> a -> b
    $
      [Fingerprint]
    -> (Int -> Ptr Fingerprint -> IO Fingerprint) -> IO Fingerprint
    forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
    withArrayLen [Fingerprint]
    fs ((Int -> Ptr Fingerprint -> IO Fingerprint) -> IO Fingerprint)
    -> (Int -> Ptr Fingerprint -> IO Fingerprint) -> IO Fingerprint
    forall a b. (a -> b) -> a -> b
    $ \Int
    len Ptr Fingerprint
    p ->
        Ptr Word8 -> Int -> IO Fingerprint
    fingerprintData (Ptr Fingerprint -> Ptr Word8
    forall a b. Ptr a -> Ptr b
    castPtr Ptr Fingerprint
    p) (Int
    len Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Fingerprint -> Int
    forall a. Storable a => a -> Int
    sizeOf (Fingerprint
    forall a. HasCallStack => a
    undefined :: Fingerprint))

    fingerprintData :: Ptr Word8 -> Int -> IO Fingerprint
    fingerprintData :: Ptr Word8 -> Int -> IO Fingerprint
    fingerprintData Ptr Word8
    buf Int
    len =
      Int -> (Ptr MD5Context -> IO Fingerprint) -> IO Fingerprint
    forall a b. Int -> (Ptr a -> IO b) -> IO b
    allocaBytes SIZEOF_STRUCT_MD5CONTEXT $ \pctxt -> do
        c_MD5Init pctxt
        c_MD5Update pctxt buf (fromIntegral len)
        allocaBytes 16 $ \pdigest -> do
          c_MD5Final pdigest pctxt
          peek (castPtr pdigest :: Ptr Fingerprint)

    fingerprintString :: String -> Fingerprint
    fingerprintString :: String -> Fingerprint
    fingerprintString String
    str = IO Fingerprint -> Fingerprint
    forall a. IO a -> a
    unsafeDupablePerformIO (IO Fingerprint -> Fingerprint) -> IO Fingerprint -> Fingerprint
    forall a b. (a -> b) -> a -> b
    $
      [Word8] -> (Int -> Ptr Word8 -> IO Fingerprint) -> IO Fingerprint
    forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
    withArrayLen [Word8]
    word8s ((Int -> Ptr Word8 -> IO Fingerprint) -> IO Fingerprint)
    -> (Int -> Ptr Word8 -> IO Fingerprint) -> IO Fingerprint
    forall a b. (a -> b) -> a -> b
    $ \Int
    len Ptr Word8
    p ->
         Ptr Word8 -> Int -> IO Fingerprint
    fingerprintData Ptr Word8
    p Int
    len
        where word8s :: [Word8]
    word8s = (Char -> [Word8]) -> String -> [Word8]
    forall a b. (a -> [b]) -> [a] -> [b]
    concatMap Char -> [Word8]
    forall {a}. Num a => Char -> [a]
    f String
    str
              f :: Char -> [a]
    f Char
    c = let w32 :: Word32
                        w32 :: Word32
    w32 = Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Char -> Int
    ord Char
    c)
                    in [Word32 -> a
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32
    w32 Word32 -> Int -> Word32
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    24),
                        Word32 -> a
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32
    w32 Word32 -> Int -> Word32
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    16),
                        Word32 -> a
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32
    w32 Word32 -> Int -> Word32
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    8),
                        Word32 -> a
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word32
    w32]

    -- | Computes the hash of a given file.
    -- This function loops over the handle, running in constant memory.
    --
    -- @since base-4.7.0.0
    getFileHash :: FilePath -> IO Fingerprint
    getFileHash :: String -> IO Fingerprint
    getFileHash String
    path = String -> IOMode -> (Handle -> IO Fingerprint) -> IO Fingerprint
    forall r. String -> IOMode -> (Handle -> IO r) -> IO r
    withBinaryFile String
    path IOMode
    ReadMode ((Handle -> IO Fingerprint) -> IO Fingerprint)
    -> (Handle -> IO Fingerprint) -> IO Fingerprint
    forall a b. (a -> b) -> a -> b
    $ \Handle
    h ->
      Int -> (Ptr MD5Context -> IO Fingerprint) -> IO Fingerprint
    forall a b. Int -> (Ptr a -> IO b) -> IO b
    allocaBytes SIZEOF_STRUCT_MD5CONTEXT $ \pctxt -> do
        c_MD5Init pctxt

        processChunks h (\buf size -> c_MD5Update pctxt buf (fromIntegral size))

        allocaBytes 16 $ \pdigest -> do
          c_MD5Final pdigest pctxt
          peek (castPtr pdigest :: Ptr Fingerprint)

      where
        _BUFSIZE :: Int
    _BUFSIZE = Int
    4096

        -- Loop over _BUFSIZE sized chunks read from the handle,
        -- passing the callback a block of bytes and its size.
        processChunks :: Handle -> (Ptr Word8 -> Int -> IO ()) -> IO ()
        processChunks :: Handle -> (Ptr Word8 -> Int -> IO ()) -> IO ()
    processChunks Handle
    h Ptr Word8 -> Int -> IO ()
    f = Int -> (Ptr Word8 -> IO ()) -> IO ()
    forall a b. Int -> (Ptr a -> IO b) -> IO b
    allocaBytes Int
    _BUFSIZE ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Ptr Word8
    arrPtr ->

          let loop :: IO ()
    loop = do
                count <- Handle -> Ptr Word8 -> Int -> IO Int
    forall a. Handle -> Ptr a -> Int -> IO Int
    hGetBuf Handle
    h Ptr Word8
    arrPtr Int
    _BUFSIZE
                eof <- hIsEOF h
                when (count /= _BUFSIZE && not eof) $ errorWithoutStackTrace $
                  "GHC.Internal.Fingerprint.getFileHash: only read " ++ show count ++ " bytes"

                f arrPtr count

                when (not eof) loop

          in IO ()
    loop

    data MD5Context

    foreign import ccall unsafe "__hsbase_MD5Init"
       c_MD5Init   :: Ptr MD5Context -> IO ()
    foreign import ccall unsafe "__hsbase_MD5Update"
       c_MD5Update :: Ptr MD5Context -> Ptr Word8 -> CInt -> IO ()
    foreign import ccall unsafe "__hsbase_MD5Final"
       c_MD5Final  :: Ptr Word8 -> Ptr MD5Context -> IO ()