{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# Language UndecidableInstances #-}
module RPC2.RefChan
  ( module RPC2.RefChan
  , module HBS2.Peer.RPC.Internal.Types
  ) where

import HBS2.Peer.Prelude

import HBS2.Actors.Peer
import HBS2.Base58
import HBS2.Data.Types.Refs (HashRef(..))
import HBS2.Net.Proto.Service
import HBS2.Peer.Proto.RefChan
import HBS2.Net.Messaging.Unix
import HBS2.Storage

import HBS2.Peer.RPC.API.RefChan
import HBS2.Peer.RPC.Internal.Types

import PeerTypes

import Control.Arrow (left)
import Control.Monad.Reader

type RefChanContext m = (MonadIO m, HasRpcContext RefChanAPI RPC2Context m)

instance (Monad m)
  => HasRpcContext RefChanAPI RPC2Context (ResponseM UNIX (ReaderT RPC2Context m)) where
  -- type instance RpcContext RefChanAPI = RPC2Context
  getRpcContext = lift ask

instance RefChanContext m => HandleMethod m RpcRefChanHeadGet where

  handleMethod puk = do
    co <- getRpcContext @RefChanAPI
    let penv = rpcPeerEnv co
    debug $ "rpc.refchanHeadGet:"  <+> pretty (AsBase58 puk)
    liftIO $ withPeerM penv $ do
      sto <- getStorage
      liftIO $ getRef sto (RefChanHeadKey @'HBS2Basic puk) <&> fmap HashRef

instance (RefChanContext m) => HandleMethod m RpcRefChanHeadFetch where

  handleMethod puk = do
    debug $ "rpc.refchanHeadFetch:"  <+> pretty (AsBase58 puk)
    penv <- rpcPeerEnv <$> getRpcContext @RefChanAPI
    void $ liftIO $ withPeerM penv $ do
      broadCastMessage (RefChanGetHead @L4Proto puk)

instance RefChanContext m => HandleMethod m RpcRefChanFetch where

  handleMethod puk = do
    debug $ "rpc.refchanFetch:"  <+> pretty (AsBase58 puk)
    penv <- rpcPeerEnv <$> getRpcContext @RefChanAPI
    void $ liftIO $ withPeerM penv $ do
      gossip (RefChanRequest @L4Proto puk)

instance RefChanContext m => HandleMethod m RpcRefChanGet where

  handleMethod puk = do
    co <- getRpcContext @RefChanAPI
    let penv = rpcPeerEnv co
    debug $ "rpc.refchanGet:"  <+> pretty (AsBase58 puk)
    liftIO $ withPeerM penv $ do
      sto <- getStorage
      liftIO $ getRef sto (RefChanLogKey @'HBS2Basic puk) <&> fmap HashRef

instance RefChanContext m => HandleMethod m RpcRefChanPropose where

  handleMethod (puk, box) = do
    co <- getRpcContext @RefChanAPI
    debug $ "rpc.refChanNotifyAction" <+>  pretty (AsBase58 puk)
    liftIO $ left RefChanAPIError <$> do
        rpcDoRefChanPropose co (puk, box)


instance RefChanContext m => HandleMethod m RpcRefChanNotify where

  handleMethod (puk, box) = do
    co <- getRpcContext @RefChanAPI
    debug $ "rpc.refChanNotifyAction" <+>  pretty (AsBase58 puk)
    liftIO $ rpcDoRefChanNotify co (puk, box)

instance RefChanContext m => HandleMethod m RpcRefChanHeadPost where

  handleMethod href = do
    co <- getRpcContext @RefChanAPI
    liftIO $ rpcDoRefChanHeadPost co href