{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Ouroboros.Network.Protocol.ChainSync.Codec
( codecChainSync
, codecChainSyncId
, byteLimitsChainSync
, timeLimitsChainSync
, ChainSyncTimeout (..)
) where
import Control.Monad.Class.MonadST
import Control.Monad.Class.MonadTime.SI
import Network.TypedProtocol.Codec.CBOR
import Ouroboros.Network.Protocol.ChainSync.Type
import Ouroboros.Network.Protocol.Limits
import Data.ByteString.Lazy qualified as LBS
import Codec.CBOR.Decoding (decodeListLen, decodeWord)
import Codec.CBOR.Decoding qualified as CBOR
import Codec.CBOR.Encoding (encodeListLen, encodeWord)
import Codec.CBOR.Encoding qualified as CBOR
import Codec.CBOR.Read qualified as CBOR
import Text.Printf
byteLimitsChainSync :: forall bytes header point tip .
(bytes -> Word)
-> ProtocolSizeLimits (ChainSync header point tip) bytes
byteLimitsChainSync :: forall {k} {k1} {k2} bytes (header :: k) (point :: k1) (tip :: k2).
(bytes -> Word)
-> ProtocolSizeLimits (ChainSync header point tip) bytes
byteLimitsChainSync = (forall (pr :: PeerRole) (st :: ChainSync header point tip).
PeerHasAgency pr st -> Word)
-> (bytes -> Word)
-> ProtocolSizeLimits (ChainSync header point tip) bytes
forall ps bytes.
(forall (pr :: PeerRole) (st :: ps). PeerHasAgency pr st -> Word)
-> (bytes -> Word) -> ProtocolSizeLimits ps bytes
ProtocolSizeLimits PeerHasAgency pr st -> Word
forall (pr :: PeerRole) (st :: ChainSync header point tip).
PeerHasAgency pr st -> Word
stateToLimit
where
stateToLimit :: forall (pr :: PeerRole) (st :: ChainSync header point tip).
PeerHasAgency pr st -> Word
stateToLimit :: forall (pr :: PeerRole) (st :: ChainSync header point tip).
PeerHasAgency pr st -> Word
stateToLimit (ClientAgency ClientHasAgency st
R:ClientHasAgencyChainSyncst k k1 k2 header point tip st
TokIdle) = Word
smallByteLimit
stateToLimit (ServerAgency (TokNext TokNextKind k3
TokCanAwait)) = Word
smallByteLimit
stateToLimit (ServerAgency (TokNext TokNextKind k3
TokMustReply)) = Word
smallByteLimit
stateToLimit (ServerAgency ServerHasAgency st
R:ServerHasAgencyChainSyncst k k1 k2 header point tip st
TokIntersect) = Word
smallByteLimit
data ChainSyncTimeout = ChainSyncTimeout
{ ChainSyncTimeout -> Maybe DiffTime
canAwaitTimeout :: Maybe DiffTime
, ChainSyncTimeout -> Maybe DiffTime
intersectTimeout :: Maybe DiffTime
, ChainSyncTimeout -> Maybe DiffTime
mustReplyTimeout :: Maybe DiffTime
, ChainSyncTimeout -> Maybe DiffTime
idleTimeout :: Maybe DiffTime
}
timeLimitsChainSync :: forall header point tip.
ChainSyncTimeout
-> ProtocolTimeLimits (ChainSync header point tip)
timeLimitsChainSync :: forall {k} {k1} {k2} (header :: k) (point :: k1) (tip :: k2).
ChainSyncTimeout -> ProtocolTimeLimits (ChainSync header point tip)
timeLimitsChainSync ChainSyncTimeout
csTimeouts = (forall (pr :: PeerRole) (st :: ChainSync header point tip).
PeerHasAgency pr st -> Maybe DiffTime)
-> ProtocolTimeLimits (ChainSync header point tip)
forall ps.
(forall (pr :: PeerRole) (st :: ps).
PeerHasAgency pr st -> Maybe DiffTime)
-> ProtocolTimeLimits ps
ProtocolTimeLimits PeerHasAgency pr st -> Maybe DiffTime
forall (pr :: PeerRole) (st :: ChainSync header point tip).
PeerHasAgency pr st -> Maybe DiffTime
stateToLimit
where
ChainSyncTimeout
{ Maybe DiffTime
canAwaitTimeout :: ChainSyncTimeout -> Maybe DiffTime
canAwaitTimeout :: Maybe DiffTime
canAwaitTimeout
, Maybe DiffTime
intersectTimeout :: ChainSyncTimeout -> Maybe DiffTime
intersectTimeout :: Maybe DiffTime
intersectTimeout
, Maybe DiffTime
mustReplyTimeout :: ChainSyncTimeout -> Maybe DiffTime
mustReplyTimeout :: Maybe DiffTime
mustReplyTimeout
, Maybe DiffTime
idleTimeout :: ChainSyncTimeout -> Maybe DiffTime
idleTimeout :: Maybe DiffTime
idleTimeout
} = ChainSyncTimeout
csTimeouts
stateToLimit :: forall (pr :: PeerRole) (st :: ChainSync header point tip).
PeerHasAgency pr st -> Maybe DiffTime
stateToLimit :: forall (pr :: PeerRole) (st :: ChainSync header point tip).
PeerHasAgency pr st -> Maybe DiffTime
stateToLimit (ClientAgency ClientHasAgency st
R:ClientHasAgencyChainSyncst k k1 k2 header point tip st
TokIdle) = Maybe DiffTime
idleTimeout
stateToLimit (ServerAgency (TokNext TokNextKind k3
TokCanAwait)) = Maybe DiffTime
canAwaitTimeout
stateToLimit (ServerAgency (TokNext TokNextKind k3
TokMustReply)) = Maybe DiffTime
mustReplyTimeout
stateToLimit (ServerAgency ServerHasAgency st
R:ServerHasAgencyChainSyncst k k1 k2 header point tip st
TokIntersect) = Maybe DiffTime
intersectTimeout
codecChainSync
:: forall header point tip m.
(MonadST m)
=> (header -> CBOR.Encoding)
-> (forall s . CBOR.Decoder s header)
-> (point -> CBOR.Encoding)
-> (forall s . CBOR.Decoder s point)
-> (tip -> CBOR.Encoding)
-> (forall s. CBOR.Decoder s tip)
-> Codec (ChainSync header point tip)
CBOR.DeserialiseFailure m LBS.ByteString
codecChainSync :: forall header point tip (m :: * -> *).
MonadST m =>
(header -> Encoding)
-> (forall s. Decoder s header)
-> (point -> Encoding)
-> (forall s. Decoder s point)
-> (tip -> Encoding)
-> (forall s. Decoder s tip)
-> Codec
(ChainSync header point tip) DeserialiseFailure m ByteString
codecChainSync header -> Encoding
encodeHeader forall s. Decoder s header
decodeHeader
point -> Encoding
encodePoint forall s. Decoder s point
decodePoint
tip -> Encoding
encodeTip forall s. Decoder s tip
decodeTip =
(forall (pr :: PeerRole) (st :: ChainSync header point tip)
(st' :: ChainSync header point tip).
PeerHasAgency pr st
-> Message (ChainSync header point tip) st st' -> Encoding)
-> (forall (pr :: PeerRole) (st :: ChainSync header point tip) s.
PeerHasAgency pr st -> Decoder s (SomeMessage st))
-> Codec
(ChainSync header point tip) DeserialiseFailure m ByteString
forall ps (m :: * -> *).
MonadST m =>
(forall (pr :: PeerRole) (st :: ps) (st' :: ps).
PeerHasAgency pr st -> Message ps st st' -> Encoding)
-> (forall (pr :: PeerRole) (st :: ps) s.
PeerHasAgency pr st -> Decoder s (SomeMessage st))
-> Codec ps DeserialiseFailure m ByteString
mkCodecCborLazyBS PeerHasAgency pr st
-> Message (ChainSync header point tip) st st' -> Encoding
forall (pr :: PeerRole) (st :: ChainSync header point tip)
(st' :: ChainSync header point tip).
PeerHasAgency pr st
-> Message (ChainSync header point tip) st st' -> Encoding
encode PeerHasAgency pr st -> Decoder s (SomeMessage st)
forall (pr :: PeerRole) (st :: ChainSync header point tip) s.
PeerHasAgency pr st -> Decoder s (SomeMessage st)
decode
where
encode :: forall (pr :: PeerRole)
(st :: ChainSync header point tip)
(st' :: ChainSync header point tip).
PeerHasAgency pr st
-> Message (ChainSync header point tip) st st'
-> CBOR.Encoding
encode :: forall (pr :: PeerRole) (st :: ChainSync header point tip)
(st' :: ChainSync header point tip).
PeerHasAgency pr st
-> Message (ChainSync header point tip) st st' -> Encoding
encode (ClientAgency ClientHasAgency st
R:ClientHasAgencyChainSyncst (*) (*) (*) header point tip st
TokIdle) Message (ChainSync header point tip) st st'
R:MessageChainSyncfromto (*) (*) (*) header point tip st st'
MsgRequestNext =
Word -> Encoding
encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord Word
0
encode (ServerAgency TokNext{}) Message (ChainSync header point tip) st st'
R:MessageChainSyncfromto (*) (*) (*) header point tip st st'
MsgAwaitReply =
Word -> Encoding
encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord Word
1
encode (ServerAgency TokNext{}) (MsgRollForward header1
h tip1
tip) =
Word -> Encoding
encodeListLen Word
3
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord Word
2
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> header -> Encoding
encodeHeader header
header1
h
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> tip -> Encoding
encodeTip tip
tip1
tip
encode (ServerAgency TokNext{}) (MsgRollBackward point1
p tip1
tip) =
Word -> Encoding
encodeListLen Word
3
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord Word
3
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> point -> Encoding
encodePoint point
point1
p
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> tip -> Encoding
encodeTip tip
tip1
tip
encode (ClientAgency ClientHasAgency st
R:ClientHasAgencyChainSyncst (*) (*) (*) header point tip st
TokIdle) (MsgFindIntersect [point1]
ps) =
Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord Word
4 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (point -> Encoding) -> [point] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
encodeList point -> Encoding
encodePoint [point]
[point1]
ps
encode (ServerAgency ServerHasAgency st
R:ServerHasAgencyChainSyncst (*) (*) (*) header point tip st
TokIntersect) (MsgIntersectFound point1
p tip1
tip) =
Word -> Encoding
encodeListLen Word
3
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord Word
5
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> point -> Encoding
encodePoint point
point1
p
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> tip -> Encoding
encodeTip tip
tip1
tip
encode (ServerAgency ServerHasAgency st
R:ServerHasAgencyChainSyncst (*) (*) (*) header point tip st
TokIntersect) (MsgIntersectNotFound tip1
tip) =
Word -> Encoding
encodeListLen Word
2
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord Word
6
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> tip -> Encoding
encodeTip tip
tip1
tip
encode (ClientAgency ClientHasAgency st
R:ClientHasAgencyChainSyncst (*) (*) (*) header point tip st
TokIdle) Message (ChainSync header point tip) st st'
R:MessageChainSyncfromto (*) (*) (*) header point tip st st'
MsgDone =
Word -> Encoding
encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord Word
7
decode :: forall (pr :: PeerRole) (st :: ChainSync header point tip) s.
PeerHasAgency pr st
-> CBOR.Decoder s (SomeMessage st)
decode :: forall (pr :: PeerRole) (st :: ChainSync header point tip) s.
PeerHasAgency pr st -> Decoder s (SomeMessage st)
decode PeerHasAgency pr st
stok = do
len <- Decoder s Int
forall s. Decoder s Int
decodeListLen
key <- decodeWord
case (key, len, stok) of
(Word
0, Int
1, ClientAgency ClientHasAgency st
R:ClientHasAgencyChainSyncst (*) (*) (*) header point tip st
TokIdle) ->
SomeMessage st -> Decoder s (SomeMessage st)
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Message (ChainSync header point tip) st ('StNext 'StCanAwait)
-> SomeMessage st
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage Message (ChainSync header point tip) st ('StNext 'StCanAwait)
Message (ChainSync header point tip) 'StIdle ('StNext 'StCanAwait)
forall {k} {k1} {k2} (header :: k) (point :: k1) (tip :: k2).
Message (ChainSync header point tip) 'StIdle ('StNext 'StCanAwait)
MsgRequestNext)
(Word
1, Int
1, ServerAgency (TokNext TokNextKind k3
TokCanAwait)) ->
SomeMessage st -> Decoder s (SomeMessage st)
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Message (ChainSync header point tip) st ('StNext 'StMustReply)
-> SomeMessage st
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage Message (ChainSync header point tip) st ('StNext 'StMustReply)
Message
(ChainSync header point tip)
('StNext 'StCanAwait)
('StNext 'StMustReply)
forall {k} {k1} {k2} (header :: k) (point :: k1) (tip :: k2).
Message
(ChainSync header point tip)
('StNext 'StCanAwait)
('StNext 'StMustReply)
MsgAwaitReply)
(Word
2, Int
3, ServerAgency (TokNext TokNextKind k3
_)) -> do
h <- Decoder s header
forall s. Decoder s header
decodeHeader
tip <- decodeTip
return (SomeMessage (MsgRollForward h tip))
(Word
3, Int
3, ServerAgency (TokNext TokNextKind k3
_)) -> do
p <- Decoder s point
forall s. Decoder s point
decodePoint
tip <- decodeTip
return (SomeMessage (MsgRollBackward p tip))
(Word
4, Int
2, ClientAgency ClientHasAgency st
R:ClientHasAgencyChainSyncst (*) (*) (*) header point tip st
TokIdle) -> do
ps <- Decoder s point -> Decoder s [point]
forall s a. Decoder s a -> Decoder s [a]
decodeList Decoder s point
forall s. Decoder s point
decodePoint
return (SomeMessage (MsgFindIntersect ps))
(Word
5, Int
3, ServerAgency ServerHasAgency st
R:ServerHasAgencyChainSyncst (*) (*) (*) header point tip st
TokIntersect) -> do
p <- Decoder s point
forall s. Decoder s point
decodePoint
tip <- decodeTip
return (SomeMessage (MsgIntersectFound p tip))
(Word
6, Int
2, ServerAgency ServerHasAgency st
R:ServerHasAgencyChainSyncst (*) (*) (*) header point tip st
TokIntersect) -> do
tip <- Decoder s tip
forall s. Decoder s tip
decodeTip
return (SomeMessage (MsgIntersectNotFound tip))
(Word
7, Int
1, ClientAgency ClientHasAgency st
R:ClientHasAgencyChainSyncst (*) (*) (*) header point tip st
TokIdle) ->
SomeMessage st -> Decoder s (SomeMessage st)
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Message (ChainSync header point tip) st 'StDone -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage Message (ChainSync header point tip) st 'StDone
Message (ChainSync header point tip) 'StIdle 'StDone
forall {k} {k1} {k2} (header :: k) (point :: k1) (tip :: k2).
Message (ChainSync header point tip) 'StIdle 'StDone
MsgDone)
(Word
_, Int
_, ClientAgency ClientHasAgency st
R:ClientHasAgencyChainSyncst (*) (*) (*) header point tip st
TokIdle) ->
String -> Decoder s (SomeMessage st)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> String -> Word -> Int -> String
forall r. PrintfType r => String -> r
printf String
"codecChainSync (%s) unexpected key (%d, %d)" (PeerHasAgency pr st -> String
forall a. Show a => a -> String
show PeerHasAgency pr st
stok) Word
key Int
len)
(Word
_, Int
_, ServerAgency (TokNext TokNextKind k3
TokCanAwait)) ->
String -> Decoder s (SomeMessage st)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> String -> Word -> Int -> String
forall r. PrintfType r => String -> r
printf String
"codecChainSync (%s) unexpected key (%d, %d)" (PeerHasAgency pr st -> String
forall a. Show a => a -> String
show PeerHasAgency pr st
stok) Word
key Int
len)
(Word
_, Int
_, ServerAgency (TokNext TokNextKind k3
TokMustReply)) ->
String -> Decoder s (SomeMessage st)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> String -> Word -> Int -> String
forall r. PrintfType r => String -> r
printf String
"codecChainSync (%s) unexpected key (%d, %d)" (PeerHasAgency pr st -> String
forall a. Show a => a -> String
show PeerHasAgency pr st
stok) Word
key Int
len)
(Word
_, Int
_, ServerAgency ServerHasAgency st
R:ServerHasAgencyChainSyncst (*) (*) (*) header point tip st
TokIntersect) ->
String -> Decoder s (SomeMessage st)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> String -> Word -> Int -> String
forall r. PrintfType r => String -> r
printf String
"codecChainSync (%s) unexpected key (%d, %d)" (PeerHasAgency pr st -> String
forall a. Show a => a -> String
show PeerHasAgency pr st
stok) Word
key Int
len)
encodeList :: (a -> CBOR.Encoding) -> [a] -> CBOR.Encoding
encodeList :: forall a. (a -> Encoding) -> [a] -> Encoding
encodeList a -> Encoding
_ [] = Word -> Encoding
CBOR.encodeListLen Word
0
encodeList a -> Encoding
enc [a]
xs = Encoding
CBOR.encodeListLenIndef
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (a -> Encoding -> Encoding) -> Encoding -> [a] -> Encoding
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Prelude.foldr (\a
x Encoding
r -> a -> Encoding
enc a
x Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
r) Encoding
CBOR.encodeBreak [a]
xs
decodeList :: CBOR.Decoder s a -> CBOR.Decoder s [a]
decodeList :: forall s a. Decoder s a -> Decoder s [a]
decodeList Decoder s a
dec = do
mn <- Decoder s (Maybe Int)
forall s. Decoder s (Maybe Int)
CBOR.decodeListLenOrIndef
case mn of
Maybe Int
Nothing -> ([a] -> a -> [a])
-> [a] -> ([a] -> [a]) -> Decoder s a -> Decoder s [a]
forall r a r' s.
(r -> a -> r) -> r -> (r -> r') -> Decoder s a -> Decoder s r'
CBOR.decodeSequenceLenIndef ((a -> [a] -> [a]) -> [a] -> a -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) [] [a] -> [a]
forall a. [a] -> [a]
reverse Decoder s a
dec
Just Int
n -> ([a] -> a -> [a])
-> [a] -> ([a] -> [a]) -> Int -> Decoder s a -> Decoder s [a]
forall r a r' s.
(r -> a -> r)
-> r -> (r -> r') -> Int -> Decoder s a -> Decoder s r'
CBOR.decodeSequenceLenN ((a -> [a] -> [a]) -> [a] -> a -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) [] [a] -> [a]
forall a. [a] -> [a]
reverse Int
n Decoder s a
dec
codecChainSyncId :: forall header point tip m. Monad m
=> Codec (ChainSync header point tip)
CodecFailure m (AnyMessage (ChainSync header point tip))
codecChainSyncId :: forall {k} {k1} {k2} (header :: k) (point :: k1) (tip :: k2)
(m :: * -> *).
Monad m =>
Codec
(ChainSync header point tip)
CodecFailure
m
(AnyMessage (ChainSync header point tip))
codecChainSyncId = Codec { PeerHasAgency pr st
-> Message (ChainSync header point tip) st st'
-> AnyMessage (ChainSync header point tip)
forall (pr :: PeerRole) (st :: ChainSync header point tip)
(st' :: ChainSync header point tip).
PeerHasAgency pr st
-> Message (ChainSync header point tip) st st'
-> AnyMessage (ChainSync header point tip)
encode :: forall (pr :: PeerRole) (st :: ChainSync header point tip)
(st' :: ChainSync header point tip).
PeerHasAgency pr st
-> Message (ChainSync header point tip) st st'
-> AnyMessage (ChainSync header point tip)
encode :: forall (pr :: PeerRole) (st :: ChainSync header point tip)
(st' :: ChainSync header point tip).
PeerHasAgency pr st
-> Message (ChainSync header point tip) st st'
-> AnyMessage (ChainSync header point tip)
encode, PeerHasAgency pr st
-> m (DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st))
forall (pr :: PeerRole) (st :: ChainSync header point tip).
PeerHasAgency pr st
-> m (DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st))
decode :: forall (pr :: PeerRole) (st :: ChainSync header point tip).
PeerHasAgency pr st
-> m (DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st))
decode :: forall (pr :: PeerRole) (st :: ChainSync header point tip).
PeerHasAgency pr st
-> m (DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st))
decode }
where
encode :: forall (pr :: PeerRole) st st'.
PeerHasAgency pr st
-> Message (ChainSync header point tip) st st'
-> AnyMessage (ChainSync header point tip)
encode :: forall (pr :: PeerRole) (st :: ChainSync header point tip)
(st' :: ChainSync header point tip).
PeerHasAgency pr st
-> Message (ChainSync header point tip) st st'
-> AnyMessage (ChainSync header point tip)
encode PeerHasAgency pr st
_ = Message (ChainSync header point tip) st st'
-> AnyMessage (ChainSync header point tip)
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> AnyMessage ps
AnyMessage
decode :: forall (pr :: PeerRole) (st :: ChainSync header point tip).
PeerHasAgency pr st
-> m (DecodeStep (AnyMessage (ChainSync header point tip))
CodecFailure m (SomeMessage st))
decode :: forall (pr :: PeerRole) (st :: ChainSync header point tip).
PeerHasAgency pr st
-> m (DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st))
decode PeerHasAgency pr st
stok = DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st)
-> m (DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st)
-> m (DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st)))
-> DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st)
-> m (DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st))
forall a b. (a -> b) -> a -> b
$ (Maybe (AnyMessage (ChainSync header point tip))
-> m (DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st)))
-> DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st)
forall bytes failure (m :: * -> *) a.
(Maybe bytes -> m (DecodeStep bytes failure m a))
-> DecodeStep bytes failure m a
DecodePartial ((Maybe (AnyMessage (ChainSync header point tip))
-> m (DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st)))
-> DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st))
-> (Maybe (AnyMessage (ChainSync header point tip))
-> m (DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st)))
-> DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st)
forall a b. (a -> b) -> a -> b
$ \Maybe (AnyMessage (ChainSync header point tip))
bytes -> case (PeerHasAgency pr st
stok, Maybe (AnyMessage (ChainSync header point tip))
bytes) of
(PeerHasAgency pr st
_, Maybe (AnyMessage (ChainSync header point tip))
Nothing) -> DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st)
-> m (DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st)
-> m (DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st)))
-> DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st)
-> m (DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st))
forall a b. (a -> b) -> a -> b
$ CodecFailure
-> DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st)
forall bytes failure (m :: * -> *) a.
failure -> DecodeStep bytes failure m a
DecodeFail CodecFailure
CodecFailureOutOfInput
(ClientAgency ClientHasAgency st
R:ClientHasAgencyChainSyncst k k1 k2 header point tip st
TokIdle, Just (AnyMessage msg :: Message (ChainSync header point tip) st st'
msg@Message (ChainSync header point tip) st st'
R:MessageChainSyncfromto k k1 k2 header point tip st st'
MsgRequestNext)) -> DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st)
-> m (DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeMessage st
-> Maybe (AnyMessage (ChainSync header point tip))
-> DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st)
forall bytes failure (m :: * -> *) a.
a -> Maybe bytes -> DecodeStep bytes failure m a
DecodeDone (Message (ChainSync header point tip) st st' -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage Message (ChainSync header point tip) st st'
Message (ChainSync header point tip) st st'
msg) Maybe (AnyMessage (ChainSync header point tip))
forall a. Maybe a
Nothing)
(ServerAgency (TokNext TokNextKind k3
TokCanAwait), Just (AnyMessage msg :: Message (ChainSync header point tip) st st'
msg@Message (ChainSync header point tip) st st'
R:MessageChainSyncfromto k k1 k2 header point tip st st'
MsgAwaitReply)) -> DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st)
-> m (DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeMessage st
-> Maybe (AnyMessage (ChainSync header point tip))
-> DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st)
forall bytes failure (m :: * -> *) a.
a -> Maybe bytes -> DecodeStep bytes failure m a
DecodeDone (Message (ChainSync header point tip) st st' -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage Message (ChainSync header point tip) st st'
Message (ChainSync header point tip) st st'
msg) Maybe (AnyMessage (ChainSync header point tip))
forall a. Maybe a
Nothing)
(ServerAgency (TokNext TokNextKind k3
_), Just (AnyMessage (MsgRollForward header1
h tip1
tip))) -> DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st)
-> m (DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeMessage st
-> Maybe (AnyMessage (ChainSync header point tip))
-> DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st)
forall bytes failure (m :: * -> *) a.
a -> Maybe bytes -> DecodeStep bytes failure m a
DecodeDone (Message (ChainSync header point tip) st 'StIdle -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage (header1
-> tip1
-> Message (ChainSync header1 point tip1) ('StNext k3) 'StIdle
forall {k1} header1 tip1 (point :: k1) (any :: StNextKind).
header1
-> tip1
-> Message (ChainSync header1 point tip1) ('StNext any) 'StIdle
MsgRollForward header1
h tip1
tip)) Maybe (AnyMessage (ChainSync header point tip))
forall a. Maybe a
Nothing)
(ServerAgency (TokNext TokNextKind k3
_), Just (AnyMessage (MsgRollBackward point1
p tip1
tip))) -> DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st)
-> m (DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeMessage st
-> Maybe (AnyMessage (ChainSync header point tip))
-> DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st)
forall bytes failure (m :: * -> *) a.
a -> Maybe bytes -> DecodeStep bytes failure m a
DecodeDone (Message (ChainSync header point tip) st 'StIdle -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage (point1
-> tip1
-> Message (ChainSync header point1 tip1) ('StNext k3) 'StIdle
forall {k} point1 tip1 (header :: k) (any :: StNextKind).
point1
-> tip1
-> Message (ChainSync header point1 tip1) ('StNext any) 'StIdle
MsgRollBackward point1
p tip1
tip)) Maybe (AnyMessage (ChainSync header point tip))
forall a. Maybe a
Nothing)
(ClientAgency ClientHasAgency st
R:ClientHasAgencyChainSyncst k k1 k2 header point tip st
TokIdle, Just (AnyMessage (MsgFindIntersect [point1]
ps))) -> DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st)
-> m (DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeMessage st
-> Maybe (AnyMessage (ChainSync header point tip))
-> DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st)
forall bytes failure (m :: * -> *) a.
a -> Maybe bytes -> DecodeStep bytes failure m a
DecodeDone (Message (ChainSync header point tip) st 'StIntersect
-> SomeMessage st
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage ([point1]
-> Message (ChainSync header point1 tip) 'StIdle 'StIntersect
forall {k} {k2} point1 (header :: k) (tip :: k2).
[point1]
-> Message (ChainSync header point1 tip) 'StIdle 'StIntersect
MsgFindIntersect [point1]
ps)) Maybe (AnyMessage (ChainSync header point tip))
forall a. Maybe a
Nothing)
(ServerAgency ServerHasAgency st
R:ServerHasAgencyChainSyncst k k1 k2 header point tip st
TokIntersect, Just (AnyMessage (MsgIntersectFound point1
p tip1
tip))) -> DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st)
-> m (DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeMessage st
-> Maybe (AnyMessage (ChainSync header point tip))
-> DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st)
forall bytes failure (m :: * -> *) a.
a -> Maybe bytes -> DecodeStep bytes failure m a
DecodeDone (Message (ChainSync header point tip) st 'StIdle -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage (point1
-> tip1
-> Message (ChainSync header point1 tip1) 'StIntersect 'StIdle
forall {k} point1 tip1 (header :: k).
point1
-> tip1
-> Message (ChainSync header point1 tip1) 'StIntersect 'StIdle
MsgIntersectFound point1
p tip1
tip)) Maybe (AnyMessage (ChainSync header point tip))
forall a. Maybe a
Nothing)
(ServerAgency ServerHasAgency st
R:ServerHasAgencyChainSyncst k k1 k2 header point tip st
TokIntersect, Just (AnyMessage (MsgIntersectNotFound tip1
tip))) -> DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st)
-> m (DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeMessage st
-> Maybe (AnyMessage (ChainSync header point tip))
-> DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st)
forall bytes failure (m :: * -> *) a.
a -> Maybe bytes -> DecodeStep bytes failure m a
DecodeDone (Message (ChainSync header point tip) st 'StIdle -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage (tip1 -> Message (ChainSync header point tip1) 'StIntersect 'StIdle
forall {k} {k1} tip1 (header :: k) (point :: k1).
tip1 -> Message (ChainSync header point tip1) 'StIntersect 'StIdle
MsgIntersectNotFound tip1
tip)) Maybe (AnyMessage (ChainSync header point tip))
forall a. Maybe a
Nothing)
(ClientAgency ClientHasAgency st
R:ClientHasAgencyChainSyncst k k1 k2 header point tip st
TokIdle, Just (AnyMessage Message (ChainSync header point tip) st st'
R:MessageChainSyncfromto k k1 k2 header point tip st st'
MsgDone)) -> DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st)
-> m (DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeMessage st
-> Maybe (AnyMessage (ChainSync header point tip))
-> DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st)
forall bytes failure (m :: * -> *) a.
a -> Maybe bytes -> DecodeStep bytes failure m a
DecodeDone (Message (ChainSync header point tip) st 'StDone -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage Message (ChainSync header point tip) st 'StDone
Message (ChainSync header point tip) 'StIdle 'StDone
forall {k} {k1} {k2} (header :: k) (point :: k1) (tip :: k2).
Message (ChainSync header point tip) 'StIdle 'StDone
MsgDone) Maybe (AnyMessage (ChainSync header point tip))
forall a. Maybe a
Nothing)
(PeerHasAgency pr st
_, Maybe (AnyMessage (ChainSync header point tip))
_) -> DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st)
-> m (DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st)
-> m (DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st)))
-> DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st)
-> m (DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st))
forall a b. (a -> b) -> a -> b
$ CodecFailure
-> DecodeStep
(AnyMessage (ChainSync header point tip))
CodecFailure
m
(SomeMessage st)
forall bytes failure (m :: * -> *) a.
failure -> DecodeStep bytes failure m a
DecodeFail (String -> CodecFailure
CodecFailure String
"codecChainSync: no matching message")