module Darcs.Util.ValidHash
    ( ValidHash(..)
    , InventoryHash
    , PatchHash
    , PristineHash
    , HashedDir(..)
    , encodeValidHash
    , decodeValidHash
    , parseValidHash
    , getHash
    , getSize
    , fromHash
    , fromSizeAndHash
    , checkHash
    , okayHash -- only used for garbage collection
    ) where

import qualified Data.ByteString as B
import Data.Maybe ( isJust )
import Text.Read ( readMaybe )

import Prelude ( (^) )
import Darcs.Prelude

import Darcs.Util.Hash ( Hash, decodeBase16, decodeHash, encodeHash, sha256strict )
import qualified Darcs.Util.Parser as P

-- | Semantically, this is the type of hashed objects. Git has a type tag
-- inside the hashed file itself, whereas in Darcs the type is determined
-- by the subdirectory.
data HashedDir
  = HashedPristineDir
  | HashedPatchesDir
  | HashedInventoriesDir
  deriving (HashedDir -> HashedDir -> Bool
(HashedDir -> HashedDir -> Bool)
-> (HashedDir -> HashedDir -> Bool) -> Eq HashedDir
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HashedDir -> HashedDir -> Bool
== :: HashedDir -> HashedDir -> Bool
$c/= :: HashedDir -> HashedDir -> Bool
/= :: HashedDir -> HashedDir -> Bool
Eq)

-- | External API for the various hash types.
class (Eq h, IsSizeHash h) => ValidHash h where
  -- | The 'HashedDir' belonging to this type of hash
  dirofValidHash :: h -> HashedDir
  -- | Compute hash from file content.
  calcValidHash :: B.ByteString -> h
  -- default definitions
  calcValidHash ByteString
content = Int -> Hash -> h
forall h. ValidHash h => Int -> Hash -> h
fromSizeAndHash (ByteString -> Int
B.length ByteString
content) (ByteString -> Hash
sha256strict ByteString
content)

newtype InventoryHash = InventoryHash SizeHash
  deriving (InventoryHash -> InventoryHash -> Bool
(InventoryHash -> InventoryHash -> Bool)
-> (InventoryHash -> InventoryHash -> Bool) -> Eq InventoryHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InventoryHash -> InventoryHash -> Bool
== :: InventoryHash -> InventoryHash -> Bool
$c/= :: InventoryHash -> InventoryHash -> Bool
/= :: InventoryHash -> InventoryHash -> Bool
Eq, Int -> InventoryHash -> ShowS
[InventoryHash] -> ShowS
InventoryHash -> String
(Int -> InventoryHash -> ShowS)
-> (InventoryHash -> String)
-> ([InventoryHash] -> ShowS)
-> Show InventoryHash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InventoryHash -> ShowS
showsPrec :: Int -> InventoryHash -> ShowS
$cshow :: InventoryHash -> String
show :: InventoryHash -> String
$cshowList :: [InventoryHash] -> ShowS
showList :: [InventoryHash] -> ShowS
Show, SizeHash -> InventoryHash
InventoryHash -> SizeHash
(InventoryHash -> SizeHash)
-> (SizeHash -> InventoryHash) -> IsSizeHash InventoryHash
forall h. (h -> SizeHash) -> (SizeHash -> h) -> IsSizeHash h
$cgetSizeHash :: InventoryHash -> SizeHash
getSizeHash :: InventoryHash -> SizeHash
$cfromSizeHash :: SizeHash -> InventoryHash
fromSizeHash :: SizeHash -> InventoryHash
IsSizeHash)

instance ValidHash InventoryHash where
  dirofValidHash :: InventoryHash -> HashedDir
dirofValidHash InventoryHash
_ = HashedDir
HashedInventoriesDir

