module Cryptol.ModuleSystem.Fingerprint
( Fingerprint
, fingerprint
, fingerprintFile
, fingerprintHexString
) where
import Control.DeepSeq (NFData (rnf))
import Crypto.Hash.SHA1 (hash)
import Data.ByteString (ByteString)
import Control.Exception (try)
import qualified Data.ByteString as B
import qualified Data.Vector as Vector
newtype Fingerprint = Fingerprint ByteString
deriving (Fingerprint -> Fingerprint -> Bool
(Fingerprint -> Fingerprint -> Bool)
-> (Fingerprint -> Fingerprint -> Bool) -> Eq Fingerprint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Fingerprint -> Fingerprint -> Bool
== :: Fingerprint -> Fingerprint -> Bool
$c/= :: Fingerprint -> Fingerprint -> Bool
/= :: Fingerprint -> Fingerprint -> Bool
Eq, Int -> Fingerprint -> ShowS
[Fingerprint] -> ShowS
Fingerprint -> String
(Int -> Fingerprint -> ShowS)
-> (Fingerprint -> String)
-> ([Fingerprint] -> ShowS)
-> Show Fingerprint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Fingerprint -> ShowS
showsPrec :: Int -> Fingerprint -> ShowS
$cshow :: Fingerprint -> String
show :: Fingerprint -> String
$cshowList :: [Fingerprint] -> ShowS
showList :: [Fingerprint] -> ShowS
Show)
instance NFData Fingerprint where
rnf :: Fingerprint -> ()
rnf (Fingerprint ByteString
fp) = ByteString -> ()
forall a. NFData a => a -> ()
rnf ByteString
fp
fingerprint :: ByteString -> Fingerprint
fingerprint :: ByteString -> Fingerprint
fingerprint = ByteString -> Fingerprint
Fingerprint (ByteString -> Fingerprint)
-> (ByteString -> ByteString) -> ByteString -> Fingerprint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
hash
fingerprintFile :: FilePath -> IO (Maybe Fingerprint)
fingerprintFile :: String -> IO (Maybe Fingerprint)
fingerprintFile String
path =
do Either IOError ByteString
res <- IO ByteString -> IO (Either IOError ByteString)
forall e a. Exception e => IO a -> IO (Either e a)
try (String -> IO ByteString
B.readFile String
path)
Maybe Fingerprint -> IO (Maybe Fingerprint)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Fingerprint -> IO (Maybe Fingerprint))
-> Maybe Fingerprint -> IO (Maybe Fingerprint)
forall a b. (a -> b) -> a -> b
$!
case Either IOError ByteString
res :: Either IOError ByteString of
Left{} -> Maybe Fingerprint
forall a. Maybe a
Nothing
Right ByteString
b -> Fingerprint -> Maybe Fingerprint
forall a. a -> Maybe a
Just (Fingerprint -> Maybe Fingerprint)
-> Fingerprint -> Maybe Fingerprint
forall a b. (a -> b) -> a -> b
$! ByteString -> Fingerprint
fingerprint ByteString
b
fingerprintHexString :: Fingerprint -> String
fingerprintHexString :: Fingerprint -> String
fingerprintHexString (Fingerprint ByteString
bs) = (Word8 -> ShowS) -> String -> ByteString -> String
forall a. (Word8 -> a -> a) -> a -> ByteString -> a
B.foldr Word8 -> ShowS
forall {a}. Integral a => a -> ShowS
hex String
"" ByteString
bs
where
digits :: Vector Char
digits = String -> Vector Char
forall a. [a] -> Vector a
Vector.fromList String
"0123456789ABCDEF"
digit :: a -> Char
digit a
x = Vector Char
digits Vector Char -> Int -> Char
forall a. Vector a -> Int -> a
Vector.! a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x
hex :: a -> ShowS
hex a
b String
cs = let (a
x,a
y) = a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
divMod a
b a
16
in a -> Char
forall {a}. Integral a => a -> Char
digit a
x Char -> ShowS
forall a. a -> [a] -> [a]
: a -> Char
forall {a}. Integral a => a -> Char
digit a
y Char -> ShowS
forall a. a -> [a] -> [a]
: String
cs