module Blockchain.Data.Wire (
  Message(..),
  Capability(..),
  obj2WireMessage,
  wireMessage2Obj
  ) where

import Data.Functor
import Data.List
import Network.Haskoin.Crypto
import Numeric
import Text.PrettyPrint.ANSI.Leijen hiding ((<$>))

import qualified Blockchain.Colors as CL
import Blockchain.Data.Block
import Blockchain.Data.Peer
import Blockchain.Data.RLP
import Blockchain.Data.SignedTransaction
import Blockchain.Format
import Blockchain.SHA
import Blockchain.Util

--import Debug.Trace

data Capability = ETH Integer | SHH Integer deriving (Show)

name2Cap::Integer->String->Capability
name2Cap qqqq "eth" = ETH qqqq
name2Cap qqqq "shh" = SHH qqqq
name2Cap _ x = error $ "Unknown capability string: " ++ x

{-capValue::Capability->String
capValue ETH = "eth"
capValue SHH = "shh"-}

instance RLPSerializable Capability where
    rlpEncode (ETH qqqq) = RLPArray [rlpEncode "eth", rlpEncode qqqq]
    rlpEncode (SHH qqqq) = RLPArray [rlpEncode "shh", rlpEncode qqqq]

    rlpDecode (RLPArray [name, qqqq]) = name2Cap (rlpDecode qqqq) $ rlpDecode name
    rlpDecode x = error $ "wrong format given to rlpDecode for Capability: " ++ show (pretty x)

data TerminationReason =
  DisconnectRequested
  | TCPSubSystemError
  | BreachOfProtocol
  | UselessPeer
  | TooManyPeers
  | AlreadyConnected
  | IncompatibleP2PProtocolVersion
  | NullNodeIdentityReceived
  | ClientQuitting
  | UnexpectedIdentity
  | ConnectedToSelf
  | PingTimeout
  | OtherSubprotocolReason deriving (Show)


numberToTerminationReason::Integer->TerminationReason
numberToTerminationReason 0x00 = DisconnectRequested
numberToTerminationReason 0x01 = TCPSubSystemError
numberToTerminationReason 0x02 = BreachOfProtocol
numberToTerminationReason 0x03 = UselessPeer
numberToTerminationReason 0x04 = TooManyPeers
numberToTerminationReason 0x05 = AlreadyConnected
numberToTerminationReason 0x06 = IncompatibleP2PProtocolVersion
numberToTerminationReason 0x07 = NullNodeIdentityReceived
numberToTerminationReason 0x08 = ClientQuitting
numberToTerminationReason 0x09 = UnexpectedIdentity
numberToTerminationReason 0x0a = ConnectedToSelf
numberToTerminationReason 0x0b = PingTimeout
numberToTerminationReason 0x0c = OtherSubprotocolReason
numberToTerminationReason _ = error "numberToTerminationReasion called with unsupported number"


terminationReasonToNumber::TerminationReason->Integer
terminationReasonToNumber DisconnectRequested = 0x00
terminationReasonToNumber TCPSubSystemError = 0x01
terminationReasonToNumber BreachOfProtocol = 0x02
terminationReasonToNumber UselessPeer = 0x03
terminationReasonToNumber TooManyPeers = 0x04
terminationReasonToNumber AlreadyConnected = 0x05
terminationReasonToNumber IncompatibleP2PProtocolVersion = 0x06
terminationReasonToNumber NullNodeIdentityReceived = 0x07
terminationReasonToNumber ClientQuitting = 0x08
terminationReasonToNumber UnexpectedIdentity = 0x09
terminationReasonToNumber ConnectedToSelf = 0x0a
terminationReasonToNumber PingTimeout = 0x0b
terminationReasonToNumber OtherSubprotocolReason = 0x0c
  


data Message =
  Hello { version::Int, clientId::String, capability::[Capability], port::Int, nodeId::Word512 } |
  Disconnect TerminationReason |
  Ping |
  Pong |
  GetPeers |
  Peers [Peer] |
  Status { protocolVersion::Int, networkID::String, totalDifficulty::Int, latestHash::SHA, genesisHash:: SHA } |
  QqqqStatus Int |
  Transactions [SignedTransaction] | 
  GetBlocks [SHA] |
  Blocks [Block] |
  BlockHashes [SHA] |
  GetBlockHashes { parentSHAs::[SHA], numChildItems::Integer } |
  GetTransactions |
  NewBlockPacket Block Integer |
  PacketCount Integer |
  QqqqPacket |
  WhisperProtocolVersion Int deriving (Show)

