From 800dba0e9113b56ab4c427868932843fa3067b5d Mon Sep 17 00:00:00 2001
From: wes <wjak56@gmail.com>
Date: Sun, 8 Jul 2012 05:36:15 -0400
Subject: [PATCH] first commit

---
 HashTrees.hs | 55 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 README       |  1 +
 2 files changed, 56 insertions(+)
 create mode 100644 HashTrees.hs
 create mode 100644 README

diff --git a/HashTrees.hs b/HashTrees.hs
new file mode 100644
index 0000000..1c7a7fd
--- /dev/null
+++ b/HashTrees.hs
@@ -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
+  
\ No newline at end of file
diff --git a/README b/README
new file mode 100644
index 0000000..abd92af
--- /dev/null
+++ b/README
@@ -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.