-- |
-- Module      :  Cryptol.ModuleSystem.Fingerprint
-- Copyright   :  (c) 2019 Galois, Inc.
-- License     :  BSD3
-- Maintainer  :  cryptol@galois.com
-- Stability   :  provisional
-- Portability :  portable

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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Fingerprint -> Fingerprint -> Bool
$c/= :: Fingerprint -> Fingerprint -> Bool
== :: Fingerprint -> Fingerprint -> Bool
$c== :: Fingerprint -> Fingerprint -> Bool
Eq, Int -> Fingerprint -> ShowS
[Fingerprint] -> ShowS
Fingerprint -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Fingerprint] -> ShowS
$cshowList :: [Fingerprint] -> ShowS
show :: Fingerprint -> String
$cshow :: Fingerprint -> String
showsPrec :: Int -> Fingerprint -> ShowS
$cshowsPrec :: Int -> Fingerprint -> ShowS
Show)

instance NFData Fingerprint where
  rnf :: Fingerprint -> ()
rnf (Fingerprint ByteString
fp) = forall a. NFData a => a -> ()
rnf ByteString
fp

-- | Compute a fingerprint for a bytestring.
fingerprint :: ByteString -> Fingerprint
fingerprint :: ByteString -> Fingerprint
fingerprint = ByteString -> Fingerprint
Fingerprint forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
hash

-- | Attempt to compute the fingerprint of the file at the given path.
-- Returns 'Nothing' in the case of an error.
fingerprintFile :: FilePath -> IO (Maybe Fingerprint)
fingerprintFile :: String -> IO (Maybe Fingerprint)
fingerprintFile String
path =
  do Either IOError ByteString
res <- forall e a. Exception e => IO a -> IO (Either e a)
try (String -> IO ByteString
B.readFile String
path)
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$!
       case Either IOError ByteString
res :: Either IOError ByteString of
         Left{}  -> forall a. Maybe a
Nothing
         Right ByteString
b -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! ByteString -> Fingerprint
fingerprint ByteString
b

fingerprintHexString :: Fingerprint -> String
fingerprintHexString :: Fingerprint -> String
fingerprintHexString (Fingerprint ByteString
bs) = forall a. (Word8 -> a -> a) -> a -> ByteString -> a
B.foldr forall {a}. Integral a => a -> ShowS
hex String
"" ByteString
bs
  where
  digits :: Vector Char
digits   = forall a. [a] -> Vector a
Vector.fromList String
"0123456789ABCDEF"
  digit :: a -> Char
digit a
x  = Vector Char
digits forall a. Vector a -> Int -> a
Vector.! 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) = forall a. Integral a => a -> a -> (a, a)
divMod a
b a
16
             in forall {a}. Integral a => a -> Char
digit a
x forall a. a -> [a] -> [a]
: forall {a}. Integral a => a -> Char
digit a
y forall a. a -> [a] -> [a]
: String
cs