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

import           Network.TypedProtocol.Codec.CBOR

import           Ouroboros.Network.Driver.Limits
import           Ouroboros.Network.Protocol.ChainSync.Type
import           Ouroboros.Network.Protocol.Limits

import qualified Data.ByteString.Lazy as LBS

import           Codec.CBOR.Decoding (decodeListLen, decodeWord)
import qualified Codec.CBOR.Decoding as CBOR
import           Codec.CBOR.Encoding (encodeListLen, encodeWord)
import qualified Codec.CBOR.Encoding as CBOR
import qualified Codec.CBOR.Read as CBOR
import           Text.Printf


-- | Byte Limits
byteLimitsChainSync :: forall bytes header point tip .
                       (bytes -> Word)
                    -> ProtocolSizeLimits (ChainSync header point tip) bytes
byteLimitsChainSync :: (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 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 :: PeerHasAgency pr st -> Word
stateToLimit (ClientAgency ClientHasAgency st
TokIdle)                = Word
smallByteLimit
    stateToLimit (ServerAgency (TokNext TokCanAwait))  = Word
smallByteLimit
    stateToLimit (ServerAgency (TokNext TokMustReply)) = Word
smallByteLimit
    stateToLimit (ServerAgency ServerHasAgency 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 @input-output-hk/ouroboros-network#2245@.)
data ChainSyncTimeout = ChainSyncTimeout
  { ChainSyncTimeout -> Maybe DiffTime
canAwaitTimeout  :: Maybe DiffTime
  , ChainSyncTimeout -> Maybe DiffTime
intersectTimeout :: Maybe DiffTime
  , ChainSyncTimeout -> Maybe DiffTime
mustReplyTimeout :: 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 :: 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 forall (pr :: PeerRole) (st :: ChainSync header point tip).
PeerHasAgency pr st -> Maybe DiffTime
stateToLimit
  where
    ChainSyncTimeout
      { Maybe DiffTime
canAwaitTimeout :: Maybe DiffTime
canAwaitTimeout :: ChainSyncTimeout -> Maybe DiffTime
canAwaitTimeout
      , Maybe DiffTime
intersectTimeout :: Maybe DiffTime
intersectTimeout :: ChainSyncTimeout -> Maybe DiffTime
intersectTimeout
      , Maybe DiffTime
mustReplyTimeout :: Maybe DiffTime
mustReplyTimeout :: ChainSyncTimeout -> Maybe DiffTime
mustReplyTimeout
      } = ChainSyncTimeout
csTimeouts

    stateToLimit :: forall (pr :: PeerRole) (st :: ChainSync header point tip).
                    PeerHasAgency pr st -> Maybe DiffTime
    stateToLimit :: PeerHasAgency pr st -> Maybe DiffTime
stateToLimit (ClientAgency ClientHasAgency st
TokIdle)                = Maybe DiffTime
waitForever
    stateToLimit (ServerAgency (TokNext TokCanAwait))  = Maybe DiffTime
canAwaitTimeout
    stateToLimit (ServerAgency (TokNext TokMustReply)) = Maybe DiffTime
mustReplyTimeout
    stateToLimit (ServerAgency ServerHasAgency 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 :: (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 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 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 :: PeerHasAgency pr st
-> Message (ChainSync header point tip) st st' -> Encoding
encode (ClientAgency ClientHasAgency st
TokIdle) Message (ChainSync 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'
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 h 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
header
h
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> tip -> Encoding
encodeTip tip
tip
tip

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

    encode (ClientAgency ClientHasAgency st
TokIdle) (MsgFindIntersect 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]
[point]
ps

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

    encode (ServerAgency ServerHasAgency st
TokIntersect) (MsgIntersectNotFound 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
tip

    encode (ClientAgency ClientHasAgency st
TokIdle) Message (ChainSync 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 :: PeerHasAgency pr st -> Decoder s (SomeMessage st)
decode PeerHasAgency pr st
stok = do
      Int
len <- Decoder s Int
forall s. Decoder s Int
decodeListLen
      Word
key <- Decoder s Word
forall s. Decoder s Word
decodeWord
      case (Word
key, Int
len, PeerHasAgency pr st
stok) of
        (Word
0, Int
1, ClientAgency ClientHasAgency st
TokIdle) ->
          SomeMessage 'StIdle -> Decoder s (SomeMessage 'StIdle)
forall (m :: * -> *) a. Monad m => a -> m a
return (Message (ChainSync header point tip) 'StIdle ('StNext 'StCanAwait)
-> SomeMessage 'StIdle
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage Message (ChainSync header point tip) 'StIdle ('StNext 'StCanAwait)
forall k k k (header :: k) (point :: k) (tip :: k).
Message (ChainSync header point tip) 'StIdle ('StNext 'StCanAwait)
MsgRequestNext)

        (Word
1, Int
1, ServerAgency (TokNext TokCanAwait)) ->
          SomeMessage ('StNext 'StCanAwait)
-> Decoder s (SomeMessage ('StNext 'StCanAwait))
forall (m :: * -> *) a. Monad m => a -> m a
return (Message
  (ChainSync header point tip)
  ('StNext 'StCanAwait)
  ('StNext 'StMustReply)
-> SomeMessage ('StNext 'StCanAwait)
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage Message
  (ChainSync header point tip)
  ('StNext 'StCanAwait)
  ('StNext 'StMustReply)
forall k k k (header :: k) (point :: k) (tip :: k).
Message
  (ChainSync header point tip)
  ('StNext 'StCanAwait)
  ('StNext 'StMustReply)
MsgAwaitReply)

        (Word
2, Int
3, ServerAgency (TokNext _)) -> do
          header
h <- Decoder s header
forall s. Decoder s header
decodeHeader
          tip
tip <- Decoder s tip
forall s. Decoder s tip
decodeTip
          SomeMessage ('StNext k) -> Decoder s (SomeMessage ('StNext k))
forall (m :: * -> *) a. Monad m => a -> m a
return (Message (ChainSync header point tip) ('StNext k) 'StIdle
-> SomeMessage ('StNext k)
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage (header
-> tip -> Message (ChainSync header point tip) ('StNext k) 'StIdle
forall k header tip (point :: k) (any :: StNextKind).
header
-> tip
-> Message (ChainSync header point tip) ('StNext any) 'StIdle
MsgRollForward header
h tip
tip))

        (Word
3, Int
3, ServerAgency (TokNext _)) -> do
          point
p <- Decoder s point
forall s. Decoder s point
decodePoint
          tip
tip  <- Decoder s tip
forall s. Decoder s tip
decodeTip
          SomeMessage ('StNext k) -> Decoder s (SomeMessage ('StNext k))
forall (m :: * -> *) a. Monad m => a -> m a
return (Message (ChainSync header point tip) ('StNext k) 'StIdle
-> SomeMessage ('StNext k)
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage (point
-> tip -> Message (ChainSync header point tip) ('StNext k) 'StIdle
forall k point tip (header :: k) (any :: StNextKind).
point
-> tip
-> Message (ChainSync header point tip) ('StNext any) 'StIdle
MsgRollBackward point
p tip
tip))

        (Word
4, Int
2, ClientAgency ClientHasAgency st
TokIdle) -> do
          [point]
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
          SomeMessage 'StIdle -> Decoder s (SomeMessage 'StIdle)
forall (m :: * -> *) a. Monad m => a -> m a
return (Message (ChainSync header point tip) 'StIdle 'StIntersect
-> SomeMessage 'StIdle
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage ([point]
-> Message (ChainSync header point tip) 'StIdle 'StIntersect
forall k k point (header :: k) (tip :: k).
[point]
-> Message (ChainSync header point tip) 'StIdle 'StIntersect
MsgFindIntersect [point]
ps))

        (Word
5, Int
3, ServerAgency ServerHasAgency st
TokIntersect) -> do
          point
p <- Decoder s point
forall s. Decoder s point
decodePoint
          tip
tip  <- Decoder s tip
forall s. Decoder s tip
decodeTip
          SomeMessage 'StIntersect -> Decoder s (SomeMessage 'StIntersect)
forall (m :: * -> *) a. Monad m => a -> m a
return (Message (ChainSync header point tip) 'StIntersect 'StIdle
-> SomeMessage 'StIntersect
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage (point
-> tip -> Message (ChainSync header point tip) 'StIntersect 'StIdle
forall k point tip (header :: k).
point
-> tip -> Message (ChainSync header point tip) 'StIntersect 'StIdle
MsgIntersectFound point
p tip
tip))

        (Word
6, Int
2, ServerAgency ServerHasAgency st
TokIntersect) -> do
          tip
tip <- Decoder s tip
forall s. Decoder s tip
decodeTip
          SomeMessage 'StIntersect -> Decoder s (SomeMessage 'StIntersect)
forall (m :: * -> *) a. Monad m => a -> m a
return (Message (ChainSync header point tip) 'StIntersect 'StIdle
-> SomeMessage 'StIntersect
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage (tip -> Message (ChainSync header point tip) 'StIntersect 'StIdle
forall k k tip (header :: k) (point :: k).
tip -> Message (ChainSync header point tip) 'StIntersect 'StIdle
MsgIntersectNotFound tip
tip))

        (Word
7, Int
1, ClientAgency ClientHasAgency st
TokIdle) ->
          SomeMessage 'StIdle -> Decoder s (SomeMessage 'StIdle)
forall (m :: * -> *) a. Monad m => a -> m a
return (Message (ChainSync header point tip) 'StIdle 'StDone
-> SomeMessage 'StIdle
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage Message (ChainSync header point tip) 'StIdle 'StDone
forall k k k (header :: k) (point :: k) (tip :: k).
Message (ChainSync header point tip) 'StIdle 'StDone
MsgDone)

        --
        -- failures per protcol state
        --

        (Word
_, Int
_, ClientAgency ClientHasAgency st
TokIdle) ->
          String -> Decoder s (SomeMessage st)
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 TokCanAwait)) ->
          String -> Decoder s (SomeMessage st)
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 TokMustReply)) ->
          String -> Decoder s (SomeMessage st)
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
TokIntersect) ->
          String -> Decoder s (SomeMessage st)
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 :: (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 (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 :: Decoder s a -> Decoder s [a]
decodeList Decoder s a
dec = do
  Maybe Int
mn <- Decoder s (Maybe Int)
forall s. Decoder s (Maybe Int)
CBOR.decodeListLenOrIndef
  case Maybe Int
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 :: Codec
  (ChainSync header point tip)
  CodecFailure
  m
  (AnyMessage (ChainSync header point tip))
codecChainSyncId = (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))
-> (forall (pr :: PeerRole) (st :: ChainSync header point tip).
    PeerHasAgency pr 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 (pr :: PeerRole) (st :: ps) (st' :: ps).
 PeerHasAgency pr st -> Message ps st st' -> bytes)
-> (forall (pr :: PeerRole) (st :: ps).
    PeerHasAgency pr st
    -> m (DecodeStep bytes failure m (SomeMessage st)))
-> Codec ps failure m bytes
Codec 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).
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 :: 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 :: 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 (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 (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
TokIdle, Just (AnyMessage msg@MsgRequestNext)) -> DecodeStep
  (AnyMessage (ChainSync header point tip))
  CodecFailure
  m
  (SomeMessage st)
-> m (DecodeStep
        (AnyMessage (ChainSync header point tip))
        CodecFailure
        m
        (SomeMessage st))
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'
msg) Maybe (AnyMessage (ChainSync header point tip))
forall a. Maybe a
Nothing)

    (ServerAgency (TokNext TokCanAwait), Just (AnyMessage msg@MsgAwaitReply)) -> DecodeStep
  (AnyMessage (ChainSync header point tip))
  CodecFailure
  m
  (SomeMessage st)
-> m (DecodeStep
        (AnyMessage (ChainSync header point tip))
        CodecFailure
        m
        (SomeMessage st))
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'
msg) Maybe (AnyMessage (ChainSync header point tip))
forall a. Maybe a
Nothing)

    (ServerAgency (TokNext _), Just (AnyMessage (MsgRollForward h tip))) -> DecodeStep
  (AnyMessage (ChainSync header point tip))
  CodecFailure
  m
  (SomeMessage ('StNext k))
-> m (DecodeStep
        (AnyMessage (ChainSync header point tip))
        CodecFailure
        m
        (SomeMessage ('StNext k)))
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeMessage ('StNext k)
-> Maybe (AnyMessage (ChainSync header point tip))
-> DecodeStep
     (AnyMessage (ChainSync header point tip))
     CodecFailure
     m
     (SomeMessage ('StNext k))
forall bytes failure (m :: * -> *) a.
a -> Maybe bytes -> DecodeStep bytes failure m a
DecodeDone (Message (ChainSync header point tip) ('StNext k) 'StIdle
-> SomeMessage ('StNext k)
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage (header
-> tip -> Message (ChainSync header point tip) ('StNext k) 'StIdle
forall k header tip (point :: k) (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)

    (ServerAgency (TokNext _), Just (AnyMessage (MsgRollBackward p tip))) -> DecodeStep
  (AnyMessage (ChainSync header point tip))
  CodecFailure
  m
  (SomeMessage ('StNext k))
-> m (DecodeStep
        (AnyMessage (ChainSync header point tip))
        CodecFailure
        m
        (SomeMessage ('StNext k)))
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeMessage ('StNext k)
-> Maybe (AnyMessage (ChainSync header point tip))
-> DecodeStep
     (AnyMessage (ChainSync header point tip))
     CodecFailure
     m
     (SomeMessage ('StNext k))
forall bytes failure (m :: * -> *) a.
a -> Maybe bytes -> DecodeStep bytes failure m a
DecodeDone (Message (ChainSync header point tip) ('StNext k) 'StIdle
-> SomeMessage ('StNext k)
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage (point
-> tip -> Message (ChainSync header point tip) ('StNext k) 'StIdle
forall k point tip (header :: k) (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)

    (ClientAgency ClientHasAgency st
TokIdle, Just (AnyMessage (MsgFindIntersect ps))) -> DecodeStep
  (AnyMessage (ChainSync header point tip))
  CodecFailure
  m
  (SomeMessage 'StIdle)
-> m (DecodeStep
        (AnyMessage (ChainSync header point tip))
        CodecFailure
        m
        (SomeMessage 'StIdle))
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeMessage 'StIdle
-> Maybe (AnyMessage (ChainSync header point tip))
-> DecodeStep
     (AnyMessage (ChainSync header point tip))
     CodecFailure
     m
     (SomeMessage 'StIdle)
forall bytes failure (m :: * -> *) a.
a -> Maybe bytes -> DecodeStep bytes failure m a
DecodeDone (Message (ChainSync header point tip) 'StIdle 'StIntersect
-> SomeMessage 'StIdle
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage ([point]
-> Message (ChainSync header point tip) 'StIdle 'StIntersect
forall k k point (header :: k) (tip :: k).
[point]
-> Message (ChainSync header point tip) 'StIdle 'StIntersect
MsgFindIntersect [point]
ps)) Maybe (AnyMessage (ChainSync header point tip))
forall a. Maybe a
Nothing)

    (ServerAgency ServerHasAgency st
TokIntersect, Just (AnyMessage (MsgIntersectFound p tip))) -> DecodeStep
  (AnyMessage (ChainSync header point tip))
  CodecFailure
  m
  (SomeMessage 'StIntersect)
-> m (DecodeStep
        (AnyMessage (ChainSync header point tip))
        CodecFailure
        m
        (SomeMessage 'StIntersect))
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeMessage 'StIntersect
-> Maybe (AnyMessage (ChainSync header point tip))
-> DecodeStep
     (AnyMessage (ChainSync header point tip))
     CodecFailure
     m
     (SomeMessage 'StIntersect)
forall bytes failure (m :: * -> *) a.
a -> Maybe bytes -> DecodeStep bytes failure m a
DecodeDone (Message (ChainSync header point tip) 'StIntersect 'StIdle
-> SomeMessage 'StIntersect
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage (point
-> tip -> Message (ChainSync header point tip) 'StIntersect 'StIdle
forall k point tip (header :: k).
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)

    (ServerAgency ServerHasAgency st
TokIntersect, Just (AnyMessage (MsgIntersectNotFound tip))) -> DecodeStep
  (AnyMessage (ChainSync header point tip))
  CodecFailure
  m
  (SomeMessage 'StIntersect)
-> m (DecodeStep
        (AnyMessage (ChainSync header point tip))
        CodecFailure
        m
        (SomeMessage 'StIntersect))
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeMessage 'StIntersect
-> Maybe (AnyMessage (ChainSync header point tip))
-> DecodeStep
     (AnyMessage (ChainSync header point tip))
     CodecFailure
     m
     (SomeMessage 'StIntersect)
forall bytes failure (m :: * -> *) a.
a -> Maybe bytes -> DecodeStep bytes failure m a
DecodeDone (Message (ChainSync header point tip) 'StIntersect 'StIdle
-> SomeMessage 'StIntersect
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage (tip -> Message (ChainSync header point tip) 'StIntersect 'StIdle
forall k k tip (header :: k) (point :: k).
tip -> Message (ChainSync header point tip) 'StIntersect 'StIdle
MsgIntersectNotFound tip
tip)) Maybe (AnyMessage (ChainSync header point tip))
forall a. Maybe a
Nothing)

    (ClientAgency ClientHasAgency st
TokIdle, Just (AnyMessage MsgDone)) -> DecodeStep
  (AnyMessage (ChainSync header point tip))
  CodecFailure
  m
  (SomeMessage 'StIdle)
-> m (DecodeStep
        (AnyMessage (ChainSync header point tip))
        CodecFailure
        m
        (SomeMessage 'StIdle))
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeMessage 'StIdle
-> Maybe (AnyMessage (ChainSync header point tip))
-> DecodeStep
     (AnyMessage (ChainSync header point tip))
     CodecFailure
     m
     (SomeMessage 'StIdle)
forall bytes failure (m :: * -> *) a.
a -> Maybe bytes -> DecodeStep bytes failure m a
DecodeDone (Message (ChainSync header point tip) 'StIdle 'StDone
-> SomeMessage 'StIdle
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage Message (ChainSync header point tip) 'StIdle 'StDone
forall k k k (header :: k) (point :: k) (tip :: k).
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 (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")