{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
module Data.TrustChain
  ( 
    -- * Trust Chains
    TrustChain (..)
  , validTrustChain
  , mkTrustProxy
  , mkTrustless
    -- * White Lists
  , Whitelist (..)
  , filterByWhitelist
    -- * Claims
  , Claim (..)
  , claims
  , claimants
    -- * Index and Merge
  , assignments 
    -- * Inconsistencies
  , Inconsistency (..)
    -- * Re-Exports from Cropty
  , PublicKey
  , PrivateKey
  , Signed(..)
    -- * Re-Exports from Data.Merge
  , 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

-- | A tree of trust of the given shape, where each internal node of the
-- tree is signed by potentially different keys. @TrustChain Identity a@
-- is a linear signature chain, whereas @TrustChain NonEmpty a@ is a tree
-- shaped trust chain. We can keep track of metadata at each internal
-- node of any structure using @TrustChain (Compose ((,) metadata) f) a@.
--
-- For those who are familiar with the free monad, you can think of this
-- as a free monad where the internal nodes are signed by differing parties.
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')

-- | A set of 'PublicKey's we accept information from.
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)

-- | Strips out all elements of the chain which aren't rooted by someone in
-- our whitelist, creating a forest of 'TrustChain's instead of a single one.
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

-- | Check that the trust chain has been legitimately signed. Once you receive
-- 'True' from this function, you can be certain that all of the 'Signed'
-- types within are truly correct.
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))

-- | Extend the trust chain with new subchains and new items.
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

-- | Make a basic, trustless trust chain.
mkTrustless :: a -> TrustChain f a
mkTrustless :: a -> TrustChain f a
mkTrustless = a -> TrustChain f a
forall (f :: * -> *) a. a -> TrustChain f a
Trustless

-- |
-- A path through the trust chain.
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)

-- |
-- An inconsistency with the various accounts in the trust chain
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)

-- |
-- Extract all of the claims from the trust chain.
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)

-- |
-- Index the claimants by what they're claiming, using the given indexing function.
--
-- The mental model here should something like @k = PublicKey@ and @a = Person@. What
-- we're doing is figuring out, for every different 'PublicKey' contained in the @Trustless@
-- node in our 'TrustChain', all of the different variations and series of signatures which lead up to those variations (along with who assented to those accounts).
--
-- There is no 'Merge'ing here, in particular. This is the way to splay out all of the different realities and the sequences of
-- 'PublicKey' which signed that particular variation (at one time or another).
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 ]

-- | 
-- Extract all of the assignments from the trust chain, unifying information contained
-- within them. This is where we might find potential inconsistencies.
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