bc

diff --git a/blockchain/bc.icl b/blockchain/bc.icl
new file mode 100644 (file)
index 0000000..6c241b8
--- /dev/null
+++ b/blockchain/bc.icl
@@ -0,0 +1,86 @@
+module bc
+
+import Crypto.Hash.SHA1
+import Data.Func
+import Data.Integer, Data.Integer.GenJSON
+import Data.List
+import Math.Random
+import StdEnv
+import System.Process
+import System.Time
+import Text
+import iTasks
+import iTasks.Extensions.DateTime
+
+NONCESIZE :== 2
+
+:: HashFun       :== String -> String
+:: ValidationFun :== String -> Bool
+:: Block           = {nonce :: !Int, prevHash :: !String, data :: !String, hash :: !String}
+:: BlockChain    :== [Block]
+:: Settings        = {difficulty :: Int, workers :: [Int]}
+
+derive class iTask Settings, Block
+
+Start w = doTasks main w
+
+mine :: !HashFun !ValidationFun !String !String !Int -> Block
+mine hfun pred prev data seed
+# (nonce, hash) = hd $ filter (pred o snd) $ map hash $ genRandInt seed
+= {nonce=nonce,prevHash=prev,data=data,hash=hash}
+where
+       hash i = (i, hfun $ data +++ prev +++ toString i)
+
+dataShare :: SimpleSDSLens [String]
+dataShare = sharedStore "data" []
+
+chainShare :: SimpleSDSLens [Block]
+chainShare = sharedStore "chain" []
+
+messageShare :: SimpleSDSLens [String]
+messageShare = sharedStore "messages" []
+
+settingsShare :: SimpleSDSLens Settings
+settingsShare = sharedStore "settings" {difficulty=4, workers=[8000,8001,8002]}
+
+main = (parallel
+                       [(Embedded, \_->chainViewer <<@ Title "Chain")
+                       ,(Embedded, \_->minerTask <<@ Title "Pool" @! ())
+                       ,(Embedded, \_->updateSharedInformation [] settingsShare <<@ Title "Settings" @! ())
+                       ] [] <<@ ArrangeWithTabs False)
+       >>* [OnAction (Action "Shutdown") $ always $ shutDown 0]
+where
+       chainViewer :: Task ()
+       chainViewer
+               =   (addData <<@ heightAttr (ExactSize 80))
+               -|| (viewSharedInformation [] chainShare <<@ Label "Chain")
+       where
+               addData = (enterInformation [] <<@ Label "Add data")
+                       >>? \x->upd (\q->q ++ [x]) dataShare
+                       >-| addData
+                       
+       minerTask :: Task ()
+       minerTask
+               = get applicationOptions
+               >>- \opts->wait (not o isEmpty) dataShare
+               >>- \[data:_]->upd (\[_:qs]->qs) dataShare
+               >-| get settingsShare
+               >>- \sett->get chainShare @ maybe "" (\b->b.hash) o listToMaybe
+               >>- \prevhash->anyTask
+                       [  mineTask i opts.appPath port sett.difficulty data prevhash
+                       \\ port <- sett.workers & i <- [0..]]
+               >>- \block->upd (\chain->[block:chain]) chainShare
+               >-| minerTask
+       where
+               mineTask :: Int String Int Int String String -> Task Block
+               mineTask num appPath port difficulty data prevHash =
+                       Title ("Worker " +++ toString num) @>> ApplyLayout (toPanel False) @>>
+                               withShared [] \stdin->
+                               withShared ([], []) \stdout->
+                                       workerproc stdin stdout ||- workerTask (mapRead fst stdout)
+               where
+                       workerproc = externalProcess {tv_sec=0,tv_nsec=100000000} appPath ["--distributed", toString port, "--distributedChild"] Nothing 9 (Just defaultPtyOptions)
+                       workerTask stdout
+                               =   wait (any (startsWith "SDS server listening on ") o split "\n" o concat) stdout
+                               >-| asyncTask "localhost" port
+                                       (get randomInt >>- return o mine sha1 (startsWith (createArray difficulty '0')) prevHash data)