{-# 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 {k} {k1} {k2} bytes (header :: k) (point :: k1) (tip :: k2).
(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 k4
SingCanAwait)  = Word
smallByteLimit
    stateToLimit (SingNext SingNextKind k4
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 {k} {k1} {k2} (header :: k) (point :: k1) (tip :: k2).
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 k4
SingCanAwait)  = Maybe DiffTime
canAwaitTimeout
    stateToLimit (SingNext SingNextKind k4
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 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 (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 (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 (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 (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 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 {k} {k1} {k2} (header :: k) (point :: k1) (tip :: k2).
Message (ChainSync header point tip) 'StIdle ('StNext 'StCanAwait)
MsgRequestNext)

        (Word
1, Int
1, SingNext SingNextKind k4
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 {k} {k1} {k2} (header :: k) (point :: k1) (tip :: k2).
Message
  (ChainSync header point tip)
  ('StNext 'StCanAwait)
  ('StNext 'StMustReply)
MsgAwaitReply)

        (Word
2, Int
3, SingNext SingNextKind k4
tok) -> Sing k4
-> (SingI k4 => Decoder s (SomeMessage st))
-> Decoder s (SomeMessage st)
forall {k} (n :: k) r. Sing n -> (SingI n => r) -> r
withSingI Sing k4
SingNextKind k4
tok ((SingI k4 => Decoder s (SomeMessage st))
 -> Decoder s (SomeMessage st))
-> (SingI k4 => 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 k4) 'StIdle
forall {k1} header1 tip1 (point :: k1) (any :: StNextKind).
header1
-> tip1
-> Message (ChainSync header1 point tip1) ('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 k4
tok) -> Sing k4
-> (SingI k4 => Decoder s (SomeMessage st))
-> Decoder s (SomeMessage st)
forall {k} (n :: k) r. Sing n -> (SingI n => r) -> r
withSingI Sing k4
SingNextKind k4
tok ((SingI k4 => Decoder s (SomeMessage st))
 -> Decoder s (SomeMessage st))
-> (SingI k4 => 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 k4) 'StIdle
forall {k} point1 tip1 (header :: k) (any :: StNextKind).
point1
-> tip1
-> Message (ChainSync header point1 tip1) ('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 {k} {k2} point1 (header :: k) (tip :: k2).
[point1]
-> Message (ChainSync header point1 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 {k} point1 tip1 (header :: k).
point1
-> tip1
-> Message (ChainSync header point1 tip1) '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 {k} {k1} tip1 (header :: k) (point :: k1).
tip1 -> Message (ChainSync header point tip1) '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 {k} {k1} {k2} (header :: k) (point :: k1) (tip :: k2).
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 k4
next) ->
          case SingNextKind k4
next of
            SingNextKind k4
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 k4
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 {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 = (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 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).
(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 k4
SingCanAwait, 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).
(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 k4
SingCanAwait, 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).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage (header1
-> tip1
-> Message
     (ChainSync header1 point tip1) ('StNext 'StCanAwait) '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)

      (SingNext SingNextKind k4
SingCanAwait, 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).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage (point1
-> tip1
-> Message
     (ChainSync header point1 tip1) ('StNext 'StCanAwait) '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)

      (SingNext SingNextKind k4
SingMustReply, 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).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage (header1
-> tip1
-> Message
     (ChainSync header1 point tip1) ('StNext 'StMustReply) '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)

      (SingNext SingNextKind k4
SingMustReply, 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).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage (point1
-> tip1
-> Message
     (ChainSync header point1 tip1) ('StNext 'StMustReply) '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)

      (SingChainSync st
SingIdle, 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).
(StateTokenI st, StateTokenI st', ActiveState st) =>
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)

      (SingChainSync st
SingIntersect, 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).
(StateTokenI st, StateTokenI st', ActiveState st) =>
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)

      (SingChainSync st
SingIntersect, 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).
(StateTokenI st, StateTokenI st', ActiveState st) =>
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)

      (SingChainSync st
SingIdle, 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).
(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 {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)

      (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")