instance Format Message where
  format Hello{version=ver, clientId=c, capability=cap, port=p, nodeId=n} =
    CL.blue "Hello" ++
      "    version: " ++ show ver ++ "\n" ++
      "    cliendId: " ++ show c ++ "\n" ++
      "    capability: " ++ intercalate ", " (show <$> cap) ++ "\n" ++
      "    port: " ++ show p ++ "\n" ++
      "    nodeId: " ++ take 20 (padZeros 64 (showHex n "")) ++ "...."
  format (Disconnect reason) = CL.blue "Disconnect" ++ "(" ++ show reason ++ ")"
  format Ping = CL.blue "Ping"
  format Pong = CL.blue "Pong"
  format GetPeers = CL.blue "GetPeers"
  format (Peers peers) = CL.blue "Peers: " ++ intercalate ", " (format <$> peers)
  format Status{ protocolVersion=ver, networkID=nID, totalDifficulty=d, latestHash=lh, genesisHash=gh } =
    CL.blue "Status" ++
      "    protocolVersion: " ++ show ver ++ "\n" ++
      "    networkID: " ++ show nID ++ "\n" ++
      "    totalDifficulty: " ++ show d ++ "\n" ++
      "    latestHash: " ++ show (pretty lh) ++ "\n" ++
      "    genesisHash: " ++ show (pretty gh)
  format (QqqqStatus ver) =
    CL.blue "QqqqStatus " ++
      "    protocolVersion: " ++ show ver
  format (Transactions transactions) =
    CL.blue "Transactions:\n    " ++ tab (intercalate "\n    " (format <$> transactions))
    
--Short version
  format (BlockHashes shas) =
    CL.blue "BlockHashes " ++ "(" ++ show (length shas) ++ " new hashes)" 
--Long version
{-  format (BlockHashes shas) =
    CL.blue "BlockHashes:" ++  
   tab ("\n" ++ intercalate "\n    " (show . pretty <$> shas))-}

  format (GetBlocks shas) =
    CL.blue "GetBlocks:" ++ 
    tab ("\n" ++ intercalate "\n    " (show . pretty <$> shas))
  format (Blocks blocks) = CL.blue "Blocks:" ++ tab("\n" ++ intercalate "\n    " (format <$> blocks))
  format (GetBlockHashes pSHAs numChild) =
    CL.blue "GetBlockHashes" ++ " (max: " ++ show numChild ++ "):\n    " ++
    intercalate ",\n    " (show . pretty <$> pSHAs)
  format (NewBlockPacket block d) = CL.blue "NewBlockPacket" ++ " (" ++ show d ++ ")" ++ tab ("\n" ++ format block)
  format (PacketCount c) =
    CL.blue "PacketCount:" ++ show c
  format QqqqPacket = CL.blue "QqqqPacket"
  format GetTransactions = CL.blue "GetTransactions"
  format (WhisperProtocolVersion ver) = CL.blue "WhisperProtocolVersion " ++ show ver


obj2WireMessage::RLPObject->Message
obj2WireMessage (RLPArray [RLPString "", ver, cId, RLPArray cap, p, nId]) =
  Hello (fromInteger $ rlpDecode ver) (rlpDecode cId) (rlpDecode <$> cap) (fromInteger $ rlpDecode p) $ rlp2Word512 nId
obj2WireMessage (RLPArray [RLPScalar 0x01, reason]) =
  Disconnect (numberToTerminationReason $ rlpDecode reason)
obj2WireMessage (RLPArray [RLPScalar 0x02]) = Ping
obj2WireMessage (RLPArray [RLPScalar 0x03]) = Pong
obj2WireMessage (RLPArray [RLPScalar 0x04]) = GetPeers
obj2WireMessage (RLPArray (RLPScalar 0x05:peers)) = Peers $ rlpDecode <$> peers
obj2WireMessage (RLPArray [RLPScalar 0x10, ver, nID, d, lh, gh]) = 
    Status {
  protocolVersion=fromInteger $ rlpDecode ver,
  networkID = rlpDecode nID,
  totalDifficulty = fromInteger $ rlpDecode d,
  latestHash=rlpDecode lh,
  genesisHash=rlpDecode gh
}
obj2WireMessage (RLPArray [RLPScalar 0x10, ver]) = 
    QqqqStatus $ fromInteger $ rlpDecode ver

