{-# 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