-- |
-- 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
(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

-- | Compute a fingerprint for a bytestring.
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

-- | 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 <- 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