{-# 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


-- | Byte Limits
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

-- | Configurable timeouts
--
-- These are configurable for at least the following reasons.
--
-- o So that deployment and testing can use different values.
--
-- o So that a net running Praos can better cope with streaks of empty slots.
--   (See @intersectmbo/ouroboros-network#2245@.)
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
  }

-- | Time Limits
--
-- > 'TokIdle'               'waitForever' (ie never times out)
-- > 'TokNext TokCanAwait'   the given 'canAwaitTimeout'
-- > 'TokNext TokMustReply'  the given 'mustReplyTimeout'
-- > 'TokIntersect'          the given 'intersectTimeout'
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

-- | Codec for chain sync that encodes/decodes headers
--
-- NOTE: See 'wrapCBORinCBOR' and 'unwrapCBORinCBOR' if you want to use this
-- with a header type that has annotations.
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)

        --
        -- failures per protocol state
        --

        (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

-- | An identity 'Codec' for the 'ChainSync' protocol. It does not do any
-- serialisation. It keeps the typed messages, wrapped in 'AnyMessage'.
--
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")