{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE PolyKinds           #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies        #-}

module Ouroboros.Network.Protocol.ObjectDiffusion.Codec
  ( codecObjectDiffusion
  , codecObjectDiffusionId
  , byteLimitsObjectDiffusion
  , timeLimitsObjectDiffusion
  ) where

import Codec.CBOR.Decoding qualified as CBOR
import Codec.CBOR.Encoding qualified as CBOR
import Codec.CBOR.Read qualified as CBOR
import Control.Monad.Class.MonadST
import Control.Monad.Class.MonadTime.SI
import Data.ByteString.Lazy (ByteString)
import Data.Kind (Type)
import Data.List.NonEmpty qualified as NonEmpty
import Network.TypedProtocol.Codec.CBOR
import Ouroboros.Network.Protocol.Limits
import Ouroboros.Network.Protocol.ObjectDiffusion.Type
import Text.Printf

-- | Byte Limits.
byteLimitsObjectDiffusion
  :: forall bytes objectId object.
     (bytes -> Word)
  -> ProtocolSizeLimits (ObjectDiffusion objectId object) bytes
byteLimitsObjectDiffusion :: forall bytes objectId object.
(bytes -> Word)
-> ProtocolSizeLimits (ObjectDiffusion objectId object) bytes
byteLimitsObjectDiffusion = (forall (st :: ObjectDiffusion objectId object).
 ActiveState st =>
 StateToken st -> Word)
-> (bytes -> Word)
-> ProtocolSizeLimits (ObjectDiffusion objectId object) bytes
forall ps bytes.
(forall (st :: ps). ActiveState st => StateToken st -> Word)
-> (bytes -> Word) -> ProtocolSizeLimits ps bytes
ProtocolSizeLimits StateToken st -> Word
forall (st :: ObjectDiffusion objectId object).
ActiveState st =>
StateToken st -> Word
stateToLimit
  where
    stateToLimit
      :: forall (st :: ObjectDiffusion objectId object).
         ActiveState st
      => StateToken st
      -> Word
    stateToLimit :: forall (st :: ObjectDiffusion objectId object).
ActiveState st =>
StateToken st -> Word
stateToLimit StateToken st
SingObjectDiffusion st
SingInit                        = Word
smallByteLimit
    stateToLimit (SingObjectIds SingBlockingStyle stBlocking
SingBlocking)    = Word
largeByteLimit
    stateToLimit (SingObjectIds SingBlockingStyle stBlocking
SingNonBlocking) = Word
largeByteLimit
    stateToLimit StateToken st
SingObjectDiffusion st
SingObjects                     = Word
largeByteLimit
    stateToLimit StateToken st
SingObjectDiffusion st
SingIdle                        = Word
smallByteLimit
    stateToLimit a :: StateToken st
a@StateToken st
SingObjectDiffusion 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

-- | 'ObjectDiffusion' time limits.
--
-- +---------------------------------+---------------+
-- | 'ObjectDiffusion' state         | timeout (s)   |
-- +=================================+===============+
-- | `StInit`                        | `waitForever` |
-- +---------------------------------+---------------+
-- | `StIdle`                        | `waitForever` |
-- +---------------------------------+---------------+
-- | @'StObjectIds' 'StBlocking'@    | `waitForever` |
-- +---------------------------------+---------------+
-- | @'StObjectIds' 'StNonBlocking'@ | `shortWait`   |
-- +---------------------------------+---------------+
-- | `StObjects`                     | `shortWait`   |
-- +---------------------------------+---------------+
timeLimitsObjectDiffusion
  :: forall (objectId :: Type) (object :: Type).
     ProtocolTimeLimits (ObjectDiffusion objectId object)
timeLimitsObjectDiffusion :: forall objectId object.
ProtocolTimeLimits (ObjectDiffusion objectId object)
timeLimitsObjectDiffusion = (forall (st :: ObjectDiffusion objectId object).
 ActiveState st =>
 StateToken st -> Maybe DiffTime)
-> ProtocolTimeLimits (ObjectDiffusion objectId object)
forall ps.
(forall (st :: ps).
 ActiveState st =>
 StateToken st -> Maybe DiffTime)
-> ProtocolTimeLimits ps
ProtocolTimeLimits StateToken st -> Maybe DiffTime
forall (st :: ObjectDiffusion objectId object).
ActiveState st =>
StateToken st -> Maybe DiffTime
stateToLimit
  where
    stateToLimit
      :: forall (st :: ObjectDiffusion objectId object).
         ActiveState st
      => StateToken st
      -> Maybe DiffTime
    stateToLimit :: forall (st :: ObjectDiffusion objectId object).
ActiveState st =>
StateToken st -> Maybe DiffTime
stateToLimit StateToken st
SingObjectDiffusion st
SingInit                        = Maybe DiffTime
waitForever
    stateToLimit (SingObjectIds SingBlockingStyle stBlocking
SingBlocking)    = Maybe DiffTime
waitForever
    stateToLimit (SingObjectIds SingBlockingStyle stBlocking
SingNonBlocking) = Maybe DiffTime
shortWait
    stateToLimit StateToken st
SingObjectDiffusion st
SingObjects                     = Maybe DiffTime
shortWait
    stateToLimit StateToken st
SingObjectDiffusion st
SingIdle                        = Maybe DiffTime
waitForever
    stateToLimit a :: StateToken st
a@StateToken st
SingObjectDiffusion 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

codecObjectDiffusion
  :: forall (objectId :: Type) (object :: Type) m.
     MonadST m
  => (objectId -> CBOR.Encoding)         -- ^ encode 'objectId'
  -> (forall s. CBOR.Decoder s objectId) -- ^ decode 'objectId'
  -> (object   -> CBOR.Encoding)         -- ^ encode object
  -> (forall s. CBOR.Decoder s object)   -- ^ decode object
  -> Codec (ObjectDiffusion objectId object) CBOR.DeserialiseFailure m ByteString
codecObjectDiffusion :: forall objectId object (m :: * -> *).
MonadST m =>
(objectId -> Encoding)
-> (forall s. Decoder s objectId)
-> (object -> Encoding)
-> (forall s. Decoder s object)
-> Codec
     (ObjectDiffusion objectId object) DeserialiseFailure m ByteString
codecObjectDiffusion objectId -> Encoding
encodeObjectId forall s. Decoder s objectId
decodeObjectId object -> Encoding
encodeObject forall s. Decoder s object
decodeObject =
  (forall (st :: ObjectDiffusion objectId object)
        (st' :: ObjectDiffusion objectId object).
 (StateTokenI st, ActiveState st) =>
 Message (ObjectDiffusion objectId object) st st' -> Encoding)
-> (forall (st :: ObjectDiffusion objectId object) s.
    ActiveState st =>
    StateToken st -> Decoder s (SomeMessage st))
-> CodecF
     (ObjectDiffusion objectId object)
     DeserialiseFailure
     m
     SomeMessage
     ByteString
forall ps (m :: * -> *) (f :: ps -> *).
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 (f st))
-> CodecF ps DeserialiseFailure m f ByteString
mkCodecCborLazyBS
    ((objectId -> Encoding)
-> (object -> Encoding)
-> Message (ObjectDiffusion objectId object) st st'
-> Encoding
forall objectId object (st :: ObjectDiffusion objectId object)
       (st' :: ObjectDiffusion objectId object).
(objectId -> Encoding)
-> (object -> Encoding)
-> Message (ObjectDiffusion objectId object) st st'
-> Encoding
encodeObjectDiffusion objectId -> Encoding
encodeObjectId object -> Encoding
encodeObject)
    StateToken st -> Decoder s (SomeMessage st)
StateToken st -> forall s. Decoder s (SomeMessage st)
forall (st :: ObjectDiffusion objectId object).
ActiveState st =>
StateToken st -> forall s. Decoder s (SomeMessage st)
forall (st :: ObjectDiffusion objectId object) s.
ActiveState st =>
StateToken st -> Decoder s (SomeMessage st)
decode
    where
      decode
        :: forall (st :: ObjectDiffusion objectId object).
           ActiveState st
        => StateToken st
        -> forall s. CBOR.Decoder s (SomeMessage st)
      decode :: forall (st :: ObjectDiffusion objectId object).
ActiveState st =>
StateToken st -> forall s. Decoder s (SomeMessage st)
decode StateToken st
stok = do
        len <- Decoder s Int
forall s. Decoder s Int
CBOR.decodeListLen
        key <- CBOR.decodeWord
        decodeObjectDiffusion decodeObjectId decodeObject stok len key

encodeObjectDiffusion
  :: forall (objectId :: Type) (object :: Type)
            (st  :: ObjectDiffusion objectId object)
            (st' :: ObjectDiffusion objectId object).
     (objectId -> CBOR.Encoding) -- ^ encode 'objectId'
  -> (object   -> CBOR.Encoding) -- ^ encode 'object'
  -> Message (ObjectDiffusion objectId object) st st'
  -> CBOR.Encoding
encodeObjectDiffusion :: forall objectId object (st :: ObjectDiffusion objectId object)
       (st' :: ObjectDiffusion objectId object).
(objectId -> Encoding)
-> (object -> Encoding)
-> Message (ObjectDiffusion objectId object) st st'
-> Encoding
encodeObjectDiffusion objectId -> Encoding
encodeObjectId object -> Encoding
encodeObject = Message (ObjectDiffusion objectId object) st st' -> Encoding
forall (st0 :: ObjectDiffusion objectId object)
       (st1 :: ObjectDiffusion objectId object).
Message (ObjectDiffusion objectId object) st0 st1 -> Encoding
encode
  where
    encode
      :: forall st0 st1.
         Message (ObjectDiffusion objectId object) st0 st1
      -> CBOR.Encoding
    encode :: forall (st0 :: ObjectDiffusion objectId object)
       (st1 :: ObjectDiffusion objectId object).
Message (ObjectDiffusion objectId object) st0 st1 -> Encoding
encode Message (ObjectDiffusion objectId object) st0 st1
R:MessageObjectDiffusionfromto objectId object st0 st1
MsgInit =
         Word -> Encoding
CBOR.encodeListLen Word
1
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeWord Word
0
    encode (MsgRequestObjectIds SingBlockingStyle blocking
blocking (NumObjectIdsAck Word16
ackNo) (NumObjectIdsReq Word16
reqNo)) =
         Word -> Encoding
CBOR.encodeListLen Word
4
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeWord Word
1
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Bool -> Encoding
CBOR.encodeBool
           ( case SingBlockingStyle blocking
blocking of
               SingBlockingStyle blocking
SingBlocking    -> Bool
True
               SingBlockingStyle blocking
SingNonBlocking -> Bool
False
           )
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word16 -> Encoding
CBOR.encodeWord16 Word16
ackNo
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word16 -> Encoding
CBOR.encodeWord16 Word16
reqNo
    encode (MsgReplyObjectIds BlockingReplyList blocking objectId
objIds) =
         Word -> Encoding
CBOR.encodeListLen Word
2
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeWord Word
2
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
CBOR.encodeListLenIndef
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (objectId -> Encoding)
-> BlockingReplyList blocking objectId -> Encoding
forall m a.
Monoid m =>
(a -> m) -> BlockingReplyList blocking a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap objectId -> Encoding
encodeObjectId BlockingReplyList blocking objectId
objIds
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
CBOR.encodeBreak
    encode (MsgRequestObjects [objectId]
objIds) =
         Word -> Encoding
CBOR.encodeListLen Word
2
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeWord Word
3
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
CBOR.encodeListLenIndef
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (objectId -> Encoding) -> [objectId] -> Encoding
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap objectId -> Encoding
encodeObjectId [objectId]
objIds
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
CBOR.encodeBreak
    encode (MsgReplyObjects [object]
objects) =
         Word -> Encoding
CBOR.encodeListLen Word
2
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeWord Word
4
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
CBOR.encodeListLenIndef
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (object -> Encoding) -> [object] -> Encoding
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap object -> Encoding
encodeObject [object]
objects
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
CBOR.encodeBreak
    encode Message (ObjectDiffusion objectId object) st0 st1
R:MessageObjectDiffusionfromto objectId object st0 st1
MsgDone =
         Word -> Encoding
CBOR.encodeListLen Word
1
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeWord Word
5

decodeObjectDiffusion
  :: forall (objectId :: Type) (object :: Type)
            (st :: ObjectDiffusion objectId object) s.
     ActiveState st
  => (forall s'. CBOR.Decoder s' objectId) -- ^ decode 'objectId'
  -> (forall s'. CBOR.Decoder s' object)   -- ^ decode object
  -> StateToken st
  -> Int
  -> Word
  -> CBOR.Decoder s (SomeMessage st)
decodeObjectDiffusion :: forall objectId object (st :: ObjectDiffusion objectId object) s.
ActiveState st =>
(forall s'. Decoder s' objectId)
-> (forall s'. Decoder s' object)
-> StateToken st
-> Int
-> Word
-> Decoder s (SomeMessage st)
decodeObjectDiffusion forall s'. Decoder s' objectId
decodeObjectId forall s'. Decoder s' object
decodeObject = StateToken st -> Int -> Word -> Decoder s (SomeMessage st)
forall (st' :: ObjectDiffusion objectId object).
ActiveState st' =>
StateToken st' -> Int -> Word -> Decoder s (SomeMessage st')
decode
  where
    decode
      :: forall (st' :: ObjectDiffusion objectId object).
         ActiveState st'
      => StateToken st'
      -> Int
      -> Word
      -> CBOR.Decoder s (SomeMessage st')
    decode :: forall (st' :: ObjectDiffusion objectId object).
ActiveState st' =>
StateToken st' -> Int -> Word -> Decoder s (SomeMessage st')
decode StateToken st'
stok Int
len Word
key = do
      case (StateToken st'
SingObjectDiffusion st'
stok, Int
len, Word
key) of
        (SingObjectDiffusion st'
SingInit, Int
1, Word
0) ->
          SomeMessage st' -> Decoder s (SomeMessage st')
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeMessage st' -> Decoder s (SomeMessage st'))
-> SomeMessage st' -> Decoder s (SomeMessage st')
forall a b. (a -> b) -> a -> b
$ Message (ObjectDiffusion objectId object) st' 'StIdle
-> SomeMessage st'
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage Message (ObjectDiffusion objectId object) st' 'StIdle
Message (ObjectDiffusion objectId object) 'StInit 'StIdle
forall objectId object.
Message (ObjectDiffusion objectId object) 'StInit 'StIdle
MsgInit
        (SingObjectDiffusion st'
SingIdle, Int
4, Word
1) -> do
          blocking <- Decoder s Bool
forall s. Decoder s Bool
CBOR.decodeBool
          ackNo <- NumObjectIdsAck <$> CBOR.decodeWord16
          reqNo <- NumObjectIdsReq <$> CBOR.decodeWord16
          return $! if blocking
            then SomeMessage $ MsgRequestObjectIds SingBlocking ackNo reqNo
            else SomeMessage $ MsgRequestObjectIds SingNonBlocking ackNo reqNo
        (SingObjectIds SingBlockingStyle stBlocking
b, Int
2, Word
2) -> do
          Decoder s ()
forall s. Decoder s ()
CBOR.decodeListLenIndef
          objIds <- ([objectId] -> objectId -> [objectId])
-> [objectId]
-> ([objectId] -> [objectId])
-> Decoder s objectId
-> Decoder s [objectId]
forall r a r' s.
(r -> a -> r) -> r -> (r -> r') -> Decoder s a -> Decoder s r'
CBOR.decodeSequenceLenIndef
                      ((objectId -> [objectId] -> [objectId])
-> [objectId] -> objectId -> [objectId]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:))
                      []
                      [objectId] -> [objectId]
forall a. [a] -> [a]
reverse
                      Decoder s objectId
forall s'. Decoder s' objectId
decodeObjectId
          case (b, objIds) of
            (SingBlockingStyle stBlocking
SingBlocking, objectId
t : [objectId]
ts) ->
              SomeMessage st' -> Decoder s (SomeMessage st')
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return
                (SomeMessage st' -> Decoder s (SomeMessage st'))
-> SomeMessage st' -> Decoder s (SomeMessage st')
forall a b. (a -> b) -> a -> b
$ Message (ObjectDiffusion objectId object) st' 'StIdle
-> SomeMessage st'
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage
                (Message (ObjectDiffusion objectId object) st' 'StIdle
 -> SomeMessage st')
-> Message (ObjectDiffusion objectId object) st' 'StIdle
-> SomeMessage st'
forall a b. (a -> b) -> a -> b
$ BlockingReplyList 'StBlocking objectId
-> Message
     (ObjectDiffusion objectId object)
     ('StObjectIds 'StBlocking)
     'StIdle
forall (blocking :: StBlockingStyle) objectId object.
BlockingReplyList blocking objectId
-> Message
     (ObjectDiffusion objectId object) ('StObjectIds blocking) 'StIdle
MsgReplyObjectIds (NonEmpty objectId -> BlockingReplyList 'StBlocking objectId
forall a. NonEmpty a -> BlockingReplyList 'StBlocking a
BlockingReply (objectId
t objectId -> [objectId] -> NonEmpty objectId
forall a. a -> [a] -> NonEmpty a
NonEmpty.:| [objectId]
ts))
            (SingBlockingStyle stBlocking
SingNonBlocking, [objectId]
ts) ->
              SomeMessage st' -> Decoder s (SomeMessage st')
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return
                (SomeMessage st' -> Decoder s (SomeMessage st'))
