froozen / kademlia Goto Github PK

#! /usr/bin/env nix-shell
#! nix-shell -i runghc -p "haskellPackages.ghcWithPackages (pkgs: with pkgs; [kademlia cryptonite uuid])"

{-# Language DeriveGeneric #-}
{-# Language OverloadedStrings #-}
{-# Language LambdaCase #-}
module Main where

import qualified Network.Kademlia as K
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import qualified Data.ByteString.Lazy as BL
import qualified Data.Binary as BS
import Control.Arrow (first)
import GHC.Generics (Generic)
import Control.Exception
import System.Environment (getArgs)
import Control.Monad (when, forever)
import Control.Concurrent (threadDelay, myThreadId)
import Data.Monoid ((<>))
import Crypto.Hash
import Data.ByteArray (convert)

data Person = Person { age :: Int , name :: String }
            deriving (Show, Eq, Ord, Generic)

instance BS.Binary Person


instance K.Serialize Person where
  toBS = BL.toStrict . BS.encode
  fromBS bs =
    let person = BS.decode (BL.fromStrict bs)
    in Right (person, "")

keySize :: Int
keySize = 32

newtype KademliaID = KademliaID B.ByteString deriving (Show, Eq, Ord)

toKey :: B.ByteString -> KademliaID
toKey bs = KademliaID (convert (hashWith SHA256 bs))

instance K.Serialize KademliaID where
   toBS (KademliaID bs)
       | B.length bs >= keySize = B.take keySize bs
       | otherwise        = error "KademliaID to short!"

   fromBS bs
       | B.length bs >= keySize = Right . first KademliaID . B.splitAt keySize $ bs
       | otherwise        = Left "ByteString too short!"

withKademlia :: Int -> KademliaID -> (K.KademliaInstance KademliaID Person -> IO ()) -> IO ()
withKademlia port name f =
  bracket (K.create port name)
          K.close
          f

debugger :: K.KademliaInstance KademliaID Person -> IO ()
debugger inst = forever $ do
  peers <- fmap K.peer <$> K.dumpPeers inst
  putStrLn $ show (length peers) <> " peers"
  print peers
  -- let key = (toKey "foobar")
  -- K.lookup inst key >>= print
  threadDelay 5000000

joinInstance :: Int -> KademliaID -> K.KademliaInstance KademliaID Person -> IO ()
joinInstance port name inst =
  K.joinNetwork inst (K.Node (K.Peer "127.0.0.1" (fromIntegral port)) name) >>= \case
    K.JoinSucces -> do
      peers <- K.dumpPeers inst
      print peers
      when (length peers > 4) $ do
        let key = (toKey "foobar")
        let person = Person 25 "Alan Turing"
        K.store inst key person
      threadDelay 1000000
    err -> print err

main :: IO ()
main =
  getArgs >>= \case
    [port, name] -> withKademlia (read port) (toKey $ C.pack name) debugger
    [port, name, remotePort, remoteName] -> withKademlia (read port) (toKey $ C.pack name) (\inst -> joinInstance (read remotePort) (toKey $ C.pack remoteName) inst >> debugger inst)