ouroboros-network-protocols
Safe HaskellNone
LanguageHaskell2010

Ouroboros.Network.Protocol.LocalStateQuery.Type

Description

The type of the local ledger state query protocol.

This is used by local clients (like wallets and CLI tools) to query the ledger state of a local node.

Synopsis

Documentation

data LocalStateQuery block point (query :: Type -> Type) where Source #

The kind of the local state query protocol, and the types of the states in the protocol state machine.

It is parametrised over the type of block (for points), the type of queries and query results.

Constructors

StIdle :: forall block point (query :: Type -> Type). LocalStateQuery block point query

The client has agency. It can ask to acquire a state or terminate.

There is no timeout in this state.

StAcquiring :: forall block point (query :: Type -> Type). LocalStateQuery block point query

The server has agency. It must acquire the state at the requested point or report a failure.

There is a timeout in this state.

StAcquired :: forall block point (query :: Type -> Type). LocalStateQuery block point query

The client has agency. It can request queries against the current state, or it can release the state.

StQuerying :: forall block point (query :: Type -> Type) result. result -> LocalStateQuery block point query

The server has agency. It must respond with the query result.

StDone :: forall block point (query :: Type -> Type). LocalStateQuery block point query

Nobody has agency. The terminal state.

Instances

Instances details
(ShowProxy block, ShowProxy query) => ShowProxy (LocalStateQuery block point query :: Type) Source # 
Instance details

Defined in Ouroboros.Network.Protocol.LocalStateQuery.Type

Methods

showProxy :: Proxy (LocalStateQuery block point query) -> String #

(ShowQuery query, Show point) => Show (AnyMessage (LocalStateQuery block point query) (State :: LocalStateQuery block point query -> Type)) Source # 
Instance details

Defined in Ouroboros.Network.Protocol.LocalStateQuery.Type

Methods

showsPrec :: Int -> AnyMessage (LocalStateQuery block point query) (State :: LocalStateQuery block point query -> Type) -> ShowS #

show :: AnyMessage (LocalStateQuery block point query) (State :: LocalStateQuery block point query -> Type) -> String #

showList :: [AnyMessage (LocalStateQuery block point query) (State :: LocalStateQuery block point query -> Type)] -> ShowS #

(forall result. NFData (query result), NFData point) => NFData (Message (LocalStateQuery block point query) from to) Source # 
Instance details

Defined in Ouroboros.Network.Protocol.LocalStateQuery.Type

Methods

rnf :: Message (LocalStateQuery block point query) from to -> () #

Protocol (LocalStateQuery block point query) Source # 
Instance details

Defined in Ouroboros.Network.Protocol.LocalStateQuery.Type

Associated Types

type StateToken 
Instance details

Defined in Ouroboros.Network.Protocol.LocalStateQuery.Type

