{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
module Data.TrustChain
(
TrustChain (..)
, validTrustChain
, mkTrustProxy
, mkTrustless
, Whitelist (..)
, filterByWhitelist
, Claim (..)
, claims
, claimants
, assignments
, Inconsistency (..)
, PublicKey
, PrivateKey
, Signed(..)
, Merge
) where
import Data.Set (Set)
import Data.Typeable (Typeable)
import qualified Data.Set as Set
import Data.Map (Map)
import Data.Foldable (toList)
import qualified Data.Map.Strict as Map
import Data.Binary (Binary (..))
import GHC.Generics (Generic)
import Data.Semigroup (All(All, getAll))
import Cropty
import Data.Merge
data TrustChain f a =
Trustless a
| TrustProxy (Signed (f (TrustChain f a)))
deriving ((forall x. TrustChain f a -> Rep (TrustChain f a) x)
-> (forall x. Rep (TrustChain f a) x -> TrustChain f a)
-> Generic (TrustChain f a)
forall x. Rep (TrustChain f a) x -> TrustChain f a
forall x. TrustChain f a -> Rep (TrustChain f a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) a x. Rep (TrustChain f a) x -> TrustChain f a
forall (f :: * -> *) a x. TrustChain f a -> Rep (TrustChain f a) x
$cto :: forall (f :: * -> *) a x. Rep (TrustChain f a) x -> TrustChain f a
$cfrom :: forall (f :: * -> *) a x. TrustChain f a -> Rep (TrustChain f a) x
Generic, Typeable)
deriving instance (Show a, Show (f (TrustChain f a))) => Show (TrustChain f a)
deriving instance (Read a, Read (f (TrustChain f a))) => Read (TrustChain f a)
deriving instance (Binary a, Binary (f (TrustChain f a))) => Binary (TrustChain f a)
instance Eq a => Eq (TrustChain f a) where
Trustless a
a == :: TrustChain f a -> TrustChain f a -> Bool
== Trustless a
a' = a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a'
Trustless a
_ == TrustProxy Signed (f (TrustChain f a))
_ = Bool
False
TrustProxy Signed (f (TrustChain f a))
_ == Trustless a
_ = Bool
False
TrustProxy Signed (f (TrustChain f a))
s == TrustProxy Signed (f (TrustChain f a))
s' = Signed (f (TrustChain f a)) -> Signature
forall a. Signed a -> Signature
signature Signed (f (TrustChain f a))
s Signature -> Signature -> Bool
forall a. Eq a => a -> a -> Bool
== Signed (f (TrustChain f a)) -> Signature
forall a. Signed a -> Signature
signature Signed (f (TrustChain f a))
s' Bool -> Bool -> Bool
&& Signed (f (TrustChain f a)) -> PublicKey
forall a. Signed a -> PublicKey
signedBy Signed (f (TrustChain f a))
s PublicKey -> PublicKey -> Bool
forall a. Eq a => a -> a -> Bool
== Signed (f (TrustChain f a)) -> PublicKey
forall a. Signed a -> PublicKey
signedBy Signed (f (TrustChain f a))
s' Bool -> Bool -> Bool
&& Signed (f (TrustChain f a)) -> ByteString
forall a. Signed a -> ByteString
signedEncoded Signed (f (TrustChain f a))
s ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Signed (f (TrustChain f a)) -> ByteString
forall a. Signed a -> ByteString
signedEncoded Signed (f (TrustChain f a))
s'
instance Ord a => Ord (TrustChain f a) where
compare :: TrustChain f a -> TrustChain f a -> Ordering
compare (Trustless a
a) (Trustless a
a') = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
a a
a'
compare (Trustless a
_) TrustChain f a
_ = Ordering
GT
compare (TrustProxy Signed (f (TrustChain f a))
_) (Trustless a
_) = Ordering
LT
compare (TrustProxy Signed (f (TrustChain f a))
s) (TrustProxy Signed (f (TrustChain f a))
s') =
Signature -> Signature -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Signed (f (TrustChain f a)) -> Signature
forall a. Signed a -> Signature
signature Signed (f (TrustChain f a))
s) (Signed (f (TrustChain f a)) -> Signature
forall a. Signed a -> Signature
signature Signed (f (TrustChain f a))
s')
Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> PublicKey -> PublicKey -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Signed (f (TrustChain f a)) -> PublicKey
forall a. Signed a -> PublicKey
signedBy Signed (f (TrustChain f a))
s) (Signed (f (TrustChain f a)) -> PublicKey
forall a. Signed a -> PublicKey
signedBy Signed (f (TrustChain f a))
s')
Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Signed (f (TrustChain f a)) -> ByteString
forall a. Signed a -> ByteString
signedEncoded Signed (f (TrustChain f a))
s) (Signed (f (TrustChain f a)) -> ByteString
forall a. Signed a -> ByteString
signedEncoded Signed (f (TrustChain f a))
s')
newtype Whitelist = Whitelist { Whitelist -> Set PublicKey
unWhitelist :: Set PublicKey }
deriving (Whitelist -> Whitelist -> Bool
(Whitelist -> Whitelist -> Bool)
-> (Whitelist -> Whitelist -> Bool) -> Eq Whitelist
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Whitelist -> Whitelist -> Bool
$c/= :: Whitelist -> Whitelist -> Bool
== :: Whitelist -> Whitelist -> Bool
$c== :: Whitelist -> Whitelist -> Bool
Eq, Eq Whitelist
Eq Whitelist
-> (Whitelist -> Whitelist -> Ordering)
-> (Whitelist -> Whitelist -> Bool)
-> (Whitelist -> Whitelist -> Bool)
-> (Whitelist -> Whitelist -> Bool)
-> (Whitelist -> Whitelist -> Bool)
-> (Whitelist -> Whitelist -> Whitelist)
-> (Whitelist -> Whitelist -> Whitelist)
-> Ord Whitelist
Whitelist -> Whitelist -> Bool
Whitelist -> Whitelist -> Ordering
Whitelist -> Whitelist -> Whitelist
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
min :: Whitelist -> Whitelist -> Whitelist
$cmin :: Whitelist -> Whitelist -> Whitelist
max :: Whitelist -> Whitelist -> Whitelist
$cmax :: Whitelist -> Whitelist -> Whitelist
>= :: Whitelist -> Whitelist -> Bool
$c>= :: Whitelist -> Whitelist -> Bool
> :: Whitelist -> Whitelist -> Bool
$c> :: Whitelist -> Whitelist -> Bool
<= :: Whitelist -> Whitelist -> Bool
$c<= :: Whitelist -> Whitelist -> Bool
< :: Whitelist -> Whitelist -> Bool
$c< :: Whitelist -> Whitelist -> Bool
compare :: Whitelist -> Whitelist -> Ordering
$ccompare :: Whitelist -> Whitelist -> Ordering
$cp1Ord :: Eq Whitelist
Ord, Int -> Whitelist -> ShowS
[Whitelist] -> ShowS
Whitelist -> String
(Int -> Whitelist -> ShowS)
-> (Whitelist -> String)
-> ([Whitelist] -> ShowS)
-> Show Whitelist
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Whitelist] -> ShowS
$cshowList :: [Whitelist] -> ShowS
show :: Whitelist -> String
$cshow :: Whitelist -> String
showsPrec :: Int -> Whitelist -> ShowS
$cshowsPrec :: Int -> Whitelist -> ShowS
Show, ReadPrec [Whitelist]
ReadPrec Whitelist
Int -> ReadS Whitelist
ReadS [Whitelist]
(Int -> ReadS Whitelist)
-> ReadS [Whitelist]
-> ReadPrec Whitelist
-> ReadPrec [Whitelist]
-> Read Whitelist
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Whitelist]
$creadListPrec :: ReadPrec [Whitelist]
readPrec :: ReadPrec Whitelist
$creadPrec :: ReadPrec Whitelist
readList :: ReadS [Whitelist]
$creadList :: ReadS [Whitelist]
readsPrec :: Int -> ReadS Whitelist
$creadsPrec :: Int -> ReadS Whitelist
Read, (forall x. Whitelist -> Rep Whitelist x)
-> (forall x. Rep Whitelist x -> Whitelist) -> Generic Whitelist
forall x. Rep Whitelist x -> Whitelist
forall x. Whitelist -> Rep Whitelist x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Whitelist x -> Whitelist
$cfrom :: forall x. Whitelist -> Rep Whitelist x
Generic, Typeable, Get Whitelist
[Whitelist] -> Put
Whitelist -> Put
(Whitelist -> Put)
-> Get Whitelist -> ([Whitelist] -> Put) -> Binary Whitelist
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [Whitelist] -> Put
$cputList :: [Whitelist] -> Put
get :: Get Whitelist
$cget :: Get Whitelist
put :: Whitelist -> Put
$cput :: Whitelist -> Put
Binary)
filterByWhitelist :: Foldable f => Whitelist -> TrustChain f a -> [TrustChain f a]
filterByWhitelist :: Whitelist -> TrustChain f a -> [TrustChain f a]
filterByWhitelist Whitelist
_ (Trustless a
_) = []
filterByWhitelist w :: Whitelist
w@(Whitelist Set PublicKey
ws) (TrustProxy Signed (f (TrustChain f a))
s) = if Signed (f (TrustChain f a)) -> PublicKey
forall a. Signed a -> PublicKey
signedBy Signed (f (TrustChain f a))
s PublicKey -> Set PublicKey -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set PublicKey
ws then [Signed (f (TrustChain f a)) -> TrustChain f a
forall (f :: * -> *) a.
Signed (f (TrustChain f a)) -> TrustChain f a
TrustProxy Signed (f (TrustChain f a))
s] else f (TrustChain f a) -> [TrustChain f a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Signed (f (TrustChain f a)) -> f (TrustChain f a)
forall a. Signed a -> a
signed Signed (f (TrustChain f a))
s) [TrustChain f a]
-> (TrustChain f a -> [TrustChain f a]) -> [TrustChain f a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Whitelist -> TrustChain f a -> [TrustChain f a]
forall (f :: * -> *) a.
Foldable f =>
Whitelist -> TrustChain f a -> [TrustChain f a]
filterByWhitelist Whitelist
w
validTrustChain :: (Binary a, Binary (f (TrustChain f a)), Foldable f) => TrustChain f a -> Bool
validTrustChain :: TrustChain f a -> Bool
validTrustChain (Trustless a
_) = Bool
True
validTrustChain (TrustProxy Signed (f (TrustChain f a))
s) = Signed (f (TrustChain f a)) -> Bool
forall a. Signed a -> Bool
verifySigned Signed (f (TrustChain f a))
s Bool -> Bool -> Bool
&& All -> Bool
getAll ((TrustChain f a -> All) -> f (TrustChain f a) -> All
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Bool -> All
All (Bool -> All) -> (TrustChain f a -> Bool) -> TrustChain f a -> All
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TrustChain f a -> Bool
forall a (f :: * -> *).
(Binary a, Binary (f (TrustChain f a)), Foldable f) =>
TrustChain f a -> Bool
validTrustChain) (Signed (f (TrustChain f a)) -> f (TrustChain f a)
forall a. Signed a -> a
signed Signed (f (TrustChain f a))
s))
mkTrustProxy ::
( Traversable f
, Binary (f (TrustChain f a))
)
=> PrivateKey
-> f (TrustChain f a)
-> IO (TrustChain f a)
mkTrustProxy :: PrivateKey -> f (TrustChain f a) -> IO (TrustChain f a)
mkTrustProxy PrivateKey
privateKey f (TrustChain f a)
layer = Signed (f (TrustChain f a)) -> TrustChain f a
forall (f :: * -> *) a.
Signed (f (TrustChain f a)) -> TrustChain f a
TrustProxy (Signed (f (TrustChain f a)) -> TrustChain f a)
-> IO (Signed (f (TrustChain f a))) -> IO (TrustChain f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PrivateKey
-> f (TrustChain f a) -> IO (Signed (f (TrustChain f a)))
forall a. Binary a => PrivateKey -> a -> IO (Signed a)
mkSigned PrivateKey
privateKey f (TrustChain f a)
layer
mkTrustless :: a -> TrustChain f a
mkTrustless :: a -> TrustChain f a
mkTrustless = a -> TrustChain f a
forall (f :: * -> *) a. a -> TrustChain f a
Trustless
data Claim a = Claim [PublicKey] a
deriving (Claim a -> Claim a -> Bool
(Claim a -> Claim a -> Bool)
-> (Claim a -> Claim a -> Bool) -> Eq (Claim a)
forall a. Eq a => Claim a -> Claim a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Claim a -> Claim a -> Bool
$c/= :: forall a. Eq a => Claim a -> Claim a -> Bool
== :: Claim a -> Claim a -> Bool
$c== :: forall a. Eq a => Claim a -> Claim a -> Bool
Eq, Eq (Claim a)
Eq (Claim a)
-> (Claim a -> Claim a -> Ordering)
-> (Claim a -> Claim a -> Bool)
-> (Claim a -> Claim a -> Bool)
-> (Claim a -> Claim a -> Bool)
-> (Claim a -> Claim a -> Bool)
-> (Claim a -> Claim a -> Claim a)
-> (Claim a -> Claim a -> Claim a)
-> Ord (Claim a)
Claim a -> Claim a -> Bool
Claim a -> Claim a -> Ordering
Claim a -> Claim a -> Claim a
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
forall a. Ord a => Eq (Claim a)
forall a. Ord a => Claim a -> Claim a -> Bool
forall a. Ord a => Claim a -> Claim a -> Ordering
forall a. Ord a => Claim a -> Claim a -> Claim a
min :: Claim a -> Claim a -> Claim a
$cmin :: forall a. Ord a => Claim a -> Claim a -> Claim a
max :: Claim a -> Claim a -> Claim a
$cmax :: forall a. Ord a => Claim a -> Claim a -> Claim a
>= :: Claim a -> Claim a -> Bool
$c>= :: forall a. Ord a => Claim a -> Claim a -> Bool
> :: Claim a -> Claim a -> Bool
$c> :: forall a. Ord a => Claim a -> Claim a -> Bool
<= :: Claim a -> Claim a -> Bool
$c<= :: forall a. Ord a => Claim a -> Claim a -> Bool
< :: Claim a -> Claim a -> Bool
$c< :: forall a. Ord a => Claim a -> Claim a -> Bool
compare :: Claim a -> Claim a -> Ordering
$ccompare :: forall a. Ord a => Claim a -> Claim a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Claim a)
Ord, Int -> Claim a -> ShowS
[Claim a] -> ShowS
Claim a -> String
(Int -> Claim a -> ShowS)
-> (Claim a -> String) -> ([Claim a] -> ShowS) -> Show (Claim a)
forall a. Show a => Int -> Claim a -> ShowS
forall a. Show a => [Claim a] -> ShowS
forall a. Show a => Claim a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Claim a] -> ShowS
$cshowList :: forall a. Show a => [Claim a] -> ShowS
show :: Claim a -> String
$cshow :: forall a. Show a => Claim a -> String
showsPrec :: Int -> Claim a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Claim a -> ShowS
Show, ReadPrec [Claim a]
ReadPrec (Claim a)
Int -> ReadS (Claim a)
ReadS [Claim a]
(Int -> ReadS (Claim a))
-> ReadS [Claim a]
-> ReadPrec (Claim a)
-> ReadPrec [Claim a]
-> Read (Claim a)
forall a. Read a => ReadPrec [Claim a]
forall a. Read a => ReadPrec (Claim a)
forall a. Read a => Int -> ReadS (Claim a)
forall a. Read a => ReadS [Claim a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Claim a]
$creadListPrec :: forall a. Read a => ReadPrec [Claim a]
readPrec :: ReadPrec (Claim a)
$creadPrec :: forall a. Read a => ReadPrec (Claim a)
readList :: ReadS [Claim a]
$creadList :: forall a. Read a => ReadS [Claim a]
readsPrec :: Int -> ReadS (Claim a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Claim a)
Read, Typeable, (forall x. Claim a -> Rep (Claim a) x)
-> (forall x. Rep (Claim a) x -> Claim a) -> Generic (Claim a)
forall x. Rep (Claim a) x -> Claim a
forall x. Claim a -> Rep (Claim a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Claim a) x -> Claim a
forall a x. Claim a -> Rep (Claim a) x
$cto :: forall a x. Rep (Claim a) x -> Claim a
$cfrom :: forall a x. Claim a -> Rep (Claim a) x
Generic, Get (Claim a)
[Claim a] -> Put
Claim a -> Put
(Claim a -> Put)
-> Get (Claim a) -> ([Claim a] -> Put) -> Binary (Claim a)
forall a. Binary a => Get (Claim a)
forall a. Binary a => [Claim a] -> Put
forall a. Binary a => Claim a -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [Claim a] -> Put
$cputList :: forall a. Binary a => [Claim a] -> Put
get :: Get (Claim a)
$cget :: forall a. Binary a => Get (Claim a)
put :: Claim a -> Put
$cput :: forall a. Binary a => Claim a -> Put
Binary)
data Inconsistency e a =
IncompatibleClaim e (Claim a) [Claim a]
deriving (Inconsistency e a -> Inconsistency e a -> Bool
(Inconsistency e a -> Inconsistency e a -> Bool)
-> (Inconsistency e a -> Inconsistency e a -> Bool)
-> Eq (Inconsistency e a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall e a.
(Eq e, Eq a) =>
Inconsistency e a -> Inconsistency e a -> Bool
/= :: Inconsistency e a -> Inconsistency e a -> Bool
$c/= :: forall e a.
(Eq e, Eq a) =>
Inconsistency e a -> Inconsistency e a -> Bool
== :: Inconsistency e a -> Inconsistency e a -> Bool
$c== :: forall e a.
(Eq e, Eq a) =>
Inconsistency e a -> Inconsistency e a -> Bool
Eq, Eq (Inconsistency e a)
Eq (Inconsistency e a)
-> (Inconsistency e a -> Inconsistency e a -> Ordering)
-> (Inconsistency e a -> Inconsistency e a -> Bool)
-> (Inconsistency e a -> Inconsistency e a -> Bool)
-> (Inconsistency e a -> Inconsistency e a -> Bool)
-> (Inconsistency e a -> Inconsistency e a -> Bool)
-> (Inconsistency e a -> Inconsistency e a -> Inconsistency e a)
-> (Inconsistency e a -> Inconsistency e a -> Inconsistency e a)
-> Ord (Inconsistency e a)
Inconsistency e a -> Inconsistency e a -> Bool
Inconsistency e a -> Inconsistency e a -> Ordering
Inconsistency e a -> Inconsistency e a -> Inconsistency e a
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
forall e a. (Ord e, Ord a) => Eq (Inconsistency e a)
forall e a.
(Ord e, Ord a) =>
Inconsistency e a -> Inconsistency e a -> Bool
forall e a.
(Ord e, Ord a) =>
Inconsistency e a -> Inconsistency e a -> Ordering
forall e a.
(Ord e, Ord a) =>
Inconsistency e a -> Inconsistency e a -> Inconsistency e a
min :: Inconsistency e a -> Inconsistency e a -> Inconsistency e a
$cmin :: forall e a.
(Ord e, Ord a) =>
Inconsistency e a -> Inconsistency e a -> Inconsistency e a
max :: Inconsistency e a -> Inconsistency e a -> Inconsistency e a
$cmax :: forall e a.
(Ord e, Ord a) =>
Inconsistency e a -> Inconsistency e a -> Inconsistency e a
>= :: Inconsistency e a -> Inconsistency e a -> Bool
$c>= :: forall e a.
(Ord e, Ord a) =>
Inconsistency e a -> Inconsistency e a -> Bool
> :: Inconsistency e a -> Inconsistency e a -> Bool
$c> :: forall e a.
(Ord e, Ord a) =>
Inconsistency e a -> Inconsistency e a -> Bool
<= :: Inconsistency e a -> Inconsistency e a -> Bool
$c<= :: forall e a.
(Ord e, Ord a) =>
Inconsistency e a -> Inconsistency e a -> Bool
< :: Inconsistency e a -> Inconsistency e a -> Bool
$c< :: forall e a.
(Ord e, Ord a) =>
Inconsistency e a -> Inconsistency e a -> Bool
compare :: Inconsistency e a -> Inconsistency e a -> Ordering
$ccompare :: forall e a.
(Ord e, Ord a) =>
Inconsistency e a -> Inconsistency e a -> Ordering
$cp1Ord :: forall e a. (Ord e, Ord a) => Eq (Inconsistency e a)
Ord, Int -> Inconsistency e a -> ShowS
[Inconsistency e a] -> ShowS
Inconsistency e a -> String
(Int -> Inconsistency e a -> ShowS)
-> (Inconsistency e a -> String)
-> ([Inconsistency e a] -> ShowS)
-> Show (Inconsistency e a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall e a. (Show e, Show a) => Int -> Inconsistency e a -> ShowS
forall e a. (Show e, Show a) => [Inconsistency e a] -> ShowS
forall e a. (Show e, Show a) => Inconsistency e a -> String
showList :: [Inconsistency e a] -> ShowS
$cshowList :: forall e a. (Show e, Show a) => [Inconsistency e a] -> ShowS
show :: Inconsistency e a -> String
$cshow :: forall e a. (Show e, Show a) => Inconsistency e a -> String
showsPrec :: Int -> Inconsistency e a -> ShowS
$cshowsPrec :: forall e a. (Show e, Show a) => Int -> Inconsistency e a -> ShowS
Show, ReadPrec [Inconsistency e a]
ReadPrec (Inconsistency e a)
Int -> ReadS (Inconsistency e a)
ReadS [Inconsistency e a]
(Int -> ReadS (Inconsistency e a))
-> ReadS [Inconsistency e a]
-> ReadPrec (Inconsistency e a)
-> ReadPrec [Inconsistency e a]
-> Read (Inconsistency e a)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall e a. (Read e, Read a) => ReadPrec [Inconsistency e a]
forall e a. (Read e, Read a) => ReadPrec (Inconsistency e a)
forall e a. (Read e, Read a) => Int -> ReadS (Inconsistency e a)
forall e a. (Read e, Read a) => ReadS [Inconsistency e a]
readListPrec :: ReadPrec [Inconsistency e a]
$creadListPrec :: forall e a. (Read e, Read a) => ReadPrec [Inconsistency e a]
readPrec :: ReadPrec (Inconsistency e a)
$creadPrec :: forall e a. (Read e, Read a) => ReadPrec (Inconsistency e a)
readList :: ReadS [Inconsistency e a]
$creadList :: forall e a. (Read e, Read a) => ReadS [Inconsistency e a]
readsPrec :: Int -> ReadS (Inconsistency e a)
$creadsPrec :: forall e a. (Read e, Read a) => Int -> ReadS (Inconsistency e a)
Read, Typeable, (forall x. Inconsistency e a -> Rep (Inconsistency e a) x)
-> (forall x. Rep (Inconsistency e a) x -> Inconsistency e a)
-> Generic (Inconsistency e a)
forall x. Rep (Inconsistency e a) x -> Inconsistency e a
forall x. Inconsistency e a -> Rep (Inconsistency e a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall e a x. Rep (Inconsistency e a) x -> Inconsistency e a
forall e a x. Inconsistency e a -> Rep (Inconsistency e a) x
$cto :: forall e a x. Rep (Inconsistency e a) x -> Inconsistency e a
$cfrom :: forall e a x. Inconsistency e a -> Rep (Inconsistency e a) x
Generic, Get (Inconsistency e a)
[Inconsistency e a] -> Put
Inconsistency e a -> Put
(Inconsistency e a -> Put)
-> Get (Inconsistency e a)
-> ([Inconsistency e a] -> Put)
-> Binary (Inconsistency e a)
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
forall e a. (Binary e, Binary a) => Get (Inconsistency e a)
forall e a. (Binary e, Binary a) => [Inconsistency e a] -> Put
forall e a. (Binary e, Binary a) => Inconsistency e a -> Put
putList :: [Inconsistency e a] -> Put
$cputList :: forall e a. (Binary e, Binary a) => [Inconsistency e a] -> Put
get :: Get (Inconsistency e a)
$cget :: forall e a. (Binary e, Binary a) => Get (Inconsistency e a)
put :: Inconsistency e a -> Put
$cput :: forall e a. (Binary e, Binary a) => Inconsistency e a -> Put
Binary)
claims :: Foldable f => TrustChain f a -> [Claim a]
claims :: TrustChain f a -> [Claim a]
claims = \case
Trustless a
a -> [[PublicKey] -> a -> Claim a
forall a. [PublicKey] -> a -> Claim a
Claim [] a
a]
TrustProxy Signed (f (TrustChain f a))
s -> (\(Claim [PublicKey]
ps a
a) -> [PublicKey] -> a -> Claim a
forall a. [PublicKey] -> a -> Claim a
Claim (Signed (f (TrustChain f a)) -> PublicKey
forall a. Signed a -> PublicKey
signedBy Signed (f (TrustChain f a))
s PublicKey -> [PublicKey] -> [PublicKey]
forall a. a -> [a] -> [a]
: [PublicKey]
ps) a
a) (Claim a -> Claim a) -> [Claim a] -> [Claim a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TrustChain f a -> [Claim a]) -> f (TrustChain f a) -> [Claim a]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap TrustChain f a -> [Claim a]
forall (f :: * -> *) a. Foldable f => TrustChain f a -> [Claim a]
claims (Signed (f (TrustChain f a)) -> f (TrustChain f a)
forall a. Signed a -> a
signed Signed (f (TrustChain f a))
s)
claimants :: (Ord k, Ord a) => (a -> k) -> [Claim a] -> Map k (Map a (Set [PublicKey]))
claimants :: (a -> k) -> [Claim a] -> Map k (Map a (Set [PublicKey]))
claimants a -> k
i [Claim a]
cs = (Map a (Set [PublicKey])
-> Map a (Set [PublicKey]) -> Map a (Set [PublicKey]))
-> [(k, Map a (Set [PublicKey]))]
-> Map k (Map a (Set [PublicKey]))
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith ((Set [PublicKey] -> Set [PublicKey] -> Set [PublicKey])
-> Map a (Set [PublicKey])
-> Map a (Set [PublicKey])
-> Map a (Set [PublicKey])
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Set [PublicKey] -> Set [PublicKey] -> Set [PublicKey]
forall a. Semigroup a => a -> a -> a
(<>)) [ (k
k, a -> Set [PublicKey] -> Map a (Set [PublicKey])
forall k a. k -> a -> Map k a
Map.singleton a
a ([PublicKey] -> Set [PublicKey]
forall a. a -> Set a
Set.singleton [PublicKey]
ps)) | Claim [PublicKey]
ps a
a <- [Claim a]
cs, let k :: k
k = a -> k
i a
a ]
assignments :: Ord k => (a -> k) -> Merge e a a -> [Claim a] -> Either (Inconsistency e a) (Map k a)
assignments :: (a -> k)
-> Merge e a a -> [Claim a] -> Either (Inconsistency e a) (Map k a)
assignments a -> k
getKey Merge e a a
f [Claim a]
cs = Map k (a, [Claim a])
-> [Claim a] -> Either (Inconsistency e a) (Map k a)
go Map k (a, [Claim a])
forall k a. Map k a
Map.empty [Claim a]
cs where
go :: Map k (a, [Claim a])
-> [Claim a] -> Either (Inconsistency e a) (Map k a)
go Map k (a, [Claim a])
as [] = Map k a -> Either (Inconsistency e a) (Map k a)
forall a b. b -> Either a b
Right (((a, [Claim a]) -> a) -> Map k (a, [Claim a]) -> Map k a
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (a, [Claim a]) -> a
forall a b. (a, b) -> a
fst Map k (a, [Claim a])
as)
go Map k (a, [Claim a])
as (Claim [PublicKey]
ps a
a : [Claim a]
xxs) =
case k -> Map k (a, [Claim a]) -> Maybe (a, [Claim a])
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (a -> k
getKey a
a) Map k (a, [Claim a])
as of
Just (a
a', [Claim a]
pss) -> case Merge e a a -> a -> a -> Validation e a
forall e x a. Merge e x a -> x -> x -> Validation e a
runMerge Merge e a a
f a
a a
a' of
Success a
a'' -> Map k (a, [Claim a])
-> [Claim a] -> Either (Inconsistency e a) (Map k a)
go (((a, [Claim a]) -> (a, [Claim a]))
-> k -> Map k (a, [Claim a]) -> Map k (a, [Claim a])
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\(a, [Claim a])
_ -> (a
a'', [PublicKey] -> a -> Claim a
forall a. [PublicKey] -> a -> Claim a
Claim [PublicKey]
ps a
a Claim a -> [Claim a] -> [Claim a]
forall a. a -> [a] -> [a]
: [Claim a]
pss)) (a -> k
getKey a
a) Map k (a, [Claim a])
as) [Claim a]
xxs
Error e
e -> Inconsistency e a -> Either (Inconsistency e a) (Map k a)
forall a b. a -> Either a b
Left (e -> Claim a -> [Claim a] -> Inconsistency e a
forall e a. e -> Claim a -> [Claim a] -> Inconsistency e a
IncompatibleClaim e
e ([PublicKey] -> a -> Claim a
forall a. [PublicKey] -> a -> Claim a
Claim [PublicKey]
ps a
a) [Claim a]
pss)
Maybe (a, [Claim a])
Nothing -> Map k (a, [Claim a])
-> [Claim a] -> Either (Inconsistency e a) (Map k a)
go (k -> (a, [Claim a]) -> Map k (a, [Claim a]) -> Map k (a, [Claim a])
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (a -> k
getKey a
a) (a
a, [[PublicKey] -> a -> Claim a
forall a. [PublicKey] -> a -> Claim a
Claim [PublicKey]
ps a
a]) Map k (a, [Claim a])
as) [Claim a]
xxs