newtype PatchHash = PatchHash SizeHash
  deriving (PatchHash -> PatchHash -> Bool
(PatchHash -> PatchHash -> Bool)
-> (PatchHash -> PatchHash -> Bool) -> Eq PatchHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PatchHash -> PatchHash -> Bool
== :: PatchHash -> PatchHash -> Bool
$c/= :: PatchHash -> PatchHash -> Bool
/= :: PatchHash -> PatchHash -> Bool
Eq, Int -> PatchHash -> ShowS
[PatchHash] -> ShowS
PatchHash -> String
(Int -> PatchHash -> ShowS)
-> (PatchHash -> String)
-> ([PatchHash] -> ShowS)
-> Show PatchHash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PatchHash -> ShowS
showsPrec :: Int -> PatchHash -> ShowS
$cshow :: PatchHash -> String
show :: PatchHash -> String
$cshowList :: [PatchHash] -> ShowS
showList :: [PatchHash] -> ShowS
Show, SizeHash -> PatchHash
PatchHash -> SizeHash
(PatchHash -> SizeHash)
-> (SizeHash -> PatchHash) -> IsSizeHash PatchHash
forall h. (h -> SizeHash) -> (SizeHash -> h) -> IsSizeHash h
$cgetSizeHash :: PatchHash -> SizeHash
getSizeHash :: PatchHash -> SizeHash
$cfromSizeHash :: SizeHash -> PatchHash
fromSizeHash :: SizeHash -> PatchHash
IsSizeHash)

instance ValidHash PatchHash where
  dirofValidHash :: PatchHash -> HashedDir
dirofValidHash PatchHash
_ = HashedDir
HashedPatchesDir

newtype PristineHash = PristineHash SizeHash
  deriving (PristineHash -> PristineHash -> Bool
(PristineHash -> PristineHash -> Bool)
-> (PristineHash -> PristineHash -> Bool) -> Eq PristineHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PristineHash -> PristineHash -> Bool
== :: PristineHash -> PristineHash -> Bool
$c/= :: PristineHash -> PristineHash -> Bool
/= :: PristineHash -> PristineHash -> Bool
Eq, Int -> PristineHash -> ShowS
[PristineHash] -> ShowS
PristineHash -> String
(Int -> PristineHash -> ShowS)
-> (PristineHash -> String)
-> ([PristineHash] -> ShowS)
-> Show PristineHash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PristineHash -> ShowS
showsPrec :: Int -> PristineHash -> ShowS
$cshow :: PristineHash -> String
show :: PristineHash -> String
$cshowList :: [PristineHash] -> ShowS
showList :: [PristineHash] -> ShowS
Show, SizeHash -> PristineHash
PristineHash -> SizeHash
(PristineHash -> SizeHash)
-> (SizeHash -> PristineHash) -> IsSizeHash PristineHash
forall h. (h -> SizeHash) -> (SizeHash -> h) -> IsSizeHash h
$cgetSizeHash :: PristineHash -> SizeHash
getSizeHash :: PristineHash -> SizeHash
$cfromSizeHash :: SizeHash -> PristineHash
fromSizeHash :: SizeHash -> PristineHash
IsSizeHash)

instance ValidHash PristineHash where
  dirofValidHash :: PristineHash -> HashedDir
dirofValidHash PristineHash
_ = HashedDir
HashedPristineDir
  -- note: not the default definition here
  calcValidHash :: ByteString -> PristineHash
calcValidHash = Hash -> PristineHash
forall h. ValidHash h => Hash -> h
fromHash (Hash -> PristineHash)
-> (ByteString -> Hash) -> ByteString -> PristineHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Hash
sha256strict

encodeValidHash :: ValidHash h => h -> String
encodeValidHash :: forall h. ValidHash h => h -> String
encodeValidHash = SizeHash -> String
encodeSizeHash (SizeHash -> String) -> (h -> SizeHash) -> h -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. h -> SizeHash
forall h. IsSizeHash h => h -> SizeHash
getSizeHash

decodeValidHash :: ValidHash h => String -> Maybe h
decodeValidHash :: forall h. ValidHash h => String -> Maybe h
decodeValidHash = (SizeHash -> h) -> Maybe SizeHash -> Maybe h
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SizeHash -> h
forall h. IsSizeHash h => SizeHash -> h
fromSizeHash (Maybe SizeHash -> Maybe h)
-> (String -> Maybe SizeHash) -> String -> Maybe h
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe SizeHash
decodeSizeHash

parseValidHash :: ValidHash h => P.Parser h
parseValidHash :: forall h. ValidHash h => Parser h
parseValidHash = SizeHash -> h
forall h. IsSizeHash h => SizeHash -> h
fromSizeHash (SizeHash -> h)
-> Parser ByteString SizeHash -> Parser ByteString h
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString SizeHash
parseSizeHash

