{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | This module contains the definition of point schedule _peers_ as well as
-- all kind of utilities to manipulate them.

module Test.Consensus.PointSchedule.Peers (
    Peer (..)
  , PeerId (..)
  , Peers (..)
  , adversarialPeers'
  , adversarialPeers''
  , deletePeer
  , enumerateAdversaries
  , fromMap
  , fromMap'
  , getPeer
  , getPeerIds
  , honestPeers'
  , honestPeers''
  , isAdversarialPeerId
  , isHonestPeerId
  , peers'
  , peersFromPeerIdList
  , peersFromPeerIdList'
  , peersFromPeerList
  , peersList
  , peersOnlyAdversary
  , peersOnlyHonest
  , toMap
  , toMap'
  , unionWithKey
  , updatePeer
  ) where

import           Data.Hashable (Hashable)
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import           Data.String (IsString (fromString))
import           GHC.Generics (Generic)
import           NoThunks.Class (NoThunks)
import           Ouroboros.Consensus.Util.Condense (Condense (..),
                     CondenseList (..), PaddingDirection (..),
                     condenseListWithPadding)

-- | Identifier used to index maps and specify which peer is active during a tick.
data PeerId
  = HonestPeer Int
  | AdversarialPeer Int
  deriving (PeerId -> PeerId -> Bool
(PeerId -> PeerId -> Bool)
-> (PeerId -> PeerId -> Bool) -> Eq PeerId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PeerId -> PeerId -> Bool
== :: PeerId -> PeerId -> Bool
$c/= :: PeerId -> PeerId -> Bool
/= :: PeerId -> PeerId -> Bool
Eq, (forall x. PeerId -> Rep PeerId x)
-> (forall x. Rep PeerId x -> PeerId) -> Generic PeerId
forall x. Rep PeerId x -> PeerId
forall x. PeerId -> Rep PeerId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PeerId -> Rep PeerId x
from :: forall x. PeerId -> Rep PeerId x
$cto :: forall x. Rep PeerId x -> PeerId
to :: forall x. Rep PeerId x -> PeerId
Generic, Int -> PeerId -> ShowS
[PeerId] -> ShowS
PeerId -> String
(Int -> PeerId -> ShowS)
-> (PeerId -> String) -> ([PeerId] -> ShowS) -> Show PeerId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PeerId -> ShowS
showsPrec :: Int -> PeerId -> ShowS
$cshow :: PeerId -> String
show :: PeerId -> String
$cshowList :: [PeerId] -> ShowS
showList :: [PeerId] -> ShowS
Show, Eq PeerId
Eq PeerId =>
(PeerId -> PeerId -> Ordering)
-> (PeerId -> PeerId -> Bool)
-> (PeerId -> PeerId -> Bool)
-> (PeerId -> PeerId -> Bool)
-> (PeerId -> PeerId -> Bool)
-> (PeerId -> PeerId -> PeerId)
-> (PeerId -> PeerId -> PeerId)
-> Ord PeerId
PeerId -> PeerId -> Bool
PeerId -> PeerId -> Ordering
PeerId -> PeerId -> PeerId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PeerId -> PeerId -> Ordering
compare :: PeerId -> PeerId -> Ordering
$c< :: PeerId -> PeerId -> Bool
< :: PeerId -> PeerId -> Bool
$c<= :: PeerId -> PeerId -> Bool
<= :: PeerId -> PeerId -> Bool
$c> :: PeerId -> PeerId -> Bool
> :: PeerId -> PeerId -> Bool
$c>= :: PeerId -> PeerId -> Bool
>= :: PeerId -> PeerId -> Bool
$cmax :: PeerId -> PeerId -> PeerId
max :: PeerId -> PeerId -> PeerId
$cmin :: PeerId -> PeerId -> PeerId
min :: PeerId -> PeerId -> PeerId
Ord, Context -> PeerId -> IO (Maybe ThunkInfo)
Proxy PeerId -> String
(Context -> PeerId -> IO (Maybe ThunkInfo))
-> (Context -> PeerId -> IO (Maybe ThunkInfo))
-> (Proxy PeerId -> String)
-> NoThunks PeerId
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> PeerId -> IO (Maybe ThunkInfo)
noThunks :: Context -> PeerId -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> PeerId -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> PeerId -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy PeerId -> String
showTypeOf :: Proxy PeerId -> String
NoThunks)

instance IsString PeerId where
  fromString :: String -> PeerId
fromString String
s = case String -> Context
words String
s of
    [String
"honest"]       -> Int -> PeerId
HonestPeer Int
1
    [String
"honest", String
n]    -> Int -> PeerId
HonestPeer (String -> Int
forall a. Read a => String -> a
read String
n)
    [String
"adversary"]    -> Int -> PeerId
AdversarialPeer Int
1
    [String
"adversary", String
n] -> Int -> PeerId
AdversarialPeer (String -> Int
forall a. Read a => String -> a
read String
n)
    Context
_                -> String -> PeerId
forall a. HasCallStack => String -> a
error (String -> PeerId) -> String -> PeerId
forall a b. (a -> b) -> a -> b
$ String
"fromString: invalid PeerId: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

instance Condense PeerId where
  condense :: PeerId -> String
condense = \case
    HonestPeer Int
1 -> String
"honest"
    HonestPeer Int
n -> String
"honest " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
    AdversarialPeer Int
1 -> String
"adversary"
    AdversarialPeer Int
n -> String
"adversary " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n

instance CondenseList PeerId where
  condenseList :: [PeerId] -> Context
condenseList = PaddingDirection -> [PeerId] -> Context
forall a. Condense a => PaddingDirection -> [a] -> Context
condenseListWithPadding PaddingDirection
PadRight

instance Hashable PeerId

-- | General-purpose functor associated with a peer.
data Peer a =
  Peer {
    forall a. Peer a -> PeerId
name  :: PeerId,
    forall a. Peer a -> a
value :: a
  }
  deriving (Peer a -> Peer a -> Bool
(Peer a -> Peer a -> Bool)
-> (Peer a -> Peer a -> Bool) -> Eq (Peer a)
forall a. Eq a => Peer a -> Peer a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Peer a -> Peer a -> Bool
== :: Peer a -> Peer a -> Bool
$c/= :: forall a. Eq a => Peer a -> Peer a -> Bool
/= :: Peer a -> Peer a -> Bool
Eq, Int -> Peer a -> ShowS
[Peer a] -> ShowS
Peer a -> String
(Int -> Peer a -> ShowS)
-> (Peer a -> String) -> ([Peer a] -> ShowS) -> Show (Peer a)
forall a. Show a => Int -> Peer a -> ShowS
forall a. Show a => [Peer a] -> ShowS
forall a. Show a => Peer a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Peer a -> ShowS
showsPrec :: Int -> Peer a -> ShowS
$cshow :: forall a. Show a => Peer a -> String
show :: Peer a -> String
$cshowList :: forall a. Show a => [Peer a] -> ShowS
showList :: [Peer a] -> ShowS
Show)

instance Functor Peer where
  fmap :: forall a b. (a -> b) -> Peer a -> Peer b
fmap a -> b
f Peer {PeerId
name :: forall a. Peer a -> PeerId
name :: PeerId
name, a
value :: forall a. Peer a -> a
value :: a
value} = Peer {PeerId
name :: PeerId
name :: PeerId
name, value :: b
value = a -> b
f a
value}

instance Foldable Peer where
  foldr :: forall a b. (a -> b -> b) -> b -> Peer a -> b
foldr a -> b -> b
step b
z (Peer PeerId
_ a
a) = a -> b -> b
step a
a b
z

instance Traversable Peer where
  sequenceA :: forall (f :: * -> *) a. Applicative f => Peer (f a) -> f (Peer a)
sequenceA (Peer PeerId
name f a
fa) =
    PeerId -> a -> Peer a
forall a. PeerId -> a -> Peer a
Peer PeerId
name (a -> Peer a) -> f a -> f (Peer a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
fa

instance Condense a => Condense (Peer a) where
  condense :: Peer a -> String
condense Peer {PeerId
name :: forall a. Peer a -> PeerId
name :: PeerId
name, a
value :: forall a. Peer a -> a
value :: a
value} = PeerId -> String
forall a. Condense a => a -> String
condense PeerId
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Condense a => a -> String
condense a
value

instance CondenseList a => CondenseList (Peer a) where
  condenseList :: [Peer a] -> Context
condenseList [Peer a]
peers =
    (String -> ShowS) -> Context -> Context -> Context
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
      (\String
name String
value -> String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
value)
      ([PeerId] -> Context
forall a. CondenseList a => [a] -> Context
condenseList ([PeerId] -> Context) -> [PeerId] -> Context
forall a b. (a -> b) -> a -> b
$ Peer a -> PeerId
forall a. Peer a -> PeerId
name (Peer a -> PeerId) -> [Peer a] -> [PeerId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Peer a]
peers)
      ([a] -> Context
forall a. CondenseList a => [a] -> Context
condenseList ([a] -> Context) -> [a] -> Context
forall a b. (a -> b) -> a -> b
$ Peer a -> a
forall a. Peer a -> a
value (Peer a -> a) -> [Peer a] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Peer a]
peers)

-- | General-purpose functor for a set of peers.
data Peers a = Peers
  { forall a. Peers a -> Map Int a
honestPeers      :: Map Int a,
    forall a. Peers a -> Map Int a
adversarialPeers :: Map Int a
  }
  deriving (Peers a -> Peers a -> Bool
(Peers a -> Peers a -> Bool)
-> (Peers a -> Peers a -> Bool) -> Eq (Peers a)
forall a. Eq a => Peers a -> Peers a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Peers a -> Peers a -> Bool
== :: Peers a -> Peers a -> Bool
$c/= :: forall a. Eq a => Peers a -> Peers a -> Bool
/= :: Peers a -> Peers a -> Bool
Eq, Int -> Peers a -> ShowS
[Peers a] -> ShowS
Peers a -> String
(Int -> Peers a -> ShowS)
-> (Peers a -> String) -> ([Peers a] -> ShowS) -> Show (Peers a)
forall a. Show a => Int -> Peers a -> ShowS
forall a. Show a => [Peers a] -> ShowS
forall a. Show a => Peers a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Peers a -> ShowS
showsPrec :: Int -> Peers a -> ShowS
$cshow :: forall a. Show a => Peers a -> String
show :: Peers a -> String
$cshowList :: forall a. Show a => [Peers a] -> ShowS
showList :: [Peers a] -> ShowS
Show)

-- | Variant of 'honestPeers' that returns a map with 'PeerId's as keys.
honestPeers' :: Peers a -> Map PeerId a
honestPeers' :: forall a. Peers a -> Map PeerId a
honestPeers' = (Int -> PeerId) -> Map Int a -> Map PeerId a
forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysMonotonic Int -> PeerId
HonestPeer (Map Int a -> Map PeerId a)
-> (Peers a -> Map Int a) -> Peers a -> Map PeerId a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peers a -> Map Int a
forall a. Peers a -> Map Int a
honestPeers

-- | Variant of 'honestPeers' that returns a map with 'PeerId's as keys and
-- values as 'Peer's.
honestPeers'' :: Peers a -> Map PeerId (Peer a)
honestPeers'' :: forall a. Peers a -> Map PeerId (Peer a)
honestPeers'' = (PeerId -> a -> Peer a) -> Map PeerId a -> Map PeerId (Peer a)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey PeerId -> a -> Peer a
forall a. PeerId -> a -> Peer a
Peer (Map PeerId a -> Map PeerId (Peer a))
-> (Peers a -> Map PeerId a) -> Peers a -> Map PeerId (Peer a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peers a -> Map PeerId a
forall a. Peers a -> Map PeerId a
honestPeers'

-- | Variant of 'adversarialPeers' that returns a map with 'PeerId's as keys.
adversarialPeers' :: Peers a -> Map PeerId a
adversarialPeers' :: forall a. Peers a -> Map PeerId a
adversarialPeers' Peers a
peers = (Int -> PeerId) -> Map Int a -> Map PeerId a
forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysMonotonic Int -> PeerId
AdversarialPeer (Map Int a -> Map PeerId a) -> Map Int a -> Map PeerId a
forall a b. (a -> b) -> a -> b
$ Peers a -> Map Int a
forall a. Peers a -> Map Int a
adversarialPeers Peers a
peers

-- | Variant of 'adversarialPeers' that returns a map with 'PeerId's as keys and
-- values as 'Peer's.
adversarialPeers'' :: Peers a -> Map PeerId (Peer a)
adversarialPeers'' :: forall a. Peers a -> Map PeerId (Peer a)
adversarialPeers'' = (PeerId -> a -> Peer a) -> Map PeerId a -> Map PeerId (Peer a)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey PeerId -> a -> Peer a
forall a. PeerId -> a -> Peer a
Peer (Map PeerId a -> Map PeerId (Peer a))
-> (Peers a -> Map PeerId a) -> Peers a -> Map PeerId (Peer a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peers a -> Map PeerId a
forall a. Peers a -> Map PeerId a
adversarialPeers'

instance Functor Peers where
  fmap :: forall a b. (a -> b) -> Peers a -> Peers b
fmap a -> b
f Peers {Map Int a
honestPeers :: forall a. Peers a -> Map Int a
honestPeers :: Map Int a
honestPeers, Map Int a
adversarialPeers :: forall a. Peers a -> Map Int a
adversarialPeers :: Map Int a
adversarialPeers} =
    Peers
      { honestPeers :: Map Int b
honestPeers = a -> b
f (a -> b) -> Map Int a -> Map Int b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Int a
honestPeers,
        adversarialPeers :: Map Int b
adversarialPeers = a -> b
f (a -> b) -> Map Int a -> Map Int b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Int a
adversarialPeers
      }

instance Foldable Peers where
  foldMap :: forall m a. Monoid m => (a -> m) -> Peers a -> m
foldMap a -> m
f Peers {Map Int a
honestPeers :: forall a. Peers a -> Map Int a
honestPeers :: Map Int a
honestPeers, Map Int a
adversarialPeers :: forall a. Peers a -> Map Int a
adversarialPeers :: Map Int a
adversarialPeers} =
    (a -> m) -> Map Int a -> m
forall m a. Monoid m => (a -> m) -> Map Int a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Map Int a
honestPeers m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (a -> m) -> Map Int a -> m
forall m a. Monoid m => (a -> m) -> Map Int a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Map Int a
adversarialPeers

-- | A set of peers with only one honest peer carrying the given value.
peersOnlyHonest :: a -> Peers a
peersOnlyHonest :: forall a. a -> Peers a
peersOnlyHonest a
value =
  Peers
    { honestPeers :: Map Int a
honestPeers = Int -> a -> Map Int a
forall k a. k -> a -> Map k a
Map.singleton Int
1 a
value,
      adversarialPeers :: Map Int a
adversarialPeers = Map Int a
forall k a. Map k a
Map.empty
    }

peersOnlyAdversary :: a -> Peers a
peersOnlyAdversary :: forall a. a -> Peers a
peersOnlyAdversary a
value =
  Peers
    { adversarialPeers :: Map Int a
adversarialPeers = Int -> a -> Map Int a
forall k a. k -> a -> Map k a
Map.singleton Int
1 a
value,
      honestPeers :: Map Int a
honestPeers = Map Int a
forall k a. Map k a
Map.empty
    }

-- | Extract all 'PeerId's.
getPeerIds :: Peers a -> [PeerId]
getPeerIds :: forall a. Peers a -> [PeerId]
getPeerIds Peers {Map Int a
honestPeers :: forall a. Peers a -> Map Int a
honestPeers :: Map Int a
honestPeers, Map Int a
adversarialPeers :: forall a. Peers a -> Map Int a
adversarialPeers :: Map Int a
adversarialPeers} =
  (Int -> PeerId
HonestPeer (Int -> PeerId) -> [Int] -> [PeerId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Int a -> [Int]
forall k a. Map k a -> [k]
Map.keys Map Int a
honestPeers) [PeerId] -> [PeerId] -> [PeerId]
forall a. [a] -> [a] -> [a]
++ (Int -> PeerId
AdversarialPeer (Int -> PeerId) -> [Int] -> [PeerId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Int a -> [Int]
forall k a. Map k a -> [k]
Map.keys Map Int a
adversarialPeers)

getPeer :: PeerId -> Peers a -> Peer a
getPeer :: forall a. PeerId -> Peers a -> Peer a
getPeer (HonestPeer Int
n) Peers {Map Int a
honestPeers :: forall a. Peers a -> Map Int a
honestPeers :: Map Int a
honestPeers} = PeerId -> a -> Peer a
forall a. PeerId -> a -> Peer a
Peer (Int -> PeerId
HonestPeer Int
n) (Map Int a
honestPeers Map Int a -> Int -> a
forall k a. Ord k => Map k a -> k -> a
Map.! Int
n)
getPeer (AdversarialPeer Int
n) Peers {Map Int a
adversarialPeers :: forall a. Peers a -> Map Int a
adversarialPeers :: Map Int a
adversarialPeers} = PeerId -> a -> Peer a
forall a. PeerId -> a -> Peer a
Peer (Int -> PeerId
AdversarialPeer Int
n) (Map Int a
adversarialPeers Map Int a -> Int -> a
forall k a. Ord k => Map k a -> k -> a
Map.! Int
n)

updatePeer :: (a -> (a, b)) -> PeerId -> Peers a -> (Peers a, b)
updatePeer :: forall a b. (a -> (a, b)) -> PeerId -> Peers a -> (Peers a, b)
updatePeer a -> (a, b)
f (HonestPeer Int
n) Peers {Map Int a
honestPeers :: forall a. Peers a -> Map Int a
honestPeers :: Map Int a
honestPeers, Map Int a
adversarialPeers :: forall a. Peers a -> Map Int a
adversarialPeers :: Map Int a
adversarialPeers} =
  let (a
a, b
b) = a -> (a, b)
f (Map Int a
honestPeers Map Int a -> Int -> a
forall k a. Ord k => Map k a -> k -> a
Map.! Int
n)
   in (Peers {honestPeers :: Map Int a
honestPeers = Int -> a -> Map Int a -> Map Int a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Int
n a
a Map Int a
honestPeers, Map Int a
adversarialPeers :: Map Int a
adversarialPeers :: Map Int a
adversarialPeers}, b
b)
updatePeer a -> (a, b)
f (AdversarialPeer Int
n) Peers {Map Int a
honestPeers :: forall a. Peers a -> Map Int a
honestPeers :: Map Int a
honestPeers, Map Int a
adversarialPeers :: forall a. Peers a -> Map Int a
adversarialPeers :: Map Int a
adversarialPeers} =
  let (a
a, b
b) = a -> (a, b)
f (Map Int a
adversarialPeers Map Int a -> Int -> a
forall k a. Ord k => Map k a -> k -> a
Map.! Int
n)
   in (Peers {Map Int a
honestPeers :: Map Int a
honestPeers :: Map Int a
honestPeers, adversarialPeers :: Map Int a
adversarialPeers = Int -> a -> Map Int a -> Map Int a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Int
n a
a Map Int a
adversarialPeers}, b
b)

-- | Convert 'Peers' to a list of 'Peer'.
peersList :: Peers a -> [Peer a]
peersList :: forall a. Peers a -> [Peer a]
peersList Peers {Map Int a
honestPeers :: forall a. Peers a -> Map Int a
honestPeers :: Map Int a
honestPeers, Map Int a
adversarialPeers :: forall a. Peers a -> Map Int a
adversarialPeers :: Map Int a
adversarialPeers} =
  (Int -> a -> [Peer a] -> [Peer a])
-> [Peer a] -> Map Int a -> [Peer a]
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey
    (\Int
k a
v -> (PeerId -> a -> Peer a
forall a. PeerId -> a -> Peer a
Peer (Int -> PeerId
HonestPeer Int
k) a
v Peer a -> [Peer a] -> [Peer a]
forall a. a -> [a] -> [a]
:))
    ( (Int -> a -> [Peer a] -> [Peer a])
-> [Peer a] -> Map Int a -> [Peer a]
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey
        (\Int
k a
v -> (PeerId -> a -> Peer a
forall a. PeerId -> a -> Peer a
Peer (Int -> PeerId
AdversarialPeer Int
k) a
v Peer a -> [Peer a] -> [Peer a]
forall a. a -> [a] -> [a]
:))
        []
        Map Int a
adversarialPeers
    )
    Map Int a
honestPeers

enumerateAdversaries :: [PeerId]
enumerateAdversaries :: [PeerId]
enumerateAdversaries = Int -> PeerId
AdversarialPeer (Int -> PeerId) -> [Int] -> [PeerId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
1 ..]

-- | Construct 'Peers' from values, adding adversary names based on the default schema.
peers' :: [a] -> [a] -> Peers a
peers' :: forall a. [a] -> [a] -> Peers a
peers' [a]
hs [a]
as =
  Peers
    { honestPeers :: Map Int a
honestPeers = [(Int, a)] -> Map Int a
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Int, a)] -> Map Int a) -> [(Int, a)] -> Map Int a
forall a b. (a -> b) -> a -> b
$ [Int] -> [a] -> [(Int, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 ..] [a]
hs,
      adversarialPeers :: Map Int a
adversarialPeers = [(Int, a)] -> Map Int a
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Int, a)] -> Map Int a) -> [(Int, a)] -> Map Int a
forall a b. (a -> b) -> a -> b
$ [Int] -> [a] -> [(Int, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 ..] [a]
as
    }

-- | Make a 'Peers' structure from individual 'Peer's.
peersFromPeerList :: [Peer a] -> Peers a
peersFromPeerList :: forall a. [Peer a] -> Peers a
peersFromPeerList [Peer a]
peers =
  let ([(Int, a)]
hs, [(Int, a)]
as) = [Peer a] -> ([(Int, a)], [(Int, a)])
forall a. [Peer a] -> ([(Int, a)], [(Int, a)])
partitionPeers [Peer a]
peers
   in Peers
        { honestPeers :: Map Int a
honestPeers = [(Int, a)] -> Map Int a
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Int, a)]
hs,
          adversarialPeers :: Map Int a
