    {-# 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.Fingerprint (
            Fingerprint(..), fingerprint0,
            fingerprintData,
            fingerprintString,
            fingerprintFingerprints,
            getFileHash
       ) where

    import GHC.IO
    import GHC.Base
    import GHC.Num
    import GHC.List
    import GHC.Real
    import GHC.Show
    import Foreign
    import Foreign.C
    import System.IO

    import GHC.Fingerprint.Type

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

    -- XXX instance Storable Fingerprint
    -- defined in 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] -> Fingerprint
    forall a. [a] -> a
    head [Fingerprint]
    fs))

    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 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
                Int
    count <- Handle -> Ptr Word8 -> Int -> IO Int
    forall a. Handle -> Ptr a -> Int -> IO Int
    hGetBuf Handle
    h Ptr Word8
    arrPtr Int
    _BUFSIZE
                Bool
    eof <- Handle -> IO Bool
    hIsEOF Handle
    h
                Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    count Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    _BUFSIZE Bool -> Bool -> Bool
    && Bool -> Bool
    not Bool
    eof) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> IO ()
    forall a. String -> a
    errorWithoutStackTrace (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                  String
    "GHC.Fingerprint.getFileHash: only read " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    count String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " bytes"

                Ptr Word8 -> Int -> IO ()
    f Ptr Word8
    arrPtr Int
    count

                Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool -> Bool
    not Bool
    eof) IO ()
    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 ()