-> SomeMessage st' -> Decoder s (SomeMessage st')
forall a b. (a -> b) -> a -> b
$ Message (ObjectDiffusion objectId object) st' 'StIdle
-> SomeMessage st'
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage
                (Message (ObjectDiffusion objectId object) st' 'StIdle
 -> SomeMessage st')
-> Message (ObjectDiffusion objectId object) st' 'StIdle
-> SomeMessage st'
forall a b. (a -> b) -> a -> b
$ BlockingReplyList 'StNonBlocking objectId
-> Message
     (ObjectDiffusion objectId object)
     ('StObjectIds 'StNonBlocking)
     'StIdle
forall (blocking :: StBlockingStyle) objectId object.
BlockingReplyList blocking objectId
-> Message
     (ObjectDiffusion objectId object) ('StObjectIds blocking) 'StIdle
MsgReplyObjectIds ([objectId] -> BlockingReplyList 'StNonBlocking objectId
forall a. [a] -> BlockingReplyList 'StNonBlocking a
NonBlockingReply [objectId]
ts)
            (SingBlockingStyle stBlocking
SingBlocking, []) ->
              String -> Decoder s (SomeMessage st')
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"codecObjectDiffusion: MsgReplyObjectIds: empty list not permitted"
        (SingObjectDiffusion st'
SingIdle, Int
2, Word
3) -> do
          Decoder s ()
forall s. Decoder s ()
CBOR.decodeListLenIndef
          objIds <- ([objectId] -> objectId -> [objectId])
-> [objectId]
-> ([objectId] -> [objectId])
-> Decoder s objectId
-> Decoder s [objectId]
forall r a r' s.
(r -> a -> r) -> r -> (r -> r') -> Decoder s a -> Decoder s r'
CBOR.decodeSequenceLenIndef
                      ((objectId -> [objectId] -> [objectId])
-> [objectId] -> objectId -> [objectId]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:))
                      []
                      [objectId] -> [objectId]
forall a. [a] -> [a]
reverse
                      Decoder s objectId
forall s'. Decoder s' objectId
decodeObjectId
          return $ SomeMessage $ MsgRequestObjects objIds
        (SingObjectDiffusion st'
SingObjects, Int
2, Word
4) -> do
          Decoder s ()
forall s. Decoder s ()
CBOR.decodeListLenIndef
          objIds <- ([object] -> object -> [object])
-> [object]
-> ([object] -> [object])
-> Decoder s object
-> Decoder s [object]
forall r a r' s.
(r -> a -> r) -> r -> (r -> r') -> Decoder s a -> Decoder s r'
CBOR.decodeSequenceLenIndef
                      ((object -> [object] -> [object]) -> [object] -> object -> [object]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:))
                      []
                      [object] -> [object]
forall a. [a] -> [a]
reverse
                      Decoder s object
forall s'. Decoder s' object
decodeObject
          return $ SomeMessage $ MsgReplyObjects objIds
        (SingObjectDiffusion st'
SingIdle, Int
1, Word
5) ->
          SomeMessage st' -> Decoder s (SomeMessage st')
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeMessage st' -> Decoder s (SomeMessage st'))
-> SomeMessage st' -> Decoder s (SomeMessage st')
forall a b. (a -> b) -> a -> b
$ Message (ObjectDiffusion objectId object) st' 'StDone
-> SomeMessage st'
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage Message (ObjectDiffusion objectId object) st' 'StDone
Message (ObjectDiffusion objectId object) 'StIdle 'StDone
forall objectId object.
Message (ObjectDiffusion objectId object) 'StIdle 'StDone
MsgDone
        (SingObjectDiffusion st'
SingDone, Int
_, Word
_) -> 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
        -- failures per protocol state
        (SingObjectDiffusion st'
SingInit, Int
_, Word
_) ->
          String -> Decoder s (SomeMessage st')
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s (SomeMessage st'))
-> String -> Decoder s (SomeMessage st')
forall a b. (a -> b) -> a -> b
$ String -> String -> Word -> Int -> String
forall r. PrintfType r => String -> r
printf String
"codecObjectDiffusion (%s) unexpected key (%d, %d)" (SingObjectDiffusion 'StInit -> String
forall a. Show a => a -> String
show StateToken st'
SingObjectDiffusion 'StInit
stok) Word
key Int
len
        (SingObjectIds SingBlockingStyle stBlocking
SingBlocking, Int
_, Word
_) ->
          String -> Decoder s (SomeMessage st')
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s (SomeMessage st'))
-> String -> Decoder s (SomeMessage st')
forall a b. (a -> b) -> a -> b
$ String -> String -> Word -> Int -> String
forall r. PrintfType r => String -> r
printf String
"codecObjectDiffusion (%s) unexpected key (%d, %d)" (SingObjectDiffusion ('StObjectIds 'StBlocking) -> String
forall a. Show a => a -> String
show StateToken st'
SingObjectDiffusion ('StObjectIds 'StBlocking)
stok) Word
key Int
len
        (SingObjectIds SingBlockingStyle stBlocking
SingNonBlocking, Int
_, Word
_) ->
          String -> Decoder s (SomeMessage st')
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s (SomeMessage st'))
-> String -> Decoder s (SomeMessage st')
forall a b. (a -> b) -> a -> b
$ String -> String -> Word -> Int -> String
forall r. PrintfType r => String -> r
printf String
"codecObjectDiffusion (%s) unexpected key (%d, %d)" (SingObjectDiffusion ('StObjectIds 'StNonBlocking) -> String
forall a. Show a => a -> String
show StateToken st'
SingObjectDiffusion ('StObjectIds 'StNonBlocking)
stok) Word
key Int
len
        (SingObjectDiffusion st'
SingObjects, Int
_, Word
_) ->
          String -> Decoder s (SomeMessage st')
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s (SomeMessage st'))
-> String -> Decoder s (SomeMessage st')
forall a b. (a -> b) -> a -> b
$ String -> String -> Word -> Int -> String
forall r. PrintfType r => String -> r
printf String
"codecObjectDiffusion (%s) unexpected key (%d, %d)" (SingObjectDiffusion 'StObjects -> String
forall a. Show a => a -> String
show StateToken st'
SingObjectDiffusion 'StObjects
stok) Word
key Int
len
        (SingObjectDiffusion st'
SingIdle, Int
_, Word
_) ->
          String -> Decoder s (SomeMessage st')
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s (SomeMessage st'))
-> String -> Decoder s (SomeMessage st')
forall a b. (a -> b) -> a -> b
$ String -> String -> Word -> Int -> String
forall r. PrintfType r => String -> r
printf String
"codecObjectDiffusion (%s) unexpected key (%d, %d)" (SingObjectDiffusion 'StIdle -> String
forall a. Show a => a -> String
show StateToken st'
SingObjectDiffusion 'StIdle
stok) Word
key Int
len

codecObjectDiffusionId
  :: forall objectId object m.
     Monad m
  => Codec
       (ObjectDiffusion objectId object)
       CodecFailure
       m
       (AnyMessage (ObjectDiffusion objectId object))
codecObjectDiffusionId :: forall objectId object (m :: * -> *).
Monad m =>
Codec
  (ObjectDiffusion objectId object)
  CodecFailure
  m
  (AnyMessage (ObjectDiffusion objectId object))
codecObjectDiffusionId = Codec {Message (ObjectDiffusion objectId object) st st'
-> AnyMessage (ObjectDiffusion objectId object)
forall (st :: ObjectDiffusion objectId object)
       (st' :: ObjectDiffusion objectId object).
(ActiveState st, StateTokenI st) =>
Message (ObjectDiffusion objectId object) st st'
-> AnyMessage (ObjectDiffusion objectId object)
forall (st :: ObjectDiffusion objectId object)
       (st' :: ObjectDiffusion objectId object).
(StateTokenI st, ActiveState st) =>
Message (ObjectDiffusion objectId object) st st'
-> AnyMessage (ObjectDiffusion objectId object)
encode :: forall (st :: ObjectDiffusion objectId object)
       (st' :: ObjectDiffusion objectId object).
(ActiveState st, StateTokenI st) =>
Message (ObjectDiffusion objectId object) st st'
-> AnyMessage (ObjectDiffusion objectId object)
encode :: forall (st :: ObjectDiffusion objectId object)
       (st' :: ObjectDiffusion objectId object).
(StateTokenI st, ActiveState st) =>
Message (ObjectDiffusion objectId object) st st'
-> AnyMessage (ObjectDiffusion objectId object)
encode, StateToken st
-> m (DecodeStep
        (AnyMessage (ObjectDiffusion objectId object))
        CodecFailure
        m
        (SomeMessage st))
forall (st :: ObjectDiffusion objectId object).
ActiveState st =>
StateToken st
-> m (DecodeStep
        (AnyMessage (ObjectDiffusion objectId object))
        CodecFailure
        m
        (SomeMessage st))
decode :: forall (st :: ObjectDiffusion objectId object).
ActiveState st =>
StateToken st
-> m (DecodeStep
        (AnyMessage (ObjectDiffusion objectId object))
        CodecFailure
        m
        (SomeMessage st))
decode :: forall (st :: ObjectDiffusion objectId object).
ActiveState st =>
StateToken st
-> m (DecodeStep
        (AnyMessage (ObjectDiffusion objectId object))
        CodecFailure
        m
        (SomeMessage st))
decode}
  where
    encode
      :: forall st st'.
         ( ActiveState st
         , StateTokenI st
         )
      => Message (ObjectDiffusion objectId object) st st'
      -> AnyMessage (ObjectDiffusion objectId object)
    encode :: forall (st :: ObjectDiffusion objectId object)
       (st' :: ObjectDiffusion objectId object).
(ActiveState st, StateTokenI st) =>
Message (ObjectDiffusion objectId object) st st'
-> AnyMessage (ObjectDiffusion objectId object)
encode = Message (ObjectDiffusion objectId object) st st'
-> AnyMessage (ObjectDiffusion objectId object)
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
Message ps st st' -> AnyMessage ps
AnyMessage

    decode
      :: forall (st :: ObjectDiffusion objectId object).
         ActiveState st
      => StateToken st
      -> m (DecodeStep
             (AnyMessage (ObjectDiffusion objectId object))
             CodecFailure
             m
             (SomeMessage st)
           )
    decode :: forall (st :: ObjectDiffusion objectId object).
ActiveState st =>
StateToken st
-> m (DecodeStep
        (AnyMessage (ObjectDiffusion objectId object))
        CodecFailure
        m
        (SomeMessage st))
decode StateToken st
stok = DecodeStep
  (AnyMessage (ObjectDiffusion objectId object))
  CodecFailure
  m
  (SomeMessage st)
-> m (DecodeStep
        (AnyMessage (ObjectDiffusion objectId object))
        CodecFailure
        m
        (SomeMessage st))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (DecodeStep
   (AnyMessage (ObjectDiffusion objectId object))
   CodecFailure
   m
   (SomeMessage st)
 -> m (DecodeStep
         (AnyMessage (ObjectDiffusion objectId object))
         CodecFailure
         m
         (SomeMessage st)))
-> DecodeStep
     (AnyMessage (ObjectDiffusion objectId object))
     CodecFailure
     m
     (SomeMessage st)
-> m (DecodeStep
        (AnyMessage (ObjectDiffusion objectId object))
        CodecFailure
        m
        (SomeMessage st))
forall a b. (a -> b) -> a -> b
$ (Maybe (AnyMessage (ObjectDiffusion objectId object))
 -> m (DecodeStep
         (AnyMessage (ObjectDiffusion objectId object))
         CodecFailure
         m
         (SomeMessage st)))
-> DecodeStep
     (AnyMessage (ObjectDiffusion objectId object))
     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 (ObjectDiffusion objectId object))
  -> m (DecodeStep
          (AnyMessage (ObjectDiffusion objectId object))
          CodecFailure
          m
          (SomeMessage st)))
 -> DecodeStep
      (AnyMessage (ObjectDiffusion objectId object))
      CodecFailure
      m
      (SomeMessage st))
-> (Maybe (AnyMessage (ObjectDiffusion objectId object))
    -> m (DecodeStep
            (AnyMessage (ObjectDiffusion objectId object))
            CodecFailure
            m
            (SomeMessage st)))
-> DecodeStep
     (AnyMessage (ObjectDiffusion objectId object))
     CodecFailure
     m
     (SomeMessage st)
forall a b. (a -> b) -> a -> b
$ \Maybe (AnyMessage (ObjectDiffusion objectId object))
bytes ->
      DecodeStep
  (AnyMessage (ObjectDiffusion objectId object))
  CodecFailure
  m
  (SomeMessage st)
-> m (DecodeStep
        (AnyMessage (ObjectDiffusion objectId object))
        CodecFailure
        m
        (SomeMessage st))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (DecodeStep
   (AnyMessage (ObjectDiffusion objectId object))
   CodecFailure
   m
   (SomeMessage st)
 -> m (DecodeStep
         (AnyMessage (ObjectDiffusion objectId object))
         CodecFailure
         m
         (SomeMessage st)))
-> DecodeStep
     (AnyMessage (ObjectDiffusion objectId object))
     CodecFailure
     m
     (SomeMessage st)
-> m (DecodeStep
        (AnyMessage (ObjectDiffusion objectId object))
        CodecFailure
        m
        (SomeMessage st))
forall a b. (a -> b) -> a -> b
$ case (StateToken st
SingObjectDiffusion st
stok, Maybe (AnyMessage (ObjectDiffusion objectId object))
bytes) of
        (SingObjectDiffusion st
SingInit, Just (AnyMessage msg :: Message (ObjectDiffusion objectId object) st st'
msg@Message (ObjectDiffusion objectId object) st st'
R:MessageObjectDiffusionfromto objectId object st st'
MsgInit)) ->
          SomeMessage st
-> Maybe (AnyMessage (ObjectDiffusion objectId object))
-> DecodeStep
     (AnyMessage (ObjectDiffusion objectId object))
     CodecFailure
     m
     (SomeMessage st)
forall bytes failure (m :: * -> *) a.
a -> Maybe bytes -> DecodeStep bytes failure m a
DecodeDone (Message (ObjectDiffusion objectId object) st st' -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage Message (ObjectDiffusion objectId object) st st'
Message (ObjectDiffusion objectId object) st st'
msg) Maybe (AnyMessage (ObjectDiffusion objectId object))
forall a. Maybe a
Nothing
        (SingObjectDiffusion st
SingIdle, Just (AnyMessage msg :: Message (ObjectDiffusion objectId object) st st'
msg@(MsgRequestObjectIds SingBlockingStyle blocking
SingBlocking NumObjectIdsAck
_ NumObjectIdsReq
_))) ->
          SomeMessage st
-> Maybe (AnyMessage (ObjectDiffusion objectId object))
-> DecodeStep
     (AnyMessage (ObjectDiffusion objectId object))
     CodecFailure
     m
     (SomeMessage st)
forall bytes failure (m :: * -> *) a.
a -> Maybe bytes -> DecodeStep bytes failure m a
DecodeDone (Message (ObjectDiffusion objectId object) st st' -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage Message (ObjectDiffusion objectId object) st st'
Message (ObjectDiffusion objectId object) st st'
msg) Maybe (AnyMessage (ObjectDiffusion objectId object))
forall a. Maybe a
Nothing
        (SingObjectDiffusion st
SingIdle, Just (AnyMessage msg :: Message (ObjectDiffusion objectId object) st st'
msg@(MsgRequestObjectIds SingBlockingStyle blocking
SingNonBlocking NumObjectIdsAck
_ NumObjectIdsReq
_))) ->
          SomeMessage st
-> Maybe (AnyMessage (ObjectDiffusion objectId object))
-> DecodeStep
     (AnyMessage (ObjectDiffusion objectId object))
     CodecFailure
     m
     (SomeMessage st)
forall bytes failure (m :: * -> *) a.
a -> Maybe bytes -> DecodeStep bytes failure m a
DecodeDone (Message (ObjectDiffusion objectId object) st st' -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage Message (ObjectDiffusion objectId object) st st'
Message (ObjectDiffusion objectId object) st st'
msg) Maybe (AnyMessage (ObjectDiffusion objectId object))
forall a. Maybe a
Nothing
        (SingObjectDiffusion st
SingIdle, Just (AnyMessage msg :: Message (ObjectDiffusion objectId object) st st'
msg@(MsgRequestObjects {}))) ->
          SomeMessage st
-> Maybe (AnyMessage (ObjectDiffusion objectId object))
-> DecodeStep
     (AnyMessage (ObjectDiffusion objectId object))
     CodecFailure
     m
     (SomeMessage st)
forall bytes failure (m :: * -> *) a.
a -> Maybe bytes -> DecodeStep bytes failure m a
DecodeDone (Message (ObjectDiffusion objectId object) st st' -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage Message (ObjectDiffusion objectId object) st st'
Message (ObjectDiffusion objectId object) st st'
msg) Maybe (AnyMessage (ObjectDiffusion objectId object))
forall a. Maybe a
Nothing
        (SingObjectDiffusion st
SingObjects, Just (AnyMessage msg :: Message (ObjectDiffusion objectId object) st st'
msg@(MsgReplyObjects {}))) ->
          SomeMessage st
-> Maybe (AnyMessage (ObjectDiffusion objectId object))
-> DecodeStep
     (AnyMessage (ObjectDiffusion objectId object))
     CodecFailure
     m
     (SomeMessage st)
forall bytes failure (m :: * -> *) a.
a -> Maybe bytes -> DecodeStep bytes failure m a
DecodeDone (Message (ObjectDiffusion objectId object) st st' -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage Message (ObjectDiffusion objectId object) st st'
Message (ObjectDiffusion objectId object) st st'
msg) Maybe (AnyMessage (ObjectDiffusion objectId object))
forall a. Maybe a
Nothing
        (SingObjectIds SingBlockingStyle stBlocking
b, Just (AnyMessage Message (ObjectDiffusion objectId object) st st'
msg)) -> case (SingBlockingStyle stBlocking
b, Message (ObjectDiffusion objectId object) st st'
msg) of
          (SingBlockingStyle stBlocking
SingBlocking, MsgReplyObjectIds (BlockingReply {})) ->
            SomeMessage st
-> Maybe (AnyMessage (ObjectDiffusion objectId object))
-> DecodeStep
     (AnyMessage (ObjectDiffusion objectId object))
     CodecFailure
     m
     (SomeMessage st)
forall bytes failure (m :: * -> *) a.
a -> Maybe bytes -> DecodeStep bytes failure m a
DecodeDone (Message (ObjectDiffusion objectId object) st st' -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage Message (ObjectDiffusion objectId object) st st'
Message (ObjectDiffusion objectId object) st st'
msg) Maybe (AnyMessage (ObjectDiffusion objectId object))
forall a. Maybe a
Nothing
          (SingBlockingStyle stBlocking
SingNonBlocking, MsgReplyObjectIds (NonBlockingReply {})) ->
            SomeMessage st
-> Maybe (AnyMessage (ObjectDiffusion objectId object))
-> DecodeStep
     (AnyMessage (ObjectDiffusion objectId object))
     CodecFailure
     m
     (SomeMessage st)
forall bytes failure (m :: * -> *) a.
a -> Maybe bytes -> DecodeStep bytes failure m a
DecodeDone (Message (ObjectDiffusion objectId object) st st' -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage Message (ObjectDiffusion objectId object) st st'
Message (ObjectDiffusion objectId object) st st'
msg) Maybe (AnyMessage (ObjectDiffusion objectId object))
forall a. Maybe a
Nothing
          (SingBlockingStyle stBlocking
_, Message (ObjectDiffusion objectId object) st st'
_) ->
            CodecFailure
-> DecodeStep
     (AnyMessage (ObjectDiffusion objectId object))
     CodecFailure
     m
     (SomeMessage st)
forall bytes failure (m :: * -> *) a.
failure -> DecodeStep bytes failure m a
DecodeFail (CodecFailure
 -> DecodeStep
      (AnyMessage (ObjectDiffusion objectId object))
      CodecFailure
      m
      (SomeMessage st))
-> CodecFailure
-> DecodeStep
     (AnyMessage (ObjectDiffusion objectId object))
     CodecFailure
     m
     (SomeMessage st)
forall a b. (a -> b) -> a -> b
$ String -> CodecFailure
CodecFailure String
"codecObjectDiffusionId: no matching message"
        (SingObjectDiffusion st
SingIdle, Just (AnyMessage msg :: Message (ObjectDiffusion objectId object) st st'
msg@Message (ObjectDiffusion objectId object) st st'
R:MessageObjectDiffusionfromto objectId object st st'
MsgDone)) ->
          SomeMessage st
-> Maybe (AnyMessage (ObjectDiffusion objectId object))
-> DecodeStep
     (AnyMessage (ObjectDiffusion objectId object))
     CodecFailure
     m
     (SomeMessage st)
forall bytes failure (m :: * -> *) a.
a -> Maybe bytes -> DecodeStep bytes failure m a
DecodeDone (Message (ObjectDiffusion objectId object) st st' -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage Message (ObjectDiffusion objectId object) st st'
Message (ObjectDiffusion objectId object) st st'
msg) Maybe (AnyMessage (ObjectDiffusion objectId object))
forall a. Maybe a
Nothing
        (SingObjectDiffusion st
SingDone, Maybe (AnyMessage (ObjectDiffusion objectId object))
_) ->
          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
        (SingObjectDiffusion st
_, Maybe (AnyMessage (ObjectDiffusion objectId object))
_) ->
          CodecFailure
-> DecodeStep
     (AnyMessage (ObjectDiffusion objectId object))
     CodecFailure
     m
     (SomeMessage st)
forall bytes failure (m :: * -> *) a.
failure -> DecodeStep bytes failure m a
DecodeFail (CodecFailure
 -> DecodeStep
      (AnyMessage (ObjectDiffusion objectId object))
      CodecFailure
      m
      (SomeMessage st))
-> CodecFailure
-> DecodeStep
     (AnyMessage (ObjectDiffusion objectId object))
     CodecFailure
     m
     (SomeMessage st)
forall a b. (a -> b) -> a -> b
$ String -> CodecFailure
CodecFailure String
"codecObjectDiffusionId: no matching message"