adversarialPeers = [(Int, a)] -> Map Int a
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Int, a)]
as
        }
  where
    partitionPeers :: [Peer a] -> ([(Int, a)], [(Int, a)])
    partitionPeers :: forall a. [Peer a] -> ([(Int, a)], [(Int, a)])
partitionPeers =
      (([(Int, a)], [(Int, a)]) -> Peer a -> ([(Int, a)], [(Int, a)]))
-> ([(Int, a)], [(Int, a)]) -> [Peer a] -> ([(Int, a)], [(Int, a)])
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl
        ( \([(Int, a)]
hs, [(Int, a)]
as) (Peer PeerId
pid a
v) -> case PeerId
pid of
            HonestPeer Int
n      -> ((Int
n, a
v) (Int, a) -> [(Int, a)] -> [(Int, a)]
forall a. a -> [a] -> [a]
: [(Int, a)]
hs, [(Int, a)]
as)
            AdversarialPeer Int
n -> ([(Int, a)]
hs, (Int
n, a
v) (Int, a) -> [(Int, a)] -> [(Int, a)]
forall a. a -> [a] -> [a]
: [(Int, a)]
as)
        )
        ([], [])

unionWithKey :: (PeerId -> a -> a -> a) -> Peers a -> Peers a -> Peers a
unionWithKey :: forall a. (PeerId -> a -> a -> a) -> Peers a -> Peers a -> Peers a
unionWithKey PeerId -> a -> a -> a
f Peers a
peers1 Peers a
peers2 =
  Peers
    { honestPeers :: Map Int a
honestPeers = (Int -> a -> a -> a) -> Map Int a -> Map Int a -> Map Int a
forall k a.
Ord k =>
(k -> a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWithKey (PeerId -> a -> a -> a
f (PeerId -> a -> a -> a) -> (Int -> PeerId) -> Int -> a -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PeerId
HonestPeer) (Peers a -> Map Int a
forall a. Peers a -> Map Int a
honestPeers Peers a
peers1) (Peers a -> Map Int a
forall a. Peers a -> Map Int a
honestPeers Peers a
peers2),
      adversarialPeers :: Map Int a
adversarialPeers = (Int -> a -> a -> a) -> Map Int a -> Map Int a -> Map Int a
forall k a.
Ord k =>
(k -> a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWithKey (PeerId -> a -> a -> a
f (PeerId -> a -> a -> a) -> (Int -> PeerId) -> Int -> a -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PeerId
AdversarialPeer) (Peers a -> Map Int a
forall a. Peers a -> Map Int a
adversarialPeers Peers a
peers1) (Peers a -> Map Int a
forall a. Peers a -> Map Int a
adversarialPeers Peers a
peers2)
    }

-- | Make a 'Peers' structure from a list of peer ids and a default value.
peersFromPeerIdList :: [PeerId] -> a -> Peers a
peersFromPeerIdList :: forall a. [PeerId] -> a -> Peers a
peersFromPeerIdList = (a -> [PeerId] -> Peers a) -> [PeerId] -> a -> Peers a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((a -> [PeerId] -> Peers a) -> [PeerId] -> a -> Peers a)
-> (a -> [PeerId] -> Peers a) -> [PeerId] -> a -> Peers a
forall a b. (a -> b) -> a -> b
$ \a
val -> [Peer a] -> Peers a
forall a. [Peer a] -> Peers a
peersFromPeerList ([Peer a] -> Peers a)
-> ([PeerId] -> [Peer a]) -> [PeerId] -> Peers a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PeerId -> Peer a) -> [PeerId] -> [Peer a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((PeerId -> a -> Peer a) -> a -> PeerId -> Peer a
forall a b c. (a -> b -> c) -> b -> a -> c
flip PeerId -> a -> Peer a
forall a. PeerId -> a -> Peer a
Peer a
val)

-- | Like 'peersFromPeerIdList' with @()@.
peersFromPeerIdList' :: [PeerId] -> Peers ()
peersFromPeerIdList' :: [PeerId] -> Peers ()
peersFromPeerIdList' = ([PeerId] -> () -> Peers ()) -> () -> [PeerId] -> Peers ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip [PeerId] -> () -> Peers ()
forall a. [PeerId] -> a -> Peers a
peersFromPeerIdList ()

-- | Same as 'toMap' but the map contains unwrapped values.
toMap' :: Peers a -> Map PeerId a
toMap' :: forall a. Peers a -> Map PeerId a
toMap' Peers {Map Int a
honestPeers :: forall a. Peers a -> Map Int a
honestPeers :: Map Int a
honestPeers, Map Int a
adversarialPeers :: forall a. Peers a -> Map Int a
adversarialPeers :: Map Int a
adversarialPeers} =
  Map PeerId a -> Map PeerId a -> Map PeerId a
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union
    ((Int -> PeerId) -> Map Int a -> Map PeerId a
forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysMonotonic Int -> PeerId
HonestPeer Map Int a
honestPeers)
    ((Int -> PeerId) -> Map Int a -> Map PeerId a
forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysMonotonic Int -> PeerId
AdversarialPeer Map Int a
adversarialPeers)

toMap :: Peers a -> Map PeerId (Peer a)
toMap :: forall a. Peers a -> Map PeerId (Peer a)
toMap = (PeerId -> a -> Peer a) -> Map PeerId a -> Map PeerId (Peer a)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey PeerId -> a -> Peer a
forall a. PeerId -> a -> Peer a
Peer (Map PeerId a -> Map PeerId (Peer a))
-> (Peers a -> Map PeerId a) -> Peers a -> Map PeerId (Peer a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peers a -> Map PeerId a
forall a. Peers a -> Map PeerId a
toMap'

-- | Same as 'fromMap' but the map contains unwrapped values.
fromMap' :: Map PeerId a -> Peers a
fromMap' :: forall a. Map PeerId a -> Peers a
fromMap' Map PeerId a
peers =
  let (Map PeerId a
honestPeers, Map PeerId a
adversarialPeers) =
        (PeerId -> a -> Either a a)
-> Map PeerId a -> (Map PeerId a, Map PeerId a)
forall k a b c.
(k -> a -> Either b c) -> Map k a -> (Map k b, Map k c)
Map.mapEitherWithKey
          ( \case
              HonestPeer Int
_ -> a -> Either a a
forall a b. a -> Either a b
Left
              AdversarialPeer Int
_ -> a -> Either a a
forall a b. b -> Either a b
Right
          )
          Map PeerId a
peers
   in Peers
        { honestPeers :: Map Int a
honestPeers = (PeerId -> Int) -> Map PeerId a -> Map Int a
forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysMonotonic PeerId -> Int
unHonestPeer Map PeerId a
honestPeers,
          adversarialPeers :: Map Int a
adversarialPeers = (PeerId -> Int) -> Map PeerId a -> Map Int a
forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysMonotonic PeerId -> Int
unAdversarialPeer Map PeerId a
adversarialPeers
        }
  where
    unHonestPeer :: PeerId -> Int
unHonestPeer (HonestPeer Int
n) = Int
n
    unHonestPeer PeerId
_              = String -> Int
forall a. HasCallStack => String -> a
error String
"unHonestPeer: not a honest peer"
    unAdversarialPeer :: PeerId -> Int
unAdversarialPeer (AdversarialPeer Int
n) = Int
n
    unAdversarialPeer PeerId
_ = String -> Int
forall a. HasCallStack => String -> a
error String
"unAdversarialPeer: not an adversarial peer"

fromMap :: Map PeerId (Peer a) -> Peers a
fromMap :: forall a. Map PeerId (Peer a) -> Peers a
fromMap = Map PeerId a -> Peers a
forall a. Map PeerId a -> Peers a
fromMap' (Map PeerId a -> Peers a)
-> (Map PeerId (Peer a) -> Map PeerId a)
-> Map PeerId (Peer a)
-> Peers a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Peer a -> a) -> Map PeerId (Peer a) -> Map PeerId a
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Peer a -> a
forall a. Peer a -> a
value

deletePeer :: PeerId -> Peers a -> Peers a
deletePeer :: forall a. PeerId -> Peers a -> Peers a
deletePeer (HonestPeer Int
n) Peers {Map Int a
honestPeers :: forall a. Peers a -> Map Int a
honestPeers :: Map Int a
honestPeers, Map Int a
adversarialPeers :: forall a. Peers a -> Map Int a
adversarialPeers :: Map Int a
adversarialPeers} =
  Peers {honestPeers :: Map Int a
honestPeers = Int -> Map Int a -> Map Int a
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Int
n Map Int a
honestPeers, Map Int a
adversarialPeers :: Map Int a
adversarialPeers :: Map Int a
adversarialPeers}
deletePeer (AdversarialPeer Int
n) Peers {Map Int a
honestPeers :: forall a. Peers a -> Map Int a
honestPeers :: Map Int a
honestPeers, Map Int a
adversarialPeers :: forall a. Peers a -> Map Int a
adversarialPeers :: Map Int a
adversarialPeers} =
  Peers {Map Int a
honestPeers :: Map Int a
honestPeers :: Map Int a
honestPeers, adversarialPeers :: Map Int a
adversarialPeers = Int -> Map Int a -> Map Int a
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Int
n Map Int a
adversarialPeers}

isHonestPeerId :: PeerId -> Bool
isHonestPeerId :: PeerId -> Bool
isHonestPeerId (HonestPeer Int
_) = Bool
True
isHonestPeerId PeerId
_              = Bool
False

isAdversarialPeerId :: PeerId -> Bool
isAdversarialPeerId :: PeerId -> Bool
isAdversarialPeerId (AdversarialPeer Int
_) = Bool
True
isAdversarialPeerId PeerId
_                   = Bool
False