Add Haddock `/Since: 4.7.0.0/` comments to new symbols
[packages/base.git] / GHC / Fingerprint.hs
1 {-# LANGUAGE Trustworthy #-}
2 {-# LANGUAGE NoImplicitPrelude
3 , BangPatterns
4 , ForeignFunctionInterface
5 , EmptyDataDecls
6 #-}
7
8 -- ----------------------------------------------------------------------------
9 --
10 -- (c) The University of Glasgow 2006
11 --
12 -- Fingerprints for recompilation checking and ABI versioning, and
13 -- implementing fast comparison of Typeable.
14 --
15 -- ----------------------------------------------------------------------------
16
17 module GHC.Fingerprint (
18 Fingerprint(..), fingerprint0,
19 fingerprintData,
20 fingerprintString,
21 fingerprintFingerprints,
22 getFileHash
23 ) where
24
25 import GHC.IO
26 import GHC.Base
27 import GHC.Num
28 import GHC.List
29 import GHC.Real
30 import GHC.Show
31 import Foreign
32 import Foreign.C
33 import System.IO
34 import Control.Monad (when)
35
36 import GHC.Fingerprint.Type
37
38 -- for SIZEOF_STRUCT_MD5CONTEXT:
39 #include "HsBaseConfig.h"
40
41 -- XXX instance Storable Fingerprint
42 -- defined in Foreign.Storable to avoid orphan instance
43
44 fingerprint0 :: Fingerprint
45 fingerprint0 = Fingerprint 0 0
46
47 fingerprintFingerprints :: [Fingerprint] -> Fingerprint
48 fingerprintFingerprints fs = unsafeDupablePerformIO $
49 withArrayLen fs $ \len p -> do
50 fingerprintData (castPtr p) (len * sizeOf (head fs))
51
52 fingerprintData :: Ptr Word8 -> Int -> IO Fingerprint
53 fingerprintData buf len = do
54 allocaBytes SIZEOF_STRUCT_MD5CONTEXT $ \pctxt -> do
55 c_MD5Init pctxt
56 c_MD5Update pctxt buf (fromIntegral len)
57 allocaBytes 16 $ \pdigest -> do
58 c_MD5Final pdigest pctxt
59 peek (castPtr pdigest :: Ptr Fingerprint)
60
61 -- This is duplicated in compiler/utils/Fingerprint.hsc
62 fingerprintString :: String -> Fingerprint
63 fingerprintString str = unsafeDupablePerformIO $
64 withArrayLen word8s $ \len p ->
65 fingerprintData p len
66 where word8s = concatMap f str
67 f c = let w32 :: Word32
68 w32 = fromIntegral (ord c)
69 in [fromIntegral (w32 `shiftR` 24),
70 fromIntegral (w32 `shiftR` 16),
71 fromIntegral (w32 `shiftR` 8),
72 fromIntegral w32]
73
74 -- | Computes the hash of a given file.
75 -- This function loops over the handle, running in constant memory.
76 --
77 -- /Since: 4.7.0.0/
78 getFileHash :: FilePath -> IO Fingerprint
79 getFileHash path = withBinaryFile path ReadMode $ \h -> do
80 allocaBytes SIZEOF_STRUCT_MD5CONTEXT $ \pctxt -> do
81 c_MD5Init pctxt
82
83 processChunks h (\buf size -> c_MD5Update pctxt buf (fromIntegral size))
84
85 allocaBytes 16 $ \pdigest -> do
86 c_MD5Final pdigest pctxt
87 peek (castPtr pdigest :: Ptr Fingerprint)
88
89 where
90 _BUFSIZE = 4096
91
92 -- | Loop over _BUFSIZE sized chunks read from the handle,
93 -- passing the callback a block of bytes and its size.
94 processChunks :: Handle -> (Ptr Word8 -> Int -> IO ()) -> IO ()
95 processChunks h f = allocaBytes _BUFSIZE $ \arrPtr ->
96
97 let loop = do
98 count <- hGetBuf h arrPtr _BUFSIZE
99 eof <- hIsEOF h
100 when (count /= _BUFSIZE && not eof) $ error $
101 "GHC.Fingerprint.getFileHash: only read " ++ show count ++ " bytes"
102
103 f arrPtr count
104
105 when (not eof) loop
106
107 in loop
108
109 data MD5Context
110
111 foreign import ccall unsafe "__hsbase_MD5Init"
112 c_MD5Init :: Ptr MD5Context -> IO ()
113 foreign import ccall unsafe "__hsbase_MD5Update"
114 c_MD5Update :: Ptr MD5Context -> Ptr Word8 -> CInt -> IO ()
115 foreign import ccall unsafe "__hsbase_MD5Final"
116 c_MD5Final :: Ptr Word8 -> Ptr MD5Context -> IO ()