{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
module Bcc.Tracing.Kernel
  ( NodeKernelData (..)
  , mkNodeKernelData
  , setNodeKernel
  , mapNodeKernelDataIO
  , nkQueryLedger
  , nkQueryChain
  -- * Re-exports
  , NodeKernel (..)
  , LocalConnectionId
  , RemoteConnectionId
  , StrictMaybe(..)
  , fromSMaybe
  ) where

import           Bcc.Prelude

import           Bcc.Ledger.BaseTypes (StrictMaybe (..), fromSMaybe)

import           Data.IORef (IORef, newIORef, readIORef, writeIORef)

import           Shardagnostic.Consensus.Block (Header)
import           Shardagnostic.Consensus.Ledger.Abstract (IsLedger, LedgerState)
import           Shardagnostic.Consensus.Ledger.Extended (ExtLedgerState)
import           Shardagnostic.Consensus.Node (NodeKernel (..))
import qualified Shardagnostic.Consensus.Storage.ChainDB as ChainDB
import           Shardagnostic.Consensus.Util.Orphans ()

import qualified Shardagnostic.Network.AnchoredFragment as AF
import           Shardagnostic.Network.NodeToClient (LocalConnectionId)
import           Shardagnostic.Network.NodeToNode (RemoteConnectionId)


newtype NodeKernelData blk =
  NodeKernelData
  { NodeKernelData blk
-> IORef
     (StrictMaybe
        (NodeKernel IO RemoteConnectionId LocalConnectionId blk))
unNodeKernelData :: IORef (StrictMaybe (NodeKernel IO RemoteConnectionId LocalConnectionId blk))
  }

mkNodeKernelData :: IO (NodeKernelData blk)
mkNodeKernelData :: IO (NodeKernelData blk)
mkNodeKernelData = IORef
  (StrictMaybe
     (NodeKernel IO RemoteConnectionId LocalConnectionId blk))
-> NodeKernelData blk
forall blk.
IORef
  (StrictMaybe
     (NodeKernel IO RemoteConnectionId LocalConnectionId blk))
-> NodeKernelData blk
NodeKernelData (IORef
   (StrictMaybe
      (NodeKernel IO RemoteConnectionId LocalConnectionId blk))
 -> NodeKernelData blk)
-> IO
     (IORef
        (StrictMaybe
           (NodeKernel IO RemoteConnectionId LocalConnectionId blk)))
-> IO (NodeKernelData blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictMaybe
  (NodeKernel IO RemoteConnectionId LocalConnectionId blk)
-> IO
     (IORef
        (StrictMaybe
           (NodeKernel IO RemoteConnectionId LocalConnectionId blk)))
forall a. a -> IO (IORef a)
newIORef StrictMaybe
  (NodeKernel IO RemoteConnectionId LocalConnectionId blk)
forall a. StrictMaybe a
SNothing

setNodeKernel :: NodeKernelData blk
              -> NodeKernel IO RemoteConnectionId LocalConnectionId blk
              -> IO ()
setNodeKernel :: NodeKernelData blk
-> NodeKernel IO RemoteConnectionId LocalConnectionId blk -> IO ()
setNodeKernel (NodeKernelData IORef
  (StrictMaybe
     (NodeKernel IO RemoteConnectionId LocalConnectionId blk))
ref) NodeKernel IO RemoteConnectionId LocalConnectionId blk
nodeKern =
  IORef
  (StrictMaybe
     (NodeKernel IO RemoteConnectionId LocalConnectionId blk))
-> StrictMaybe
     (NodeKernel IO RemoteConnectionId LocalConnectionId blk)
-> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef
  (StrictMaybe
     (NodeKernel IO RemoteConnectionId LocalConnectionId blk))
ref (StrictMaybe
   (NodeKernel IO RemoteConnectionId LocalConnectionId blk)
 -> IO ())
-> StrictMaybe
     (NodeKernel IO RemoteConnectionId LocalConnectionId blk)
-> IO ()
forall a b. (a -> b) -> a -> b
$ NodeKernel IO RemoteConnectionId LocalConnectionId blk
-> StrictMaybe
     (NodeKernel IO RemoteConnectionId LocalConnectionId blk)
forall a. a -> StrictMaybe a
SJust NodeKernel IO RemoteConnectionId LocalConnectionId blk
nodeKern

mapNodeKernelDataIO ::
  (NodeKernel IO RemoteConnectionId LocalConnectionId blk -> IO a)
  -> NodeKernelData blk
  -> IO (StrictMaybe a)
mapNodeKernelDataIO :: (NodeKernel IO RemoteConnectionId LocalConnectionId blk -> IO a)
-> NodeKernelData blk -> IO (StrictMaybe a)
mapNodeKernelDataIO NodeKernel IO RemoteConnectionId LocalConnectionId blk -> IO a
f (NodeKernelData IORef
  (StrictMaybe
     (NodeKernel IO RemoteConnectionId LocalConnectionId blk))
ref) =
  IORef
  (StrictMaybe
     (NodeKernel IO RemoteConnectionId LocalConnectionId blk))
-> IO
     (StrictMaybe
        (NodeKernel IO RemoteConnectionId LocalConnectionId blk))
forall a. IORef a -> IO a
readIORef IORef
  (StrictMaybe
     (NodeKernel IO RemoteConnectionId LocalConnectionId blk))
ref IO
  (StrictMaybe
     (NodeKernel IO RemoteConnectionId LocalConnectionId blk))
-> (StrictMaybe
      (NodeKernel IO RemoteConnectionId LocalConnectionId blk)
    -> IO (StrictMaybe a))
-> IO (StrictMaybe a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (NodeKernel IO RemoteConnectionId LocalConnectionId blk -> IO a)
-> StrictMaybe
     (NodeKernel IO RemoteConnectionId LocalConnectionId blk)
-> IO (StrictMaybe a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse NodeKernel IO RemoteConnectionId LocalConnectionId blk -> IO a
f

nkQueryLedger ::
     IsLedger (LedgerState blk)
  => (ExtLedgerState blk -> a)
  -> NodeKernel IO RemoteConnectionId LocalConnectionId blk
  -> IO a
nkQueryLedger :: (ExtLedgerState blk -> a)
-> NodeKernel IO RemoteConnectionId LocalConnectionId blk -> IO a
nkQueryLedger ExtLedgerState blk -> a
f NodeKernel{ChainDB IO blk
$sel:getChainDB:NodeKernel :: forall (m :: * -> *) remotePeer localPeer blk.
NodeKernel m remotePeer localPeer blk -> ChainDB m blk
getChainDB :: ChainDB IO blk
getChainDB} =
  ExtLedgerState blk -> a
f (ExtLedgerState blk -> a) -> IO (ExtLedgerState blk) -> IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STM (ExtLedgerState blk) -> IO (ExtLedgerState blk)
forall a. STM a -> IO a
atomically (ChainDB IO blk -> STM IO (ExtLedgerState blk)
forall (m :: * -> *) blk.
(Monad (STM m), IsLedger (LedgerState blk)) =>
ChainDB m blk -> STM m (ExtLedgerState blk)
ChainDB.getCurrentLedger ChainDB IO blk
getChainDB)

nkQueryChain ::
     (AF.AnchoredFragment (Header blk) -> a)
  -> NodeKernel IO RemoteConnectionId LocalConnectionId blk
  -> IO a
nkQueryChain :: (AnchoredFragment (Header blk) -> a)
-> NodeKernel IO RemoteConnectionId LocalConnectionId blk -> IO a
nkQueryChain AnchoredFragment (Header blk) -> a
f NodeKernel{ChainDB IO blk
getChainDB :: ChainDB IO blk
$sel:getChainDB:NodeKernel :: forall (m :: * -> *) remotePeer localPeer blk.
NodeKernel m remotePeer localPeer blk -> ChainDB m blk
getChainDB} =
  AnchoredFragment (Header blk) -> a
f (AnchoredFragment (Header blk) -> a)
-> IO (AnchoredFragment (Header blk)) -> IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STM (AnchoredFragment (Header blk))
-> IO (AnchoredFragment (Header blk))
forall a. STM a -> IO a
atomically (ChainDB IO blk -> STM IO (AnchoredFragment (Header blk))
forall (m :: * -> *) blk.
ChainDB m blk -> STM m (AnchoredFragment (Header blk))
ChainDB.getCurrentChain ChainDB IO blk
getChainDB)