{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# 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 Data.Singletons (withSingI)

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 bytes header point tip.
(bytes -> Word)
-> ProtocolSizeLimits (ChainSync header point tip) bytes
byteLimitsChainSync = (forall (st :: ChainSync header point tip).
 ActiveState st =>
 StateToken st -> Word)
-> (bytes -> Word)
-> ProtocolSizeLimits (ChainSync header point tip) bytes
forall ps bytes.
(forall (st :: ps). ActiveState st => StateToken st -> Word)
-> (bytes -> Word) -> ProtocolSizeLimits ps bytes
ProtocolSizeLimits StateToken st -> Word
forall (st :: ChainSync header point tip).
ActiveState st =>
StateToken st -> Word
stateToLimit
  where
    stateToLimit :: forall (st :: ChainSync header point tip).
                    ActiveState st => StateToken st -> Word
    stateToLimit :: forall (st :: ChainSync header point tip).
ActiveState st =>
StateToken st -> Word
stateToLimit StateToken st
SingChainSync st
SingIdle                 = Word
smallByteLimit
    stateToLimit (SingNext SingNextKind k1
SingCanAwait)  = Word
smallByteLimit
    stateToLimit (SingNext SingNextKind k1
SingMustReply) = Word
smallByteLimit
    stateToLimit StateToken st
SingChainSync st
SingIntersect            = Word
smallByteLimit
    stateToLimit a :: StateToken st
a@StateToken st
SingChainSync st
SingDone               = StateToken 'StDone -> forall a. a
forall ps (st :: ps).
(StateAgency st ~ 'NobodyAgency, ActiveState st) =>
StateToken st -> forall a. a
notActiveState StateToken st
StateToken 'StDone
a

-- | 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 header point tip.
ChainSyncTimeout -> ProtocolTimeLimits (ChainSync header point tip)
timeLimitsChainSync ChainSyncTimeout
csTimeouts = (forall (st :: ChainSync header point tip).
 ActiveState st =>
 StateToken st -> Maybe DiffTime)
-> ProtocolTimeLimits (ChainSync header point tip)
forall ps.
(forall (st :: ps).
 ActiveState st =>
 StateToken st -> Maybe DiffTime)
-> ProtocolTimeLimits ps
ProtocolTimeLimits StateToken st -> Maybe DiffTime
forall (st :: ChainSync header point tip).
ActiveState st =>
StateToken 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 (st :: ChainSync header point tip).
                    ActiveState st => StateToken st -> Maybe DiffTime
    stateToLimit :: forall (st :: ChainSync header point tip).
ActiveState st =>
StateToken st -> Maybe DiffTime
stateToLimit StateToken st
SingChainSync st
SingIdle                 = Maybe DiffTime
idleTimeout
    stateToLimit (SingNext SingNextKind k1
SingCanAwait)  = Maybe DiffTime
canAwaitTimeout
    stateToLimit (SingNext SingNextKind k1
SingMustReply) = Maybe DiffTime
mustReplyTimeout
    stateToLimit StateToken st
SingChainSync st
SingIntersect            = Maybe DiffTime
intersectTimeout
    stateToLimit a :: StateToken st
a@StateToken st
SingChainSync st
SingDone               = StateToken 'StDone -> forall a. a
forall ps (st :: ps).
(StateAgency st ~ 'NobodyAgency, ActiveState st) =>
StateToken st -> forall a. a
notActiveState StateToken st
StateToken 'StDone
a

-- | 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 (st :: ChainSync header point tip)
        (st' :: ChainSync header point tip).
 (StateTokenI st, ActiveState st) =>
 Message (ChainSync header point tip) st st' -> Encoding)
-> (forall (st :: ChainSync header point tip) s.
    ActiveState st =>
    StateToken st -> Decoder s (SomeMessage st))
-> Codec
     (ChainSync header point tip) DeserialiseFailure m ByteString
forall ps (m :: * -> *).
MonadST m =>
(forall (st :: ps) (st' :: ps).
 (StateTokenI st, ActiveState st) =>
 Message ps st st' -> Encoding)
-> (forall (st :: ps) s.
    ActiveState st =>
    StateToken st -> Decoder s (SomeMessage st))
-> Codec ps DeserialiseFailure m ByteString
mkCodecCborLazyBS Message (ChainSync header point tip) st st' -> Encoding
forall (st :: ChainSync header point tip)
       (st' :: ChainSync header point tip).
Message (ChainSync header point tip) st st' -> Encoding
forall (st :: ChainSync header point tip)
       (st' :: ChainSync header point tip).
(StateTokenI st, ActiveState st) =>
Message (ChainSync header point tip) st st' -> Encoding
encode StateToken st -> Decoder s (SomeMessage st)
forall (st :: ChainSync header point tip) s.
ActiveState st =>
StateToken st -> Decoder s (SomeMessage st)
decode
  where
    encode :: forall (st  :: ChainSync header point tip)
                     (st' :: ChainSync header point tip).
              Message (ChainSync header point tip) st st'
           -> CBOR.Encoding

    encode :: forall (st :: ChainSync header point tip)
       (st' :: ChainSync header point tip).
Message (ChainSync header point tip) st st' -> Encoding
encode 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 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 (MsgRollForward header
h tip
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
h
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> tip -> Encoding
encodeTip tip
tip

    encode (MsgRollBackward point
p tip
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
p
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> tip -> Encoding
encodeTip tip
tip

    encode (MsgFindIntersect [point]
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]
ps

    encode (MsgIntersectFound point
p tip
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
p
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> tip -> Encoding
encodeTip tip
tip

    encode (MsgIntersectNotFound tip
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
tip

    encode 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 (st :: ChainSync header point tip) s.
              ActiveState st
           => StateToken st
           -> CBOR.Decoder s (SomeMessage st)
    decode :: forall (st :: ChainSync header point tip) s.
ActiveState st =>
StateToken st -> Decoder s (SomeMessage st)
decode StateToken st
stok = do
      len <- Decoder s Int
forall s. Decoder s Int
decodeListLen
      key <- decodeWord
      case (key, len, stok) of
        (Word
0, Int
1, SingChainSync st
SingIdle) ->
          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).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage Message (ChainSync header point tip) st ('StNext 'StCanAwait)
Message (ChainSync header point tip) 'StIdle ('StNext 'StCanAwait)
forall header point tip.
Message (ChainSync header point tip) 'StIdle ('StNext 'StCanAwait)
MsgRequestNext)

        (Word
1, Int
1, SingNext SingNextKind k1
SingCanAwait) ->
          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).
(StateTokenI st, StateTokenI st', ActiveState st) =>
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 header point tip.
Message
  (ChainSync header point tip)
  ('StNext 'StCanAwait)
  ('StNext 'StMustReply)
MsgAwaitReply)

        (Word
2, Int
3, SingNext SingNextKind k1
tok) -> Sing k1
-> (SingI k1 => Decoder s (SomeMessage st))
-> Decoder s (SomeMessage st)
forall {k} (n :: k) r. Sing n -> (SingI n => r) -> r
withSingI Sing k1
SingNextKind k1
tok ((SingI k1 => Decoder s (SomeMessage st))
 -> Decoder s (SomeMessage st))
-> (SingI k1 => Decoder s (SomeMessage st))
-> Decoder s (SomeMessage st)
forall a b. (a -> b) -> a -> b
$
              (\header
h tip
tip -> Message (ChainSync header point tip) st 'StIdle -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage (header
-> tip -> Message (ChainSync header point tip) ('StNext k1) 'StIdle
forall header tip point (any :: StNextKind).
header
-> tip
-> Message (ChainSync header point tip) ('StNext any) 'StIdle
MsgRollForward header
h tip
tip))
          (header -> tip -> SomeMessage st)
-> Decoder s header -> Decoder s (tip -> SomeMessage st)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s header
forall s. Decoder s header
decodeHeader
          Decoder s (tip -> SomeMessage st)
-> Decoder s tip -> Decoder s (SomeMessage st)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s tip
forall s. Decoder s tip
decodeTip

        (Word
3, Int
3, SingNext SingNextKind k1
tok) -> Sing k1
-> (SingI k1 => Decoder s (SomeMessage st))
-> Decoder s (SomeMessage st)
forall {k} (n :: k) r. Sing n -> (SingI n => r) -> r
withSingI Sing k1
SingNextKind k1
tok ((SingI k1 => Decoder s (SomeMessage st))
 -> Decoder s (SomeMessage st))
-> (SingI k1 => Decoder s (SomeMessage st))
-> Decoder s (SomeMessage st)
forall a b. (a -> b) -> a -> b
$
              (\point
p tip
tip -> Message (ChainSync header point tip) st 'StIdle -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage (point
-> tip -> Message (ChainSync header point tip) ('StNext k1) 'StIdle
forall point tip header (any :: StNextKind).
point
-> tip
-> Message (ChainSync header point tip) ('StNext any) 'StIdle
MsgRollBackward point
p tip
tip))
          (point -> tip -> SomeMessage st)
-> Decoder s point -> Decoder s (tip -> SomeMessage st)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s point
forall s. Decoder s point
decodePoint
          Decoder s (tip -> SomeMessage st)
-> Decoder s tip -> Decoder s (SomeMessage st)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s tip
forall s. Decoder s tip
decodeTip

        (Word
4, Int
2, SingChainSync st
SingIdle) ->
          Message (ChainSync header point tip) st 'StIntersect
-> SomeMessage st
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage (Message (ChainSync header point tip) st 'StIntersect
 -> SomeMessage st)
-> ([point]
    -> Message (ChainSync header point tip) st 'StIntersect)
-> [point]
-> SomeMessage st
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [point] -> Message (ChainSync header point tip) st 'StIntersect
[point]
-> Message (ChainSync header point tip) 'StIdle 'StIntersect
forall point header tip.
[point]
-> Message (ChainSync header point tip) 'StIdle 'StIntersect
MsgFindIntersect ([point] -> SomeMessage st)
-> Decoder s [point] -> Decoder s (SomeMessage st)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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

        (Word
5, Int
3, SingChainSync st
SingIntersect) -> do
              (\point
p tip
tip -> Message (ChainSync header point tip) st 'StIdle -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage (point
-> tip -> Message (ChainSync header point tip) 'StIntersect 'StIdle
forall point tip header.
point
-> tip -> Message (ChainSync header point tip) 'StIntersect 'StIdle
MsgIntersectFound point
p tip
tip))
          (point -> tip -> SomeMessage st)
-> Decoder s point -> Decoder s (tip -> SomeMessage st)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s point
forall s. Decoder s point
decodePoint
          Decoder s (tip -> SomeMessage st)
-> Decoder s tip -> Decoder s (SomeMessage st)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s tip
forall s. Decoder s tip
decodeTip

        (Word
6, Int
2, SingChainSync st
SingIntersect) -> do
              Message (ChainSync header point tip) st 'StIdle -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage (Message (ChainSync header point tip) st 'StIdle -> SomeMessage st)
-> (tip -> Message (ChainSync header point tip) st 'StIdle)
-> tip
-> SomeMessage st
forall b c a. (b -> c) -> (a -> b) -> a -> c
. tip -> Message (ChainSync header point tip) st 'StIdle
tip -> Message (ChainSync header point tip) 'StIntersect 'StIdle
forall tip header point.
tip -> Message (ChainSync header point tip) 'StIntersect 'StIdle
MsgIntersectNotFound
          (tip -> SomeMessage st)
-> Decoder s tip -> Decoder s (SomeMessage st)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s tip
forall s. Decoder s tip
decodeTip

        (Word
7, Int
1, SingChainSync st
SingIdle) ->
          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).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage Message (ChainSync header point tip) st 'StDone
Message (ChainSync header point tip) 'StIdle 'StDone
forall header point tip.
Message (ChainSync header point tip) 'StIdle 'StDone
MsgDone)

        --
        -- failures per protocol state
        --

        (Word
_, Int
_, SingChainSync st
SingIdle) ->
          String -> Decoder s (SomeMessage st)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> String -> String -> Word -> Int -> String
forall r. PrintfType r => String -> r
printf String
"codecChainSync (%s, %s) unexpected key (%d, %d)"
                       (ActiveAgency' 'StIdle 'ClientAgency -> String
forall a. Show a => a -> String
show (ActiveAgency' st 'ClientAgency
ActiveAgency' st (StateAgency st)
forall {ps} (st :: ps) (agency :: Agency).
IsActiveState st agency =>
ActiveAgency' st agency
activeAgency :: ActiveAgency st)) (SingChainSync 'StIdle -> String
forall a. Show a => a -> String
show StateToken st
SingChainSync 'StIdle
stok) Word
key Int
len)
        (Word
_, Int
_, SingNext SingNextKind k1
next) ->
          case SingNextKind k1
next of
            SingNextKind k1
SingCanAwait ->
              String -> Decoder s (SomeMessage st)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> String -> String -> Word -> Int -> String
forall r. PrintfType r => String -> r
printf String
"codecChainSync (%s) unexpected key (%d, %d)"
                           (ActiveAgency' ('StNext 'StCanAwait) 'ServerAgency -> String
forall a. Show a => a -> String
show (ActiveAgency' st 'ServerAgency
ActiveAgency' st (StateAgency st)
forall {ps} (st :: ps) (agency :: Agency).
IsActiveState st agency =>
ActiveAgency' st agency
activeAgency :: ActiveAgency st)) (SingChainSync ('StNext 'StCanAwait) -> String
forall a. Show a => a -> String
show StateToken st
SingChainSync ('StNext 'StCanAwait)
stok) Word
key Int
len)
            SingNextKind k1
SingMustReply ->
              String -> Decoder s (SomeMessage st)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> String -> String -> Word -> Int -> String
forall r. PrintfType r => String -> r
printf String
"codecChainSync (%s) unexpected key (%d, %d)"
                           (ActiveAgency' ('StNext 'StMustReply) 'ServerAgency -> String
forall a. Show a => a -> String
show (ActiveAgency' st 'ServerAgency
ActiveAgency' st (StateAgency st)
forall {ps} (st :: ps) (agency :: Agency).
IsActiveState st agency =>
ActiveAgency' st agency
activeAgency :: ActiveAgency st)) (SingChainSync ('StNext 'StMustReply) -> String
forall a. Show a => a -> String
show StateToken st
SingChainSync ('StNext 'StMustReply)
stok) Word
key Int
len)
        (Word
_, Int
_, SingChainSync st
SingIntersect) ->
          String -> Decoder s (SomeMessage st)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> String -> String -> Word -> Int -> String
forall r. PrintfType r => String -> r
printf String
"codecChainSync (%s) unexpected key (%d, %d)"
                       (ActiveAgency' 'StIntersect 'ServerAgency -> String
forall a. Show a => a -> String
show (ActiveAgency' st 'ServerAgency
ActiveAgency' st (StateAgency st)
forall {ps} (st :: ps) (agency :: Agency).
IsActiveState st agency =>
ActiveAgency' st agency
activeAgency :: ActiveAgency st)) (SingChainSync 'StIntersect -> String
forall a. Show a => a -> String
show StateToken st
SingChainSync 'StIntersect
stok) Word
key Int
len)
        (Word
_, Int
_, SingChainSync st
SingDone) -> StateToken 'StDone -> forall a. a
forall ps (st :: ps).
(StateAgency st ~ 'NobodyAgency, ActiveState st) =>
StateToken st -> forall a. a
notActiveState StateToken st
StateToken 'StDone
stok

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 header point tip (m :: * -> *).
Monad m =>
Codec
  (ChainSync header point tip)
  CodecFailure
  m
  (AnyMessage (ChainSync header point tip))
codecChainSyncId = (forall (st :: ChainSync header point tip)
        (st' :: ChainSync header point tip).
 (StateTokenI st, ActiveState st) =>
 Message (ChainSync header point tip) st st'
 -> AnyMessage (ChainSync header point tip))
-> (forall (st :: ChainSync header point tip).
    ActiveState st =>
    StateToken st
    -> m (DecodeStep
            (AnyMessage (ChainSync header point tip))
            CodecFailure
            m
            (SomeMessage st)))
-> Codec
     (ChainSync header point tip)
     CodecFailure
     m
     (AnyMessage (ChainSync header point tip))
forall ps failure (m :: * -> *) bytes.
(forall (st :: ps) (st' :: ps).
 (StateTokenI st, ActiveState st) =>
 Message ps st st' -> bytes)
-> (forall (st :: ps).
    ActiveState st =>
    StateToken st -> m (DecodeStep bytes failure m (SomeMessage st)))
-> Codec ps failure m bytes
Codec Message (ChainSync header point tip) st st'
-> AnyMessage (ChainSync header point tip)
forall (st :: ChainSync header point tip)
       (st' :: ChainSync header point tip).
(StateTokenI st, ActiveState st) =>
Message (ChainSync header point tip) st st'
-> AnyMessage (ChainSync header point tip)
encode StateToken st
-> m (DecodeStep
        (AnyMessage (ChainSync header point tip))
        CodecFailure
        m
        (SomeMessage st))
forall (st :: ChainSync header point tip).
ActiveState st =>
StateToken st
-> m (DecodeStep
        (AnyMessage (ChainSync header point tip))
        CodecFailure
        m
        (SomeMessage st))
decode
 where
  encode :: forall st st'.
            StateTokenI st
         => ActiveState st
         => Message (ChainSync header point tip) st st'
         -> AnyMessage (ChainSync header point tip)
  encode :: forall (st :: ChainSync header point tip)
       (st' :: ChainSync header point tip).
(StateTokenI st, ActiveState st) =>
Message (ChainSync header point tip) st st'
-> AnyMessage (ChainSync header point tip)
encode = Message (ChainSync header point tip) st st'
-> AnyMessage (ChainSync header point tip)
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
Message ps st st' -> AnyMessage ps
AnyMessage

  decode :: forall (st :: ChainSync header point tip).
            ActiveState st
         => StateToken st
         -> m (DecodeStep (AnyMessage (ChainSync header point tip))
                          CodecFailure m (SomeMessage st))
  decode :: forall (st :: ChainSync header point tip).
ActiveState st =>
StateToken st
-> m (DecodeStep
        (AnyMessage (ChainSync header point tip))
        CodecFailure
        m
        (SomeMessage st))
decode StateToken st
stok = do
    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 (StateToken st
SingChainSync st
stok, Maybe (AnyMessage (ChainSync header point tip))
bytes) of

      (SingChainSync 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

      (SingChainSync st
SingIdle, Just (AnyMessage msg :: Message (ChainSync header point tip) st st'
msg@Message (ChainSync header point tip) st st'
R:MessageChainSyncfromto 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).
(StateTokenI st, StateTokenI st', ActiveState st) =>
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)

      (SingNext SingNextKind k1
SingCanAwait, Just (AnyMessage msg :: Message (ChainSync header point tip) st st'
msg@Message (ChainSync header point tip) st st'
R:MessageChainSyncfromto 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).
(StateTokenI st, StateTokenI st', ActiveState st) =>
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)

      (SingNext SingNextKind k1
SingCanAwait, Just (AnyMessage (MsgRollForward header
h tip
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).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage (header
-> tip
-> Message
     (ChainSync header point tip) ('StNext 'StCanAwait) 'StIdle
forall header tip point (any :: StNextKind).
header
-> tip
-> Message (ChainSync header point tip) ('StNext any) 'StIdle
MsgRollForward header
h tip
tip)) Maybe (AnyMessage (ChainSync header point tip))
forall a. Maybe a
Nothing)

      (SingNext SingNextKind k1
SingCanAwait, Just (AnyMessage (MsgRollBackward point
p tip
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).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage (point
-> tip
-> Message
     (ChainSync header point tip) ('StNext 'StCanAwait) 'StIdle
forall point tip header (any :: StNextKind).
point
-> tip
-> Message (ChainSync header point tip) ('StNext any) 'StIdle
MsgRollBackward point
p tip
tip)) Maybe (AnyMessage (ChainSync header point tip))
forall a. Maybe a
Nothing)

      (SingNext SingNextKind k1
SingMustReply, Just (AnyMessage (MsgRollForward header
h tip
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).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage (header
-> tip
-> Message
     (ChainSync header point tip) ('StNext 'StMustReply) 'StIdle
forall header tip point (any :: StNextKind).
header
-> tip
-> Message (ChainSync header point tip) ('StNext any) 'StIdle
MsgRollForward header
h tip
tip)) Maybe (AnyMessage (ChainSync header point tip))
forall a. Maybe a
Nothing)

      (SingNext SingNextKind k1
SingMustReply, Just (AnyMessage (MsgRollBackward point
p tip
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).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage (point
-> tip
-> Message
     (ChainSync header point tip) ('StNext 'StMustReply) 'StIdle
forall point tip header (any :: StNextKind).
point
-> tip
-> Message (ChainSync header point tip) ('StNext any) 'StIdle
MsgRollBackward point
p tip
tip)) Maybe (AnyMessage (ChainSync header point tip))
forall a. Maybe a
Nothing)

      (SingChainSync st
SingIdle, Just (AnyMessage (MsgFindIntersect [point]
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).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage ([point]
-> Message (ChainSync header point tip) 'StIdle 'StIntersect
forall point header tip.
[point]
-> Message (ChainSync header point tip) 'StIdle 'StIntersect
MsgFindIntersect [point]
ps)) Maybe (AnyMessage (ChainSync header point tip))
forall a. Maybe a
Nothing)

      (SingChainSync st
SingIntersect, Just (AnyMessage (MsgIntersectFound point
p tip
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).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage (point
-> tip -> Message (ChainSync header point tip) 'StIntersect 'StIdle
forall point tip header.
point
-> tip -> Message (ChainSync header point tip) 'StIntersect 'StIdle
MsgIntersectFound point
p tip
tip)) Maybe (AnyMessage (ChainSync header point tip))
forall a. Maybe a
Nothing)

      (SingChainSync st
SingIntersect, Just (AnyMessage (MsgIntersectNotFound tip
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).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage (tip -> Message (ChainSync header point tip) 'StIntersect 'StIdle
forall tip header point.
tip -> Message (ChainSync header point tip) 'StIntersect 'StIdle
MsgIntersectNotFound tip
tip)) Maybe (AnyMessage (ChainSync header point tip))
forall a. Maybe a
Nothing)

      (SingChainSync st
SingIdle, Just (AnyMessage Message (ChainSync header point tip) st st'
R:MessageChainSyncfromto 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).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage Message (ChainSync header point tip) st 'StDone
Message (ChainSync header point tip) 'StIdle 'StDone
forall header point tip.
Message (ChainSync header point tip) 'StIdle 'StDone
MsgDone) Maybe (AnyMessage (ChainSync header point tip))
forall a. Maybe a
Nothing)

      (SingChainSync st
SingDone, Maybe (AnyMessage (ChainSync header point tip))
_) -> StateToken 'StDone -> forall a. a
forall ps (st :: ps).
(StateAgency st ~ 'NobodyAgency, ActiveState st) =>
StateToken st -> forall a. a
notActiveState StateToken st
StateToken 'StDone
stok

      (SingChainSync 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 -> CodecFailure) -> String -> CodecFailure
forall a b. (a -> b) -> a -> b
$ String
"codecChainSync: no matching message")