Ethereum

Ethereum is a platform and a programming language that makes it possible for any developer to build and publish next-generation distributed applications.

Ether, Ethereum's cryptofuel, powers the applications on the decentralized network.

http://ethereum.org

ethereum-haskell

An independent, unaffiliated, and incomplete reimplementation of Ethereum in Haskell.

https://github.com/bkirwi/ethereum-haskell

http://ben.kirw.in

Setup

import Data.ByteString
import Ethereum.Word4

type Key = [Word4] -- hexadecimal digits
type Value = ByteString

defaultValue = ByteString.empty

Key / Value Pairs

Association List

type AssocList = [(Key, Value)]

lookup :: Key -> AssocList -> Value
lookup key = 
  fromMaybe defaultValue . Prelude.lookup key

update :: Key -> Value -> AssocList -> AssocList
update key value list = (key, value) : list

-- TODO: handle duplicates, default values

Trie

Trie

data Trie
  = Branch [Trie] Value -- 16-element list
  | Empty

lookup :: Trie -> Key -> Value
lookup Empty _ = defaultValue
lookup (Branch _ value) [] = value
lookup (Branch children _) (nibble : rest) =
  let child = genericIndex children nibble
  in lookup child rest

Patricia Trie

Patricia Trie

data Trie
  = Branch [Trie] Value
  | Shortcut [Word4] (Either Trie Value)
  | Empty

lookup :: Trie -> Key -> Value
lookup (Shortcut prefix result) key = 
  case (stripPrefix prefix key, result) of
    (Just [], Right value) -> value
    (Just suffix, Left child) -> lookup child suffix
    _ -> defaultValue
lookup _ _ = ...

Normalization

Shortcut prefix (Right defaultValue) --> Empty

Shortcut prefix (Left Empty) --> Empty

Branch (replicate 16 Empty) value -->
  Shortcut [] (Right value)

Intuition

[...] a hash tree or Merkle tree is a tree in which every non-leaf node is labelled with the hash of the labels of its children nodes. Hash trees are useful because they allow efficient and secure verification of the contents of large data structures.

http://en.wikipedia.org/wiki/Merkle_tree

Merkle Patricia Trie

newtype Hash = Hash ByteString

data Trie
  = Branch [Hash] Value
  | Shortcut [Word4] (Either Value Hash)
  | Empty

lookup :: Hash -> Key -> Value
lookup hash key = ??? 

Interleaved IO

lookup :: Hash -> Key -> IO Value
lookup root key = retrieveNode root >>= getVal
  where
    getVal Empty = return defaultValue
    getVal (Shortcut prefix result) = 
      case (stripPrefix prefix key, result) of
        (Just [], Right value) -> return value
        (Just suffix, Left ref) -> lookup ref suffix
        _ -> return defaultValue
    getVal (Branch _ _) = ...

retrieveNode :: Hash -> IO Node

Monadic State

class Monad m => DB m where
  getDB :: Hash -> m Trie
  putDB :: Hash -> Trie -> m ()

instance DB (State (Hash -> Trie)) where
  getDB hash = do
    stateFn <- get
    return $ stateFn hash
  putDB hash node = do
    stateFn <- get
    set $ \hash' ->
      if (hash' == hash) then node
      else stateFn hash'

Lookup

lookup :: DB db => Hash -> Key -> db Value
lookup root key = getDB root >>= getVal
  where getVal = ...

Expressiveness

• Association List
• Data.Map
• LevelDB (IO)
• Network RPC (IO / Continuations)
• Custom error handling
• Multiple instances with newtype

Multi-Param Class

class Monad m => DB m where
  getDB :: Hash -> m Trie
  putDB :: Hash -> Trie -> m ()

-- becomes...

class Monad (m k v) => DB m k v where
  getDB :: k -> m k v v
  putDB :: k -> v -> m k v ()

Language Extensions

• MultiParamTypeClasses
• FlexibleContexts
• ConstraintKinds
• ...

Keeping it Simple

I advocate a direct programming style in Haskell. Advanced type system features have their place, but plain old functions go a long, long way. Functions are the masters of reuse: when you use an advanced feature, you need a yet more advanced feature to abstract over it [...] but all you need to abstract over a function is another function.

https://lukepalmer.wordpress.com/2010/01/24/haskell-antipattern-existential-typeclass/

Free Monad

data Free f a 
  = Pure a
  | Free (f (Free f a))

instance Functor f => Monad (Free f) where
  return = Pure
  Pure a >>= f = f a
  Free m >>= f = Free ((>>= f) <$> m)

Implementation

data DBOps k v next
  = Put k v next
  | Get k (v -> next)
  deriving (Functor)

newtype DB k v a = DB (Free (DBOps k v) a)
  deriving (Functor, Applicative, Monad)

getDB :: k -> DB k v v
getDB k = DB $ liftF $ Get k id

putDB :: k -> v -> DB k v ()
putDB k v = DB $ liftF $ Put k v ()

Lookup

lookup :: DB db => Hash -> Key -> db Value
lookup root key = getDB root >>= getVal
  where
    getVal Empty = return defaultValue
    getVal (Shortcut prefix result) = 
      case (stripPrefix prefix key, result) of
        (Just [], Right value) -> return value
        (Just suffix, Left ref) -> lookup ref suffix
        _ -> return defaultValue
    getVal (Branch children val) = case key of
      [] -> return val
      (nibble:rest) -> 
        let ref = genericIndex children nibble
        in lookup ref rest

Interpreter

runDB :: Monad m           
    => (k -> v -> m ()) -- put
    -> (k -> m v)       -- get
    -> DB k v a
    -> m a
runDB put get (DB ops) = go ops
  where
    go (Pure a) = return a 
    go (Free (Put k v next)) = 
        put k v >> go next
    go (Free (Get k handler)) = 
        get k >>= go . handler

Payoff

• Fewer extensions
• Multiple interepreters for same context (ie. IO)
• Very late binding

More Freedom

• Why Free Monads Matter

  http://www.haskellforall.com/2012/06/you-could-have-invented-free-monads.html

• Typed Tagless Final Interpreters

  http://okmij.org/ftp/tagless-final/course/lecture.pdf

Optional Merkle?

data Trie ref
  = Empty
  | Branch [ref] Value
  | ...

class Monad m => IsRef m r | r -> m where
  getRef :: r -> m Trie
  putRef :: Trie -> m r

Optional Merkle?

instance IsRef Identity Trie where
  getRef trie = return trie
  putRef trie = return trie

instance IsRef (DB Hash Trie) Hash where
  getRef hash = getDB hash
  putRef trie = 
    let hash = getHash trie 
    in putDB hash trie >> return hash

Pandoc

graphViz :: Block -> IO Block
graphViz (CodeBlock (_, classes, _) text) 
    | "dot" `elem` classes = stripStyle <$> ...
graphViz x = return x

stripStyle :: String -> String
stripStyle = renderTags . map noStyle . parseTags
  where noStyle = ...

main :: IO ()
main = toJSONFilter graphViz