commit
800dba0e91
2 changed files with 56 additions and 0 deletions
@ -0,0 +1,55 @@ |
|||||
|
module HashTrees where |
||||
|
|
||||
|
import Data.Digest.Pure.SHA |
||||
|
import Data.List |
||||
|
import qualified Data.ByteString.Lazy as BL |
||||
|
import Control.Monad |
||||
|
import Data.List |
||||
|
import Data.Bits |
||||
|
|
||||
|
data HashTree k a = Leaf | HashTree (Digest k) (HashTree k a) (HashTree k a) deriving (Show) |
||||
|
|
||||
|
groupsOf _ ([]) = [] |
||||
|
groupsOf n xs = case splitAt n xs of |
||||
|
(a, as) -> a : (groupsOf n as) |
||||
|
|
||||
|
groupsOf2 xs = map (\(x:y:[]) -> (x,y)) $ groupsOf 2 xs |
||||
|
|
||||
|
hashCatInner (h1, h2) = sha1 $ BL.concat [(bytestringDigest h1), (bytestringDigest h2), BL.singleton 1] |
||||
|
|
||||
|
hashes = map sha1 |
||||
|
|
||||
|
singletonTrees xs = map (\x -> HashTree x Leaf Leaf) xs |
||||
|
|
||||
|
reduceHashes xs = map (\((HashTree x _ _), (HashTree y _ _)) -> HashTree (hashCatInner (x,y)) Leaf Leaf) (groupsOf2 xs) |
||||
|
|
||||
|
combineTrees (HashTree x _ _) (t1, t2) = HashTree x t1 t2 |
||||
|
|
||||
|
combineTreeLists lower upper = zipWith combineTrees upper (groupsOf2 lower) |
||||
|
|
||||
|
buildPreliminaryLevels ([x]) = [[x]] |
||||
|
buildPreliminaryLevels xs = xs : (buildPreliminaryLevels $ (reduceHashes xs)) |
||||
|
|
||||
|
buildTree' :: [HashTree k t] -> [[HashTree k t]] -> [HashTree k t] |
||||
|
buildTree' acc ([]) = acc |
||||
|
buildTree' acc (x:xs) = buildTree' (combineTreeLists acc x) xs |
||||
|
|
||||
|
buildTree = (\x -> buildTree' (head x) (tail x)) . buildPreliminaryLevels . singletonTrees . hashes . (map (\x -> BL.concat [x,BL.singleton 0])) . padHashes |
||||
|
|
||||
|
-- Padding functions |
||||
|
|
||||
|
nextPowerOf n = 2 ^ (ceiling $ logBase 2 $ fromIntegral n) |
||||
|
|
||||
|
padHashes xs = pad' 0 xs where |
||||
|
pad' n ([]) = [] ++ (take ((nextPowerOf n) - n) $ repeat BL.empty) |
||||
|
pad' n (x:xs) = x : (pad' (n +1) xs) |
||||
|
|
||||
|
main :: IO () |
||||
|
main = do |
||||
|
contents <- BL.readFile "Mover.hs" |
||||
|
contents2 <- BL.readFile "TooFull.hs" |
||||
|
contents3 <- BL.readFile "Candidates.hs" |
||||
|
contents4 <- BL.readFile "Helpers.hs" |
||||
|
let test = [contents, contents2, contents3, contents4, contents, contents, contents,contents] |
||||
|
print $ buildTree test |
||||
|
|
@ -0,0 +1 @@ |
|||||
|
This is not suitable for use in mission critical programs. May be security vulnerabilities and/or other bugs. Use at your own risk. |
Loading…
Reference in new issue