this repo has no description
Initial commit
+107
+23
.gitignore
+23
.gitignore
···
1
+
dist
2
+
dist-*
3
+
cabal-dev
4
+
*.o
5
+
*.hi
6
+
*.hie
7
+
*.chi
8
+
*.chs.h
9
+
*.dyn_o
10
+
*.dyn_hi
11
+
.hpc
12
+
.hsenv
13
+
.cabal-sandbox/
14
+
cabal.sandbox.config
15
+
*.prof
16
+
*.aux
17
+
*.hp
18
+
*.eventlog
19
+
.stack-work/
20
+
cabal.project.local
21
+
cabal.project.local~
22
+
.HTF/
23
+
.ghc.environment.*
+5
CHANGELOG.md
+5
CHANGELOG.md
+44
app/Main.hs
+44
app/Main.hs
···
1
+
module Main where
2
+
3
+
import Data.Bifunctor (Bifunctor (bimap))
4
+
import Data.Bits (Bits (shiftR), (.|.))
5
+
import Data.Foldable (Foldable (foldr'), foldl')
6
+
import Data.Hashable (Hashable, hash)
7
+
import qualified Data.List.NonEmpty as NE
8
+
9
+
type Hash = Int
10
+
11
+
-- this can be also rep as a Map<a, Hash>
12
+
data Merkle a = Merkle Hash a deriving (Show)
13
+
14
+
unHash :: Merkle a -> Hash
15
+
unHash (Merkle h _) = h
16
+
17
+
def :: Monoid a => [a] -> a
18
+
def = mempty
19
+
20
+
nextHighestPowerOfTwoSmallerThan :: (Num a, Bits a) => a -> a
21
+
nextHighestPowerOfTwoSmallerThan n = (1 + foldl' go (n -1) [1, 2, 4, 8, 16, 32]) `shiftR` 1
22
+
where
23
+
go m i = m .|. m `shiftR` i
24
+
25
+
merkleTreeHash :: (Hashable a, Monoid a) => [a] -> NE.NonEmpty (Merkle a)
26
+
merkleTreeHash xs@[] = return $ Merkle (hash $ def xs) mempty
27
+
merkleTreeHash [x] = return $ Merkle (hash x) x
28
+
merkleTreeHash xs =
29
+
let k = nextHighestPowerOfTwoSmallerThan $ length xs
30
+
(left, right) = bimap merkleTreeHash merkleTreeHash $ splitAt k xs
31
+
in left <> right
32
+
33
+
getMerkle :: (Hashable a, Monoid a, Eq a) => a -> [a] -> Maybe (Merkle a)
34
+
getMerkle x = fmap NE.head . NE.nonEmpty . NE.dropWhile (\(Merkle _ a) -> a /= x) . merkleTreeHash
35
+
36
+
getHash :: (Hashable a, Monoid a, Eq a) => a -> [a] -> Maybe Hash
37
+
getHash x xs = unHash <$> getMerkle x xs
38
+
39
+
auditPath :: (Hashable a) => Int -> [a] -> Maybe [Hash]
40
+
auditPath x xs | x > length xs = Nothing
41
+
auditPath x xs = error "todo"
42
+
43
+
main :: IO ()
44
+
main = putStrLn "Hello, Haskell!"
+35
merkle-basic-haskell.cabal
+35
merkle-basic-haskell.cabal
···
1
+
cabal-version: 2.4
2
+
name: merkle-basic-haskell
3
+
version: 0.1.0.0
4
+
5
+
-- A short (one-line) description of the package.
6
+
-- synopsis:
7
+
8
+
-- A longer description of the package.
9
+
-- description:
10
+
11
+
-- A URL where users can report bugs.
12
+
-- bug-reports:
13
+
14
+
-- The license under which the package is released.
15
+
-- license:
16
+
author: Kaushik Chakraborty
17
+
maintainer: git@kaushikc.org
18
+
19
+
-- A copyright notice.
20
+
-- copyright:
21
+
-- category:
22
+
extra-source-files: CHANGELOG.md
23
+
24
+
executable merkle-basic-haskell
25
+
main-is: Main.hs
26
+
27
+
-- Modules included in this executable, other than Main.
28
+
-- other-modules:
29
+
30
+
-- LANGUAGE extensions used by modules in this package.
31
+
-- other-extensions:
32
+
build-depends: base ^>=4.14.3.0,
33
+
hashable >= 1.3.0
34
+
hs-source-dirs: app
35
+
default-language: Haskell2010