obj2WireMessage (RLPArray [RLPScalar 0x11]) = GetTransactions
obj2WireMessage (RLPArray (RLPScalar 0x12:transactions)) =
  Transactions $ rlpDecode <$> transactions


obj2WireMessage (RLPArray (RLPScalar 0x13:items)) =
  GetBlockHashes (rlpDecode <$> init items) $ rlpDecode $ last items
obj2WireMessage (RLPArray (RLPScalar 0x14:items)) =
  BlockHashes $ rlpDecode <$> items


obj2WireMessage (RLPArray (RLPScalar 0x15:items)) =
  GetBlocks $ rlpDecode <$> items
obj2WireMessage (RLPArray (RLPScalar 0x16:blocks)) =
  Blocks $ rlpDecode <$> blocks
obj2WireMessage (RLPArray [RLPScalar 0x17, block, td]) =
  NewBlockPacket (rlpDecode block) (rlpDecode td)
obj2WireMessage (RLPArray [RLPScalar 0x18, c]) =
  PacketCount $ rlpDecode c
obj2WireMessage (RLPArray [RLPScalar 0x19]) =
  QqqqPacket

obj2WireMessage (RLPArray [RLPScalar 0x20, ver]) =
  WhisperProtocolVersion $ fromInteger $ rlpDecode ver

obj2WireMessage x = error ("Missing case in obj2WireMessage: " ++ show (pretty x))






wireMessage2Obj::Message->RLPObject
wireMessage2Obj Hello { version = ver,
                        clientId = cId,
                        capability = cap,
                        port = p,
                        nodeId = nId } =
  RLPArray [
    RLPString [],
    rlpEncode $ toInteger ver,
    rlpEncode cId,
    RLPArray $ rlpEncode <$> cap,
    rlpEncode $ toInteger p,
    word5122RLP nId
    ]
wireMessage2Obj (Disconnect reason) =
  RLPArray [RLPScalar 0x1, rlpEncode $ terminationReasonToNumber reason]
wireMessage2Obj Ping = RLPArray [RLPScalar 0x2]
wireMessage2Obj Pong = RLPArray [RLPScalar 0x3]
wireMessage2Obj GetPeers = RLPArray [RLPScalar 0x4]
wireMessage2Obj (Peers peers) = RLPArray $ RLPScalar 0x5:(rlpEncode <$> peers)

wireMessage2Obj (Status ver nID d lh gh) =
    RLPArray [RLPScalar 0x10, rlpEncode $ toInteger ver, rlpEncode nID, rlpEncode $ toInteger d, rlpEncode lh, rlpEncode gh]
wireMessage2Obj (QqqqStatus ver) =
    RLPArray [RLPScalar 0x10, rlpEncode $ toInteger ver]
wireMessage2Obj GetTransactions = RLPArray [RLPScalar 0x11]
wireMessage2Obj (Transactions transactions) =
  RLPArray (RLPScalar 0x12:(rlpEncode <$> transactions))
wireMessage2Obj (GetBlockHashes pSHAs numChildren) = 
  RLPArray $ [RLPScalar 0x13] ++
  (rlpEncode <$> pSHAs) ++
  [rlpEncode numChildren]
wireMessage2Obj (BlockHashes shas) = 
  RLPArray $ RLPScalar 0x14:(rlpEncode <$> shas)
wireMessage2Obj (GetBlocks shas) = 
  RLPArray $ RLPScalar 0x15:(rlpEncode <$> shas)
wireMessage2Obj (Blocks blocks) =
  RLPArray (RLPScalar 0x16:(rlpEncode <$> blocks))
wireMessage2Obj (NewBlockPacket block d) =
  RLPArray [RLPScalar 0x17, rlpEncode block, rlpEncode d]
wireMessage2Obj (PacketCount c) =
  RLPArray [RLPScalar 0x18, rlpEncode c]
wireMessage2Obj QqqqPacket =
  RLPArray [RLPScalar 0x19]

wireMessage2Obj (WhisperProtocolVersion ver) = 
  RLPArray [RLPScalar 0x20, rlpEncode $ toInteger ver]