module Darcs.Util.ValidHash
( ValidHash(..)
, InventoryHash
, PatchHash
, PristineHash
, HashedDir(..)
, encodeValidHash
, decodeValidHash
, parseValidHash
, getHash
, getSize
, fromHash
, fromSizeAndHash
, checkHash
, okayHash
) 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
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)
class (Eq h, IsSizeHash h) => ValidHash h where
dirofValidHash :: h -> HashedDir
calcValidHash :: B.ByteString -> h
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
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
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
checkHash :: ValidHash h => h -> B.ByteString -> Bool
checkHash :: forall h. ValidHash h => h -> ByteString -> Bool
checkHash h
vh ByteString
content =
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
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)
class IsSizeHash h where
getSizeHash :: h -> SizeHash
fromSizeHash :: SizeHash -> h
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
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)