getHash :: ValidHash h => h -> Hash
getHash :: forall h. ValidHash h => h -> Hash
getHash h
sh =
  case h -> SizeHash
forall h. IsSizeHash h => h -> SizeHash
getSizeHash h
sh of
    (NoSize Hash
h) -> Hash
h
    (WithSize Int
_ Hash
h) -> Hash
h

getSize :: ValidHash h => h -> Maybe Int
getSize :: forall h. ValidHash h => h -> Maybe Int
getSize h
sh =
  case h -> SizeHash
forall h. IsSizeHash h => h -> SizeHash
getSizeHash h
sh of
    (NoSize Hash
_) -> Maybe Int
forall a. Maybe a
Nothing
    (WithSize Int
s Hash
_) -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
s

fromHash :: ValidHash h => Hash -> h
fromHash :: forall h. ValidHash h => Hash -> h
fromHash Hash
h = SizeHash -> h
forall h. IsSizeHash h => SizeHash -> h
fromSizeHash (Hash -> SizeHash
NoSize Hash
h)

numSizeDigits :: Int
numSizeDigits :: Int
numSizeDigits = Int
10

sizeLimit :: Int
sizeLimit :: Int
sizeLimit = Int
10 Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
numSizeDigits

fromSizeAndHash :: ValidHash h => Int -> Hash -> h
fromSizeAndHash :: forall h. ValidHash h => Int -> Hash -> h
fromSizeAndHash Int
size Hash
hash =
  SizeHash -> h
forall h. IsSizeHash h => SizeHash -> h
fromSizeHash (SizeHash -> h) -> SizeHash -> h
forall a b. (a -> b) -> a -> b
$ if Int
size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sizeLimit then Int -> Hash -> SizeHash
WithSize Int
size Hash
hash else Hash -> SizeHash
NoSize Hash
hash

-- | Check that the given 'String' is an encoding of some 'ValidHash'.
okayHash :: String -> Bool
okayHash :: String -> Bool
okayHash = Maybe SizeHash -> Bool
forall a. Maybe a -> Bool
isJust (Maybe SizeHash -> Bool)
-> (String -> Maybe SizeHash) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe SizeHash
decodeSizeHash

-- | Verify file content against a given 'ValidHash'.
checkHash :: ValidHash h => h -> B.ByteString -> Bool
checkHash :: forall h. ValidHash h => h -> ByteString -> Bool
checkHash h
vh ByteString
content =
  -- It is tempting to simplify this to
  --   vh == calcValidHash content
  -- However, since we need to check old-style (sized) pristine hashes,
  -- this would require a non-standard Eq instance for SizeHash.
  case h -> SizeHash
forall h. IsSizeHash h => h -> SizeHash
getSizeHash h
vh of
    NoSize Hash
h -> Hash
h Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
hash
    WithSize Int
s Hash
h -> Int
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
size Bool -> Bool -> Bool
&& Hash
h Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
hash
  where
    hash :: Hash
hash = ByteString -> Hash
sha256strict ByteString
content
    size :: Int
size = ByteString -> Int
B.length ByteString
content

-- * Internal definitions, not exported

-- | Combined size and hash, where the size is optional.
-- The invariant for a valid @'WithSize' size _@ is that
--
-- > size >=0 and size < 'sizeLimit'
data SizeHash
  = WithSize !Int !Hash
  | NoSize !Hash
  deriving (SizeHash -> SizeHash -> Bool
(SizeHash -> SizeHash -> Bool)
-> (SizeHash -> SizeHash -> Bool) -> Eq SizeHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SizeHash -> SizeHash -> Bool
== :: SizeHash -> SizeHash -> Bool
$c/= :: SizeHash -> SizeHash -> Bool
/= :: SizeHash -> SizeHash -> Bool
Eq, Int -> SizeHash -> ShowS
[SizeHash] -> ShowS
SizeHash -> String
(Int -> SizeHash -> ShowS)
-> (SizeHash -> String) -> ([SizeHash] -> ShowS) -> Show SizeHash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SizeHash -> ShowS
showsPrec :: Int -> SizeHash -> ShowS
$cshow :: SizeHash -> String
show :: SizeHash -> String
$cshowList :: [SizeHash] -> ShowS
showList :: [SizeHash] -> ShowS
Show)

