{-# LANGUAGE CPP #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE Trustworthy #-}
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
#include "HsBaseConfig.h"
fingerprint0 :: Fingerprint
fingerprint0 :: Fingerprint
fingerprint0 = Word64 -> Word64 -> Fingerprint
Fingerprint Word64
0 Word64
0
fingerprintFingerprints :: [Fingerprint] -> Fingerprint
fingerprintFingerprints :: [Fingerprint] -> Fingerprint
fingerprintFingerprints [Fingerprint]
fs = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen [Fingerprint]
fs forall a b. (a -> b) -> a -> b
$ \Int
len Ptr Fingerprint
p ->
Ptr Word8 -> Int -> IO Fingerprint
fingerprintData (forall a b. Ptr a -> Ptr b
castPtr Ptr Fingerprint
p) (Int
len forall a. Num a => a -> a -> a
* forall a. Storable a => a -> Int
sizeOf (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 =
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 = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen [Word8]
word8s 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 = forall a b. (a -> [b]) -> [a] -> [b]
concatMap forall {a}. Num a => Char -> [a]
f String
str
f :: Char -> [a]
f Char
c = let w32 :: Word32
w32 :: Word32
w32 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
c)
in [forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
w32 forall a. Bits a => a -> Int -> a
`shiftR` Int
24),
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
w32 forall a. Bits a => a -> Int -> a
`shiftR` Int
16),
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
w32 forall a. Bits a => a -> Int -> a
`shiftR` Int
8),
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w32]
getFileHash :: FilePath -> IO Fingerprint
getFileHash :: String -> IO Fingerprint
getFileHash String
path = forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
path IOMode
ReadMode forall a b. (a -> b) -> a -> b
$ \Handle
h ->
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
processChunks :: Handle -> (Ptr Word8 -> Int -> IO ()) -> IO ()
processChunks :: Handle -> (Ptr Word8 -> Int -> IO ()) -> IO ()
processChunks Handle
h Ptr Word8 -> Int -> IO ()
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
_BUFSIZE forall a b. (a -> b) -> a -> b
$ \Ptr Word8
arrPtr ->
let loop :: IO ()
loop = do
Int
count <- forall a. Handle -> Ptr a -> Int -> IO Int
hGetBuf Handle
h Ptr Word8
arrPtr Int
_BUFSIZE
Bool
eof <- Handle -> IO Bool
hIsEOF Handle
h
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
count forall a. Eq a => a -> a -> Bool
/= Int
_BUFSIZE Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
eof) forall a b. (a -> b) -> a -> b
$ forall a. String -> a
errorWithoutStackTrace forall a b. (a -> b) -> a -> b
$
String
"GHC.Fingerprint.getFileHash: only read " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
count forall a. [a] -> [a] -> [a]
++ String
" bytes"
Ptr Word8 -> Int -> IO ()
f Ptr Word8
arrPtr Int
count
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 ()