From: Mart Lubbers <mart@martlubbers.net>
Date: Fri, 27 Mar 2020 15:02:31 +0000 (+0100)
Subject: bc
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=5f867d6838773024fba6dbe3900ed4c055e06209;p=clean-tests.git

bc
---

diff --git a/blockchain/bc.icl b/blockchain/bc.icl
new file mode 100644
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)