Add existing Node files

.gitignore

@@ -0,0 +1,3 @@
+.stack-work/*
+data/*.txt
+Node.cabal

LICENSE

@@ -0,0 +1,30 @@
+Copyright Enecuum (c) 2018
+
+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 Enecuum 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.

Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

app/BootNode/Main.hs

@@ -0,0 +1,21 @@
+-- бинарники бут ноды
+module Main where
+
+import              Control.Monad
+import              Control.Concurrent
+import              Service.Timer
+import              Node.Node.Types
+
+import              Boot.Boot
+import              Boot.Types
+import              Node.Lib
+
+main :: IO ()
+main = do
+    exitCh    <- newChan
+    answerCh  <- newChan
+    void $ startNode "./data/bootInitData.bin"
+        exitCh answerCh managerBootNode $ \ch _ _ -> do
+            metronomeS 100000 (writeChan ch checkBroadcastNodes)
+            metronomeS 10000000 (writeChan ch deleteDeadSouls)
+    void $ readChan exitCh

app/MakeConfigBootNode/Main.hs

@@ -0,0 +1,9 @@
+{-# Language PackageImports #-}
+module Main where
+
+import Node.Node.Config.Make
+import Node.Data.Data
+
+main :: IO ()
+main = do
+    makeFileConfig "./data/bootInitData.bin" [BootNode] 1666

app/MakeConfigSimpleNode/Main.hs

@@ -0,0 +1,9 @@
+{-# Language PackageImports #-}
+module Main where
+
+import Node.Node.Config.Make
+import Node.Data.Data
+
+main :: IO ()
+main = do
+    makeFileConfig "./data/miningInitData.bin" [BroadcastNode] 1666

app/SimpleNode/Main.hs

@@ -0,0 +1,32 @@
+module Main where
+
+import              Control.Monad
+import              Control.Concurrent
+import              Node.Node.Mining
+import              Node.Node.Types
+import              Service.Timer
+import              Node.Lib
+import              Service.Metrics
+import              PoA
+import              CLI.CLI (control)
+
+main :: IO ()
+main = do
+    aExitChan <- newChan
+    aAnswerChan  <- newChan
+    metric $ increment "cl.node.count"
+    void $ startNode "./data/miningInitData.bin"
+        aExitChan aAnswerChan managerMining $ \ch aChan aMyNodeId -> do
+            -- периодически проверяем, в каком состоянии относительно сети
+            -- мы находимся
+            metronomeS 400000 (writeChan ch connectivityQuery)
+            metronomeS 1000000 (writeChan ch deleteOldestMsg)
+            metronomeS 10000000 (writeChan ch deleteDeadSouls)
+            metronomeS 3000000 $ writeChan ch deleteOldestVacantPositions
+            idmain <- myThreadId
+            print idmain
+            idpoa <- forkIO $ servePoA  "1554" aMyNodeId ch aChan "1556"
+            print idpoa
+            idcli <- forkIO $ control ch
+            print idcli
+    void $ readChan aExitChan

data/bootNodeList.conf

@@ -0,0 +1 @@
+[(32182577306544079806602665674428406723165416005525971576927739899916426865191,(127,0,0,1),1666)]

package.yaml

@@ -0,0 +1,136 @@
+name:                Node
+version:             0.1.0.7
+github:              "Enecuum/Node"
+license:             BSD3
+author:              "Dmitriy Pavlyuk"
+maintainer:          "al.lastor@enecuum.com"
+copyright:           "2018  Enecuum"
+
+extra-source-files:
+- README.md
+- ChangeLog.md
+
+# Metadata used when publishing your package
+# synopsis:            Short description of your package
+# category:            Web
+
+# To avoid duplicated efforts in documentation and dealing with the
+# complications of embedding Haddock markup inside cabal files, it is
+# common to point users to the README.md file.
+description:
+    Структура программы состоит из нескольких потоков в каждом из
+    которых выполняется своя функция. Цикл жизни каждой такой функции очень
+    прост. Она считывает сообщение из потока и в зависимости от его содержания
+    и значения переданных ей переменных она производит какие-то действия. В
+    литературе такую сущность называют актором.
+
+    Следует выделить такие акторы как центральный, серверный, клиентский.
+
+    Серверный отвечает за приём сообщений от незнакомых нод.
+
+    Клиентский - за присоединение к серверному актору ещё незнакомой ноды.
+
+    Центральный актор отвечает за хранение состояния ноды и приём решений,
+    обработку внешних команд и ответ на них.
+
+dependencies:
+- base >= 4.7 && < 5
+- bytestring
+- fgl
+- time-units
+- network
+- websockets
+- aeson
+- cereal
+- mtl
+- cryptonite
+- base16-bytestring
+- base58-bytestring
+- arithmoi
+- directory
+- filepath
+- microlens
+- microlens-mtl
+- extra
+- time
+- clock
+- containers
+- random
+- free
+- iproute
+- memory
+- do-list
+- transformers
+- template-haskell
+- async
+- bimap
+- random-shuffle
+- split
+
+library:
+  source-dirs: src
+  ghc-options:
+  - -threaded
+  - -rtsopts
+  - -with-rtsopts=-N
+  - -Wall
+  - -O2
+
+executables:
+  BootNode-exe:
+    main:                Main.hs
+    source-dirs:         app/BootNode
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    - -Wall
+    - -O2
+    dependencies:
+    - Node
+
+  SimpleNode-exe:
+    main:                Main.hs
+    source-dirs:         app/SimpleNode
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    - -Wall
+    - -O2
+    dependencies:
+    - Node
+  MakeConfigBootNode-exe:
+    main:                Main.hs
+    source-dirs:         app/MakeConfigBootNode
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    - -Wall
+    - -O2
+    dependencies:
+    - Node
+  MakeConfigSimpleNode-exe:
+    main:                Main.hs
+    source-dirs:         app/MakeConfigSimpleNode
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    - -Wall
+    - -O2
+    dependencies:
+    - Node
+
+tests:
+  Node-test:
+    main:                Spec.hs
+    source-dirs:         test
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -O2
+    - -with-rtsopts=-N
+    dependencies:
+    - Node

src/Boot/Boot.hs

@@ -0,0 +1,116 @@
+{-# LANGUAGE ViewPatterns, LambdaCase #-}
+module Boot.Boot where
+
+import qualified    Data.Map                        as M
+import qualified    Data.Set                        as S
+import qualified    Boot.Map.Random                 as RM
+import              Data.IORef
+import              Control.Monad.Extra
+import              Lens.Micro
+import              Control.Concurrent.Chan
+import              Debug.Trace
+
+import              Boot.Types
+import              Node.Node.Base
+import              Node.Node.Types
+import              Service.Monad.Option
+import              Node.Crypto
+import              Node.Data.Data
+import              Service.Timer
+
+
+managerBootNode :: Chan ManagerBootNodeMsgBase -> IORef NodeBootNodeData -> IO ()
+managerBootNode ch md = forever $ do
+    mData <- readIORef md
+    msg <- readChan ch
+    --debug (mData^.outChan) $ "manager " <> show msg
+    runOption msg $ do
+        baseNodeOpts ch md mData
+
+        opt isClientIsDisconnected $ bootNodeAnswerClientIsDisconnected md
+
+        opt isInitDatagram      $ answerToInitDatagram md
+        opt isDatagramMsg       $ answerToDatagramMsg ch md (mData^.myNodeId)
+            bootNodeAnswerToPing
+            (answerToPong
+                :: PongAnswer NodeBootNodeData ManagerBootNodeMsgBase)
+            bootNodeAnswerToInfoPing
+        opt isCheckBroadcastNodes $ answerToCheckBroadcastNodes md ch
+        opt isCheckBroadcastNode  $ answerToCheckBroadcastNode ch md
+
+
+answerToCheckBroadcastNodes ::
+    IORef NodeBootNodeData ->
+    Chan ManagerBootNodeMsgBase ->
+    ManagerBootNodeMsgBase -> IO ()
+answerToCheckBroadcastNodes aMd aChan _ = do
+    aData <- readIORef aMd
+    let anActiveNodes :: [Node]
+        anActiveNodes = getNodes Active aData
+
+        aNodeIds :: [NodeId]
+        aNodeIds = (\aNode -> keyToId $ (aNode^.nPublicKey)) <$> anActiveNodes
+
+        aNeededInBroadcastLis :: [NodeId]
+        aNeededInBroadcastLis = filter (\aId -> S.notMember aId $ aData^.checSet)
+            aNodeIds
+
+        aBroadcastNodes :: [NodeId]
+        aBroadcastNodes = filter (\aId -> S.member aId $ aData^.checSet)
+            aNodeIds
+
+    forM_ aNeededInBroadcastLis $ \aNodeId -> do
+        aBroadcastNodeList <- aData^.broadcastNodes.to (RM.takeRandom 10)
+        sendJustPackagedMsg $ makeMsg aNodeId aData $
+            makePongMsg $ BroadcastNodeListAnswer aBroadcastNodeList
+        whenJust (aNodeId `M.lookup` (aData^.nodes)) $ \aNode -> do
+            timer 100000 $ do
+                sendExitMsgToNode aNode
+                whenJust (aGetIpAndPort aData aNodeId) $ \(aIp, aPort) -> do
+                    timer 100000 $ do
+                        writeChan aChan $ checkBroadcastNode aNodeId aIp aPort
+
+    forM_ aBroadcastNodes $ \aNodeId -> do
+        modifyIORef aMd $ checSet %~ S.delete aNodeId
+
+        whenJust (aNodeId `M.lookup` (aData^.nodes)) sendExitMsgToNode
+        whenJust (aGetIpAndPort aData aNodeId) $ \(aIp, aPort) -> do
+            modifyIORef aMd $ broadcastNodes %~ RM.insert aNodeId (aIp, aPort)
+  where
+    aGetIpAndPort aData aNodeId = do
+        aNode     <- aNodeId `M.lookup` (aData^.nodes)
+        aHelloMsg <- aNode^.mHelloMsg
+        return (aNode^.nHostAddress, aHelloMsg^.listenPort)
+
+
+answerToCheckBroadcastNode :: ManagerMsg a =>
+    Chan a -> IORef NodeBootNodeData -> ManagerBootNodeMsgBase -> IO ()
+answerToCheckBroadcastNode aChan aMd (CheckBroadcastNode aNodeId aIp aPort) = do
+    modifyIORef aMd $ checSet %~ S.insert aNodeId
+    sendInitDatagramFunc aChan aIp aPort aNodeId aMd
+answerToCheckBroadcastNode _ _ _ = return ()
+
+
+bootNodeAnswerClientIsDisconnected ::
+    IORef NodeBootNodeData -> ManagerBootNodeMsgBase -> IO ()
+bootNodeAnswerClientIsDisconnected aMd
+    (toManagerMsg -> ClientIsDisconnected aId aChan) = do
+        traceMarkerIO "bootNodeAnswerClientIsDisconnected"
+        aData <- readIORef aMd
+        whenJust (aId `M.lookup` (aData^.nodes)) $ \aNode -> do
+            when (aNode^.chan == aChan) $ do
+                minusStatusNumber aMd aId
+                modifyIORef aMd (nodes %~ M.delete aId)
+bootNodeAnswerClientIsDisconnected _ _ = pure ()
+
+
+bootNodeAnswerToPing :: PingAnswer NodeBootNodeData ManagerBootNodeMsgBase
+bootNodeAnswerToPing _ _ _ _ = pure ()
+
+
+bootNodeAnswerToPong :: PongAnswer NodeBootNodeData ManagerBootNodeMsgBase
+bootNodeAnswerToPong _ _ _ _ = pure ()
+
+
+bootNodeAnswerToInfoPing :: InfoPingAnswer  NodeBootNodeData ManagerBootNodeMsgBase
+bootNodeAnswerToInfoPing _ _ _ _ = pure ()