-- | Methods to wrap and unwrap 'ValidHash'es
class IsSizeHash h where
  getSizeHash :: h -> SizeHash
  fromSizeHash :: SizeHash -> h

-- This instance is only there so we can derive the instances above
instance IsSizeHash SizeHash where
  getSizeHash :: SizeHash -> SizeHash
getSizeHash = SizeHash -> SizeHash
forall a. a -> a
id
  fromSizeHash :: SizeHash -> SizeHash
fromSizeHash = SizeHash -> SizeHash
forall a. a -> a
id

{-
-- This non-standard Eq instance would allow us to implement 'checkHash'
-- using equality with a freshly calculated hash.
instance Eq SizeHash where
  NoSize h1 == NoSize h2 = h1 == h2
  WithSize s1 h1 == WithSize s2 h2 = s1 == s2 && h1 == h2
  NoSize h1 == WithSize _ h2 = h1 == h2
  WithSize _ h1 == NoSize h2 = h1 == h2
-}

encodeSizeHash :: SizeHash -> String
encodeSizeHash :: SizeHash -> String
encodeSizeHash (NoSize Hash
hash) = Hash -> String
encodeHash Hash
hash
encodeSizeHash (WithSize Int
size Hash
hash) =
    ShowS
padZero (Int -> String
forall a. Show a => a -> String
show Int
size) String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
'-' Char -> ShowS
forall a. a -> [a] -> [a]
: Hash -> String
encodeHash Hash
hash
  where padZero :: ShowS
padZero String
s = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
numSizeDigits Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) Char
'0' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

decodeSizeHash :: String -> Maybe SizeHash
decodeSizeHash :: String -> Maybe SizeHash
decodeSizeHash String
s =
  case Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
numSizeDigits String
s of
    (String
sizeStr, Char
'-':String
hashStr)
      | Just Int
size <- String -> Maybe Int
decodeSize String
sizeStr -> Int -> Hash -> SizeHash
WithSize Int
size (Hash -> SizeHash) -> Maybe Hash -> Maybe SizeHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Hash
decodeHash String
hashStr
    (String, String)
_ -> Hash -> SizeHash
NoSize (Hash -> SizeHash) -> Maybe Hash -> Maybe SizeHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Hash
decodeHash String
s
  where
    decodeSize :: String -> Maybe Int
    decodeSize :: String -> Maybe Int
decodeSize String
ss =
      case String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
ss of
        Just Int
size | Int
size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sizeLimit -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
size
        Maybe Int
_ -> Maybe Int
forall a. Maybe a
Nothing

parseSizeHash :: P.Parser SizeHash
parseSizeHash :: Parser ByteString SizeHash
parseSizeHash =
    (Int -> Hash -> SizeHash
WithSize (Int -> Hash -> SizeHash)
-> Parser ByteString Int -> Parser ByteString (Hash -> SizeHash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int
pSize Parser ByteString (Hash -> SizeHash)
-> Parser ByteString Hash -> Parser ByteString SizeHash
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Hash
pNoSize) Parser ByteString SizeHash
-> Parser ByteString SizeHash -> Parser ByteString SizeHash
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
P.<|> (Hash -> SizeHash
NoSize (Hash -> SizeHash)
-> Parser ByteString Hash -> Parser ByteString SizeHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Hash
pNoSize)
  where
    pSize :: Parser ByteString Int
pSize = do
      Parser ByteString () -> Parser ByteString ()
forall i a. Parser i a -> Parser i a
P.lookAhead (Int -> Parser ByteString
P.take Int
numSizeDigits Parser ByteString -> Parser ByteString () -> Parser ByteString ()
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> Parser ByteString ()
P.char Char
'-')
      Parser ByteString Int
forall a. Integral a => Parser a
P.unsigned Parser ByteString Int
-> Parser ByteString () -> Parser ByteString Int
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString ()
P.char Char
'-'
    pNoSize :: Parser ByteString Hash
pNoSize = do
      ByteString
x <- Int -> Parser ByteString
P.take Int
64
      Parser ByteString Hash
-> (Hash -> Parser ByteString Hash)
-> Maybe Hash
-> Parser ByteString Hash
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser ByteString Hash
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expecting b16-encoded sha256 hash") Hash -> Parser ByteString Hash
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Maybe Hash
decodeBase16 ByteString
x)