module DMQ.Diffusion.PeerSelection where

import Data.Set (Set)
import Data.Set qualified as Set
import Network.Socket (SockAddr)
import Ouroboros.Network.PeerSelection.Governor.Types
import System.Random (Random (..), StdGen)

-- | Trivial peer selection policy used as dummy value
--
policy :: StdGen -> PeerSelectionPolicy SockAddr IO
policy :: StdGen -> PeerSelectionPolicy SockAddr IO
policy StdGen
gen =
  PeerSelectionPolicy {
    policyPickKnownPeersForPeerShare :: PickPolicy SockAddr (STM IO)
policyPickKnownPeersForPeerShare = \SockAddr -> PeerSource
_ SockAddr -> Int
_ SockAddr -> Bool
_ -> Set SockAddr -> Int -> STM (Set SockAddr)
Set SockAddr -> Int -> STM IO (Set SockAddr)
forall (m :: * -> *).
Applicative m =>
Set SockAddr -> Int -> m (Set SockAddr)
pickTrivially
  , policyPickColdPeersToForget :: PickPolicy SockAddr (STM IO)
policyPickColdPeersToForget   = \SockAddr -> PeerSource
_ SockAddr -> Int
_ SockAddr -> Bool
_    -> Set SockAddr -> Int -> STM (Set SockAddr)
Set SockAddr -> Int -> STM IO (Set SockAddr)
forall (m :: * -> *).
Applicative m =>
Set SockAddr -> Int -> m (Set SockAddr)
pickTrivially
  , policyPickColdPeersToPromote :: PickPolicy SockAddr (STM IO)
policyPickColdPeersToPromote  = \SockAddr -> PeerSource
_ SockAddr -> Int
_ SockAddr -> Bool
_    -> Set SockAddr -> Int -> STM (Set SockAddr)
Set SockAddr -> Int -> STM IO (Set SockAddr)
forall (m :: * -> *).
Applicative m =>
Set SockAddr -> Int -> m (Set SockAddr)
pickTrivially
  , policyPickWarmPeersToPromote :: PickPolicy SockAddr (STM IO)
policyPickWarmPeersToPromote  = \SockAddr -> PeerSource
_ SockAddr -> Int
_ SockAddr -> Bool
_    -> Set SockAddr -> Int -> STM (Set SockAddr)
Set SockAddr -> Int -> STM IO (Set SockAddr)
forall (m :: * -> *).
Applicative m =>
Set SockAddr -> Int -> m (Set SockAddr)
pickTrivially
  , policyPickHotPeersToDemote :: PickPolicy SockAddr (STM IO)
policyPickHotPeersToDemote    = \SockAddr -> PeerSource
_ SockAddr -> Int
_ SockAddr -> Bool
_    -> Set SockAddr -> Int -> STM (Set SockAddr)
Set SockAddr -> Int -> STM IO (Set SockAddr)
forall (m :: * -> *).
Applicative m =>
Set SockAddr -> Int -> m (Set SockAddr)
pickTrivially
  , policyPickWarmPeersToDemote :: PickPolicy SockAddr (STM IO)
policyPickWarmPeersToDemote   = \SockAddr -> PeerSource
_ SockAddr -> Int
_ SockAddr -> Bool
_    -> Set SockAddr -> Int -> STM (Set SockAddr)
Set SockAddr -> Int -> STM IO (Set SockAddr)
forall (m :: * -> *).
Applicative m =>
Set SockAddr -> Int -> m (Set SockAddr)
pickTrivially
  , policyPickInboundPeers :: PickPolicy SockAddr (STM IO)
policyPickInboundPeers        = \SockAddr -> PeerSource
_ SockAddr -> Int
_ SockAddr -> Bool
_    -> Set SockAddr -> Int -> STM (Set SockAddr)
Set SockAddr -> Int -> STM IO (Set SockAddr)
forall (m :: * -> *).
Applicative m =>
Set SockAddr -> Int -> m (Set SockAddr)
pickTrivially
  , policyFindPublicRootTimeout :: DiffTime
policyFindPublicRootTimeout   = DiffTime
5
  , policyMaxInProgressPeerShareReqs :: Int
policyMaxInProgressPeerShareReqs = Int
0
  , policyPeerShareRetryTime :: DiffTime
policyPeerShareRetryTime         = DiffTime
0 -- seconds
  , policyPeerShareBatchWaitTime :: DiffTime
policyPeerShareBatchWaitTime     = DiffTime
0 -- seconds
  , policyPeerShareOverallTimeout :: DiffTime
policyPeerShareOverallTimeout    = DiffTime
0 -- seconds
  , policyPeerShareActivationDelay :: DiffTime
policyPeerShareActivationDelay   = DiffTime
2 -- seconds
  }
  where
    pickTrivially :: Applicative m => Set SockAddr -> Int -> m (Set SockAddr)
    pickTrivially :: forall (m :: * -> *).
Applicative m =>
Set SockAddr -> Int -> m (Set SockAddr)
pickTrivially Set SockAddr
set Int
n = Set SockAddr -> m (Set SockAddr)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                        (Set SockAddr -> m (Set SockAddr))
-> ((Set SockAddr, StdGen) -> Set SockAddr)
-> (Set SockAddr, StdGen)
-> m (Set SockAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set SockAddr, StdGen) -> Set SockAddr
forall a b. (a, b) -> a
fst
                        ((Set SockAddr, StdGen) -> m (Set SockAddr))
-> (Set SockAddr, StdGen) -> m (Set SockAddr)
forall a b. (a -> b) -> a -> b
$ StdGen -> [SockAddr] -> Int -> [SockAddr] -> (Set SockAddr, StdGen)
forall {t} {a} {t}.
(Num t, Ord a, Eq t, RandomGen t) =>
t -> [a] -> t -> [a] -> (Set a, t)
go StdGen
gen (Set SockAddr -> [SockAddr]
forall a. Set a -> [a]
Set.toList Set SockAddr
set) Int
n []
      where
        go :: t -> [a] -> t -> [a] -> (Set a, t)
go t
g [a]
_ t
0 [a]
acc  = ([a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList [a]
acc, t
g)
        go t
g [] t
_ [a]
acc = ([a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList [a]
acc, t
g)
        go t
g [a]
xs t
k [a]
acc =
          let (Int
idx, t
g') = (Int, Int) -> t -> (Int, t)
forall g. RandomGen g => (Int, Int) -> g -> (Int, g)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (Int
0, [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) t
g
              picked :: a
picked = [a]
xs [a] -> Int -> a
forall a. HasCallStack => [a] -> Int -> a
!! Int
idx
              xs' :: [a]
xs' = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
idx [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [a]
xs
          in t -> [a] -> t -> [a] -> (Set a, t)
go t
g' [a]
xs' (t
k t -> t -> t
forall a. Num a => a -> a -> a
- t
1) (a
picked a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
acc)