{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
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
)
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
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)
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)
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
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'
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
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
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
}
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)
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 ..]
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
}
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)
}
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)
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 ()
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'
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