content: {-# LANGUAGE DeriveDataTypeable    #-}
  {-# LANGUAGE DeriveGeneric         #-}
  {-# LANGUAGE FlexibleInstances     #-}
  {-# LANGUAGE GADTs                 #-}
  {-# LANGUAGE MultiParamTypeClasses #-}
  {-# LANGUAGE OverloadedStrings     #-}
  {-# LANGUAGE RankNTypes            #-}
  {-# LANGUAGE RecursiveDo           #-}
  {-# LANGUAGE ScopedTypeVariables   #-}
  {-# LANGUAGE StandaloneDeriving    #-}
  {-# LANGUAGE TypeApplications      #-}
  {-# LANGUAGE TypeFamilies          #-}
  
  module Main where
  
  import           Control.Concurrent (forkIO, killThread, threadDelay)
  import           Control.Concurrent.Async (forConcurrently)
  import           Control.Exception (throwIO)
  import           Data.Binary (Binary)
  import qualified Data.ByteString as BS
  import qualified Data.ByteString.Char8 as B8
  import           Data.Data (Data)
  import           Data.Functor.Contravariant (contramap)
  import           GHC.Generics (Generic)
  import           Network.Transport (closeTransport)
  import qualified Network.Transport.TCP as TCP
  import           Node
  import           Node.Message.Binary (BinaryP, binaryPacking)
  import           Pos.Util.Trace (stdoutTrace)
  import           System.Random
  
  -- | Type for messages from the workers to the listeners.
  data Ping = Ping
  deriving instance Generic Ping
  deriving instance Data Ping
  deriving instance Show Ping
  instance Binary Ping
  instance Message Ping where
      messageCode _ = 0
      formatMessage _ = "Ping"
  
  -- | Type for messages from the listeners to the workers.
  data Pong = Pong BS.ByteString
  deriving instance Generic Pong
  deriving instance Show Pong
  instance Binary Pong
  
  type Packing = BinaryP
  
  worker
      :: NodeId
      -> StdGen
      -> [NodeId]
      -> Converse Packing BS.ByteString
      -> IO ()
  worker anId generator peerIds = pingWorker generator
      where
      pingWorker
          :: StdGen
          -> Converse Packing BS.ByteString
          -> IO ()
      pingWorker gen converse = loop gen
          where
          loop :: StdGen -> IO ()
          loop g = do
              let (us, gen') = randomR (0,1000000) g
              threadDelay us
              let pong :: NodeId -> ConversationActions Ping Pong -> IO ()
                  pong peerId cactions = do
                      putStrLn $ show anId ++ " sent PING to " ++ show peerId
                      received <- recv cactions maxBound
                      case received of
                          Just (Pong _) -> putStrLn $ show anId ++ " heard PONG from " ++ show peerId
                          Nothing -> error "Unexpected end of input"
              _ <- forConcurrently peerIds $ \peerId ->
                  converseWith converse peerId (\_ -> Conversation (pong peerId))
              loop gen'
  
  listeners
      :: NodeId
      -> BS.ByteString
      -> [Listener Packing BS.ByteString]
  listeners anId peerData = [pongListener]
      where
      pongListener :: Listener Packing BS.ByteString
      pongListener = Listener $ \_ peerId (cactions :: ConversationActions Pong Ping) -> do
          putStrLn $ show anId ++  " heard PING from " ++ show peerId ++ " with peer data " ++ B8.unpack peerData
          send cactions (Pong "")
          putStrLn $ show anId ++ " sent PONG to " ++ show peerId
  
  main :: IO ()
  main = do
  
      let params = TCP.defaultTCPParameters { TCP.tcpCheckPeerHost = True }
      transport <- do
          transportOrError <-
              TCP.createTransport (TCP.defaultTCPAddr "127.0.0.1" "10128") params
          either throwIO return transportOrError
  
      let prng1 = mkStdGen 0
      let prng2 = mkStdGen 1
      let prng3 = mkStdGen 2
      let prng4 = mkStdGen 3
  
      putStrLn $ "Starting nodes"
      node (contramap snd stdoutTrace) (simpleNodeEndPoint transport) (const noReceiveDelay) (const noReceiveDelay)
           prng1 binaryPacking (B8.pack "I am node 1") defaultNodeEnvironment $ \node1 ->
          NodeAction (listeners . nodeId $ node1) $ \converse1 -> do
              node (contramap snd stdoutTrace) (simpleNodeEndPoint transport) (const noReceiveDelay) (const noReceiveDelay)
                    prng2 binaryPacking (B8.pack "I am node 2") defaultNodeEnvironment $ \node2 ->
                  NodeAction (listeners . nodeId $ node2) $ \converse2 -> do
                      tid1 <- forkIO $ worker (nodeId node1) prng3 [nodeId node2] converse1
                      tid2 <- forkIO $ worker (nodeId node2) prng4 [nodeId node1] converse2
                      putStrLn $ "Hit return to stop"
                      _ <- getChar
                      killThread tid1
                      killThread tid2
                      putStrLn $ "Stopping nodes"
      putStrLn $ "All done."
      closeTransport transport
  