Permalink
Browse files

Stub

  • Loading branch information...
neongreen committed Sep 27, 2016
0 parents commit 3786244574953ea9ddb71cc4b9c7d0b8d2aacc31
Showing with 235 additions and 0 deletions.
  1. +22 −0 .gitignore
  2. +30 −0 LICENSE
  3. +2 −0 Setup.hs
  4. +25 −0 pos.cabal
  5. +146 −0 src/Main.hs
  6. +10 −0 stack.yaml
@@ -0,0 +1,22 @@
dist
cabal-dev
*.o
*.hi
*.chi
*.chs.h
*.dyn_o
*.dyn_hi
*.prof
*.aux
*.hp
.virtualenv
.hsenv
.hpc
.stack-work/
.cabal-sandbox/
cabal.sandbox.config
cabal.config
TAGS
.DS_Store
*~
*#
30 LICENSE
@@ -0,0 +1,30 @@
Copyright Artyom (c) 2016

All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:

* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.

* Redistributions in binary form must reproduce the above
copyright notice, this list of conditions and the following
disclaimer in the documentation and/or other materials provided
with the distribution.

* Neither the name of Artyom nor the names of other
contributors may be used to endorse or promote products derived
from this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
@@ -0,0 +1,2 @@
import Distribution.Simple
main = defaultMain
@@ -0,0 +1,25 @@
name: pos
version: 0.1.0.0
synopsis: Proof-of-stake
description: Please see README.md
license: BSD3
license-file: LICENSE
author: Artyom
maintainer: yom@artyom.me
copyright: 2016 Artyom
category: Currency
build-type: Simple
-- extra-source-files:
cabal-version: >=1.10

executable pos
hs-source-dirs: src
main-is: Main.hs
ghc-options: -threaded -rtsopts -with-rtsopts=-N
build-depends: base
, base-prelude
, cryptonite
, secret-sharing
, slave-thread
, time
default-language: Haskell2010
@@ -0,0 +1,146 @@
{-# LANGUAGE RecursiveDo #-}
{-# LANGUAGE NoImplicitPrelude #-}


module Main where


import BasePrelude
import Crypto.Hash (Digest, SHA256)
import qualified Crypto.SecretSharing as Secret
import Data.Time
import qualified SlaveThread as Slave


main :: IO ()
main = runNodes [node0, node1]

type NodeId = Int
type Hash = Digest SHA256

----------------------------------------------------------------------------
-- Transactions, blocks
----------------------------------------------------------------------------

-- | Transaction input
data TxIn = TxIn {
txInHash :: Hash, -- ^ Which transaction's output is used
txInIndex :: Int } -- ^ Index of the output in transaction's outputs

-- | Transaction output
data TxOut = TxOut {
txOutValue :: Word64 } -- ^ Output value

-- | Transaction
data Tx = Tx {
txInputs :: [TxIn],
txOutputs :: [TxOut],
txHash :: Hash } -- ^ Hash of the transaction

-- | An entry in a block
data BlockEntry

-- | Transaction
= ETx Tx

-- | Hash of random string U that a node has committed to
| EUHash NodeId Hash
-- | An encrypted piece of secret-shared U that the first node sent to
-- the second node (and encrypted with the second node's pubkey)
| EUShare NodeId NodeId Secret.Share

-- | Block
type Block = [BlockEntry]

----------------------------------------------------------------------------
-- Messages that nodes send to each other
----------------------------------------------------------------------------

data Message
= MBlockEntry BlockEntry
| MPing

----------------------------------------------------------------------------
-- Network simulation
----------------------------------------------------------------------------

-- | A node is given a function to send messages. A node also provides a
-- callback which can be used to send messages to the node (and the callback
-- knows who sent it a message).
type Node = (NodeId -> Message -> IO ()) -> IO (NodeId -> Message -> IO ())

node0 :: Node
node0 sendTo = do
Slave.fork $ inSlot $ \epoch slot -> do
threadDelay 100057
printf "epoch %d slot %d: 0: pinging 1\n" epoch slot
sendTo 1 MPing
return $ \from msg -> do
case msg of
MPing -> do
putStrLn ("0: pinged by " ++ show from)
_ -> do
putStrLn "0: unknown message"

node1 :: Node
node1 sendTo = do
Slave.fork $ inSlot $ \epoch slot -> do
threadDelay 350235
printf "epoch %d slot %d: 1: pinging 0\n" epoch slot
sendTo 0 MPing
return $ \from msg -> do
case msg of
MPing -> do
putStrLn ("1: pinged by " ++ show from)
_ -> do
putStrLn "1: unknown message"

runNodes :: [Node] -> IO ()
runNodes nodes = do
-- The system shall start working in a bit of time (not exactly right now –
-- due to the way inSlot implemented, it'd be nice to wait a bit)
writeIORef systemStart . (addUTCTime (slotDuration/2)) =<< getCurrentTime
tid <- Slave.fork $ mdo
nodeCallbacks <-
let send from to msg = (nodeCallbacks !! to) from msg
in sequence [node (send nid) | (nid, node) <- zip [0..] nodes]
forever $ threadDelay 1000000
forever (threadDelay 1000000) `onException` killThread tid

k :: Integral a => a
k = 3

slotDuration :: Num a => a
slotDuration = 2

systemStart :: IORef UTCTime
systemStart = unsafePerformIO $ newIORef undefined
{-# NOINLINE systemStart #-}

-- | Run something at the beginning of every slot. The first parameter is
-- epoch number (starting from 0) and the second parameter is slot number in
-- the epoch (from 0 to 6k-1).
inSlot :: (Int -> Int -> IO ()) -> IO ()
inSlot f = do
start <- readIORef systemStart
forever $ do
-- Wait until the next slot begins
t <- getCurrentTime
let untilNext = slotDuration - mod' (diffUTCTime t start) slotDuration
let currentAbsoluteSlot = div' (diffUTCTime t start) slotDuration
threadDelay (ceiling (untilNext * 1000000))
-- Do stuff
let (epoch, slot) = (currentAbsoluteSlot+1) `divMod` (6*k)
f epoch slot

{-
When an epoch starts, each of N active nodes:
• generates `u`, a random bitvector of length R log τ, where τ is the amount of satoshis in the system
• secret-shares `u` (by splitting it into N pieces) and encrypts each piece with corresponding node's pubkey; the secret can be recovered with at least N−T available pieces
• posts encrypted shares and a commitment to `u` to the blockchain
If some node becomes inactive, other nodes will be able to recover its `u` by exchanging decrypted pieces of secret-shared `u` they've been sent.
After K slots all nodes are guaranteed to have a common prefix; each node computes the random satoshi index from all available `u`s to find out who has won the leader election and can generate the next block.
-}
@@ -0,0 +1,10 @@
flags: {}
extra-package-dbs: []
packages:
- '.'
extra-deps:
- dice-entropy-conduit-1.0.0.1
- finite-field-0.8.0
- polynomial-0.7.2
- secret-sharing-1.0.0.3
resolver: lts-6.15

1 comment on commit 3786244

@si-m

This comment has been minimized.

Copy link

si-m commented on 3786244 Jan 10, 2018

ad infinitum

Please sign in to comment.