type StateToken = SingLocalStateQuery :: LocalStateQuery block point query -> Type
StateTokenI ('StAcquired :: LocalStateQuery block point query) Source # 
Instance details

Defined in Ouroboros.Network.Protocol.LocalStateQuery.Type

Methods

stateToken :: StateToken ('StAcquired :: LocalStateQuery block point query) #

StateTokenI ('StAcquiring :: LocalStateQuery block point query) Source # 
Instance details

Defined in Ouroboros.Network.Protocol.LocalStateQuery.Type

Methods

stateToken :: StateToken ('StAcquiring :: LocalStateQuery block point query) #

StateTokenI ('StDone :: LocalStateQuery block point query) Source # 
Instance details

Defined in Ouroboros.Network.Protocol.LocalStateQuery.Type

Methods

stateToken :: StateToken ('StDone :: LocalStateQuery block point query) #

StateTokenI ('StIdle :: LocalStateQuery block point query) Source # 
Instance details

Defined in Ouroboros.Network.Protocol.LocalStateQuery.Type

Methods

stateToken :: StateToken ('StIdle :: LocalStateQuery block point query) #

StateTokenI ('StQuerying result :: LocalStateQuery block point query) Source # 
Instance details

Defined in Ouroboros.Network.Protocol.LocalStateQuery.Type

Methods

stateToken :: StateToken ('StQuerying result :: LocalStateQuery block point query) #

data Message (LocalStateQuery block point query) (from :: LocalStateQuery block point query) (to :: LocalStateQuery block point query) Source # 
Instance details

Defined in Ouroboros.Network.Protocol.LocalStateQuery.Type

data Message (LocalStateQuery block point query) (from :: LocalStateQuery block point query) (to :: LocalStateQuery block point query) where
type StateToken Source # 
Instance details

Defined in Ouroboros.Network.Protocol.LocalStateQuery.Type

type StateToken = SingLocalStateQuery :: LocalStateQuery block point query -> Type
type StateAgency ('StAcquired :: LocalStateQuery block point query) Source # 
Instance details

Defined in Ouroboros.Network.Protocol.LocalStateQuery.Type

type StateAgency ('StAcquired :: LocalStateQuery block point query) = 'ClientAgency
type StateAgency ('StAcquiring :: LocalStateQuery block point query) Source # 
Instance details

Defined in Ouroboros.Network.Protocol.LocalStateQuery.Type

type StateAgency ('StAcquiring :: LocalStateQuery block point query) = 'ServerAgency
type StateAgency ('StDone :: LocalStateQuery block point query) Source # 
Instance details

Defined in Ouroboros.Network.Protocol.LocalStateQuery.Type

type StateAgency ('StDone :: LocalStateQuery block point query) = 'NobodyAgency
type StateAgency ('StIdle :: LocalStateQuery block point query) Source # 
Instance details

Defined in Ouroboros.Network.Protocol.LocalStateQuery.Type

type StateAgency ('StIdle :: LocalStateQuery block point query) = 'ClientAgency
type StateAgency ('StQuerying result2 :: LocalStateQuery block point query) Source # 
Instance details

Defined in Ouroboros.Network.Protocol.LocalStateQuery.Type

type StateAgency ('StQuerying result2 :: LocalStateQuery block point query) = 'ServerAgency

data SingLocalStateQuery (k :: LocalStateQuery block point query) where Source #

Singletons for LocalStateQuery state types.

Constructors

SingIdle :: forall {block} {point} {query :: Type -> Type}. SingLocalStateQuery ('StIdle :: LocalStateQuery block point query) 
SingAcquiring :: forall {block} {point} {query :: Type -> Type}. SingLocalStateQuery ('StAcquiring :: LocalStateQuery block point query) 
SingAcquired :: forall {block} {point} {query :: Type -> Type}. SingLocalStateQuery ('StAcquired :: LocalStateQuery block point query) 
SingQuerying :: forall block point (query :: Type -> Type) result. SingLocalStateQuery ('StQuerying result :: LocalStateQuery block point query) 
SingDone :: forall {block} {point} {query :: Type -> Type}. SingLocalStateQuery ('StDone :: LocalStateQuery block point query) 

Instances

Instances details
(forall result. Show (query result)) => Show (SingLocalStateQuery k) Source # 
Instance details

Defined in Ouroboros.Network.Protocol.LocalStateQuery.Type

data Target point Source #

Constructors

VolatileTip

The tip of the volatile chain

Cannot fail to be acquired.

SpecificPoint point

A specified point

Fails to be acquired if the point is not between VolatileTip and ImmutableTip (inclusive).

ImmutableTip

The tip of the immutable chain

Cannot fail to be acquired.

Requires at least NodeToClientV_16.

Instances

Instances details
Functor Target Source # 
Instance details

Defined in Ouroboros.Network.Protocol.LocalStateQuery.Type

Methods

fmap :: (a -> b) -> Target a -> Target b #

(<$) :: a -> Target b -> Target a #

Foldable Target Source # 
Instance details

Defined in Ouroboros.Network.Protocol.LocalStateQuery.Type

Methods

fold :: Monoid m => Target m -> m #

foldMap :: Monoid m => (a -> m) -> Target a -> m #

foldMap' :: Monoid m => (a -> m) -> Target a -> m #

foldr :: (a -> b -> b) -> b -> Target a -> b #

foldr' :: (a -> b -> b) -> b -> Target a -> b #

foldl :: (b -> a -> b) -> b -> Target a -> b #

foldl' :: (b -> a -> b) -> b -> Target a -> b #

foldr1 :: (a -> a -> a) -> Target a -> a #

foldl1 :: (a -> a -> a) -> Target a -> a #

toList :: Target a -> [a] #

null :: Target a -> Bool #

length :: Target a -> Int #

elem :: Eq a => a -> Target a -> Bool #

maximum :: Ord a => Target a -> a #

minimum :: Ord a => Target a -> a #

sum :: Num a => Target a -> a #

product :: Num a => Target a -> a #

Traversable Target Source # 
Instance details

Defined in Ouroboros.Network.Protocol.LocalStateQuery.Type

Methods

traverse :: Applicative f => (a -> f b) -> Target a -> f (Target b) #

sequenceA :: Applicative f => Target (f a) -> f (Target a) #

mapM :: Monad m => (a -> m b) -> Target a -> m (Target b) #

sequence :: Monad m => Target (m a) -> m (Target a) #

NFData point => NFData (Target point) Source # 
Instance details

Defined in Ouroboros.Network.Protocol.LocalStateQuery.Type

Methods

rnf :: Target point -> () #

Generic (Target point) Source # 
Instance details

Defined in Ouroboros.Network.Protocol.LocalStateQuery.Type

Associated Types

type Rep (Target point) 
Instance details

Defined in Ouroboros.Network.Protocol.LocalStateQuery.Type

type Rep (Target point) = D1 ('MetaData "Target" "Ouroboros.Network.Protocol.LocalStateQuery.Type" "ouroboros-network-protocols-0.12.0.0-inplace" 'False) (C1 ('MetaCons "VolatileTip" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "SpecificPoint" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 point)) :+: C1 ('MetaCons "ImmutableTip" 'PrefixI 'False) (U1 :: Type -> Type)))

Methods

from :: Target point -> Rep (Target point) x #

to :: Rep (Target point) x -> Target point #

Show point => Show (Target point) Source # 
Instance details

Defined in Ouroboros.Network.Protocol.LocalStateQuery.Type

Methods

showsPrec :: Int -> Target point -> ShowS #

show :: Target point -> String #

showList :: [Target point] -> ShowS #

Eq point => Eq (Target point) Source # 
Instance details

Defined in Ouroboros.Network.Protocol.LocalStateQuery.Type

Methods

(==) :: Target point -> Target point -> Bool #

(/=) :: Target point -> Target point -> Bool #

Ord point => Ord (Target point) Source # 
Instance details

Defined in Ouroboros.Network.Protocol.LocalStateQuery.Type

Methods

compare :: Target point -> Target point -> Ordering #

(<) :: Target point -> Target point -> Bool #

(<=) :: Target point -> Target point -> Bool #

(>) :: Target point -> Target point -> Bool #

(>=) :: Target point -> Target point -> Bool #

max :: Target point -> Target point -> Target point #

min :: Target point -> Target point -> Target point #

type Rep (Target point) Source # 
Instance details

Defined in Ouroboros.Network.Protocol.LocalStateQuery.Type

type Rep (Target point) = D1 ('MetaData "Target" "Ouroboros.Network.Protocol.LocalStateQuery.Type" "ouroboros-network-protocols-0.12.0.0-inplace" 'False) (C1 ('MetaCons "VolatileTip" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "SpecificPoint" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 point)) :+: C1 ('MetaCons "ImmutableTip" 'PrefixI 'False) (U1 :: Type -> Type)))

data AcquireFailure Source #

Instances

Instances details
NFData AcquireFailure Source # 
Instance details

Defined in Ouroboros.Network.Protocol.LocalStateQuery.Type

Methods

rnf :: AcquireFailure -> () #

Enum AcquireFailure Source # 
Instance details

Defined in Ouroboros.Network.Protocol.LocalStateQuery.Type

Generic AcquireFailure Source # 
Instance details

Defined in Ouroboros.Network.Protocol.LocalStateQuery.Type

Associated Types

type Rep AcquireFailure 
Instance details

Defined in Ouroboros.Network.Protocol.LocalStateQuery.Type

type Rep AcquireFailure = D1 ('MetaData "AcquireFailure" "Ouroboros.Network.Protocol.LocalStateQuery.Type" "ouroboros-network-protocols-0.12.0.0-inplace" 'False) (C1 ('MetaCons "AcquireFailurePointTooOld" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "AcquireFailurePointNotOnChain" 'PrefixI 'False) (U1 :: Type -> Type))
Show AcquireFailure Source # 
Instance details

Defined in Ouroboros.Network.Protocol.LocalStateQuery.Type

Eq AcquireFailure Source # 
Instance details

Defined in Ouroboros.Network.Protocol.LocalStateQuery.Type

type Rep AcquireFailure Source # 
Instance details

Defined in Ouroboros.Network.Protocol.LocalStateQuery.Type

type Rep AcquireFailure = D1 ('MetaData "AcquireFailure" "Ouroboros.Network.Protocol.LocalStateQuery.Type" "ouroboros-network-protocols-0.12.0.0-inplace" 'False) (C1 ('MetaCons "AcquireFailurePointTooOld" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "AcquireFailurePointNotOnChain" 'PrefixI 'False) (U1 :: Type -> Type))

class (forall result. Show (query result)) => ShowQuery (query :: Type -> Type) where Source #

To implement Show for:

('Message' ('LocalStateQuery' block query) st st')

we need a way to print the query GADT and its type index, result. This class contain the method we need to provide this Show instance.

We use a type class for this, as this Show constraint propagates to a lot of places.

Methods

showResult :: query result -> result -> String Source #

data State (st :: LocalStateQuery block point query) where Source #

Constructors

StateIdle :: forall {block} {point} {query :: Type -> Type}. State ('StIdle :: LocalStateQuery block point query) 
StateAcquiring :: forall {block} {point} {query :: Type -> Type}. State ('StAcquiring :: LocalStateQuery block point query) 
StateAcquired :: forall {block} {point} {query :: Type -> Type}. State ('StAcquired :: LocalStateQuery block point query) 
StateQuerying :: forall (query :: Type -> Type) result block point. query result -> State ('StQuerying result :: LocalStateQuery block point query) 
StateDone :: forall {block} {point} {query :: Type -> Type}. State ('StDone :: LocalStateQuery block point query) 

Instances

Instances details
(ShowQuery query, Show point) => Show (AnyMessage (LocalStateQuery block point query) (State :: LocalStateQuery block point query -> Type)) Source # 
Instance details

Defined in Ouroboros.Network.Protocol.LocalStateQuery.Type

Methods

showsPrec :: Int -> AnyMessage (LocalStateQuery block point query) (State :: LocalStateQuery block point query -> Type) -> ShowS #

show :: AnyMessage (LocalStateQuery block point query) (State :: LocalStateQuery block point query -> Type) -> String #

showList :: [AnyMessage (LocalStateQuery block point query) (State :: LocalStateQuery block point query -> Type)] -> ShowS #

Show (State st) Source # 
Instance details

Defined in Ouroboros.Network.Protocol.LocalStateQuery.Type

Methods

showsPrec :: Int -> State st -> ShowS #

show :: State st -> String #

showList :: [State st] -> ShowS #