{-# Language TemplateHaskell #-}
{-# Language UndecidableInstances #-}
module HBS2.Net.Proto.Peer where

import HBS2.Base58
import HBS2.Data.Types
import HBS2.Events
import HBS2.Net.Proto
import HBS2.Clock
import HBS2.Net.Proto.Sessions
import HBS2.Prelude.Plated

import Data.Maybe
import Codec.Serialise()
import Data.ByteString qualified as BS
import Data.Hashable
import Lens.Micro.Platform
import Type.Reflection (someTypeRep)

import Prettyprinter

type PingSign  e = Signature e
type PingNonce = BS.ByteString

newtype PeerData e =
  PeerData
  { _peerSignKey :: PubKey 'Sign e
  }
  deriving stock (Typeable,Generic)

makeLenses 'PeerData

data PeerHandshake e =
    PeerPing  PingNonce
  | PeerPong  (Signature e) (PeerData e)
  deriving stock (Generic)

newtype KnownPeer e = KnownPeer (PeerData e)
  deriving stock (Typeable,Generic)

newtype instance SessionKey e  (KnownPeer e) =
  KnownPeerKey (Peer e)
  deriving stock (Generic,Typeable)

type instance SessionData e (KnownPeer e) = KnownPeer e

newtype instance SessionKey e (PeerHandshake e) =
  PeerHandshakeKey (Peer e)
  deriving stock (Generic, Typeable)

type instance SessionData e (PeerHandshake e) = PingNonce



sendPing :: forall e m . ( MonadIO m
                         , Request e (PeerHandshake e) m
                         , Sessions e (PeerHandshake e) m
                         , HasNonces (PeerHandshake e) m
                         , Nonce (PeerHandshake e) ~ PingNonce
                         , Pretty (Peer e)
                         )
         => Peer e -> m ()

sendPing pip = do
  nonce <- newNonce @(PeerHandshake e)
  update nonce (PeerHandshakeKey pip) id
  liftIO $ print $ "sendPing" <+>  pretty pip <+> pretty (AsBase58 nonce)
  request pip (PeerPing @e nonce)

peerHandShakeProto :: forall e m . ( MonadIO m
                                   , Response e (PeerHandshake e) m
                                   , Request e (PeerHandshake e) m
                                   , Sessions e (PeerHandshake e) m
                                   , Sessions e (KnownPeer e) m
                                   , HasNonces (PeerHandshake e) m
                                   , Nonce (PeerHandshake e) ~ PingNonce
                                   , Signatures e
                                   , Pretty (Peer e)
                                   , HasCredentials e m
                                   , EventEmitter e (PeerHandshake e) m
                                   )
                   => PeerHandshake e -> m ()

peerHandShakeProto =
  \case
    PeerPing nonce  -> do
      pip <- thatPeer proto
      -- TODO: взять свои ключи
      creds <- getCredentials @e
      liftIO $ print $ "PING" <+> pretty pip <+> pretty (AsBase58 nonce)

      -- TODO: подписать нонс
      let sign = makeSign @e (view peerSignSk creds) nonce

      -- TODO: отправить обратно вместе с публичным ключом
      response (PeerPong @e sign (PeerData (view peerSignPk creds)))

      -- TODO: да и пингануть того самим

      se <- find (KnownPeerKey pip) id <&> isJust

      unless se $ do
        sendPing pip

    PeerPong sign d -> do
      pip <- thatPeer proto

      se' <- find @e (PeerHandshakeKey pip) id

      maybe1 se' (pure ()) $ \nonce -> do
        liftIO $ print $ pretty "PONG" <+> pretty (AsBase58 nonce)

        let pk = view peerSignKey d

        let signed = verifySign @e pk sign nonce

        liftIO $ print $ "SIGNED: " <+> pretty signed

        expire (PeerHandshakeKey pip)

        update (KnownPeer d) (KnownPeerKey pip) id

        emit KnownPeerEventKey (KnownPeerEvent pip d)

  where
    proto = Proxy @(PeerHandshake e)


data instance EventKey e (PeerHandshake e) =
  KnownPeerEventKey
  deriving stock (Typeable, Eq,Generic)

data instance Event e (PeerHandshake e) =
  KnownPeerEvent (Peer e) (PeerData e)
  deriving stock (Typeable)

instance Typeable (KnownPeer e) => Hashable (EventKey e (KnownPeer e)) where
  hashWithSalt salt _ = hashWithSalt salt (someTypeRep p)
    where
      p = Proxy @(KnownPeer e)

instance EventType ( Event e ( PeerHandshake e) ) where
  isPersistent = True

instance Expires (EventKey e (PeerHandshake e)) where
  expiresIn _ = Nothing

instance Hashable (Peer e) => Hashable (EventKey e (PeerHandshake e))

deriving instance Eq (Peer e) => Eq (SessionKey e (KnownPeer e))
instance Hashable (Peer e) => Hashable (SessionKey e (KnownPeer e))

deriving instance Eq (Peer e) => Eq (SessionKey e (PeerHandshake e))
instance Hashable (Peer e) => Hashable (SessionKey e (PeerHandshake e))

instance ( Serialise (PubKey 'Sign e)
         , Serialise (Signature e) )

  => Serialise (PeerData e)

instance ( Serialise (PubKey 'Sign e)
         , Serialise (Signature e)
         )

  => Serialise (PeerHandshake e)