module Hydra.Network.Ouroboros.Codec where

import Hydra.Prelude

import Cardano.Binary qualified as CBOR
import Codec.CBOR.Read qualified as CBOR
import Hydra.Network.Ouroboros.Type (FireForget (..), Message (..), SFireForget (..))
import Network.TypedProtocol.Codec
import Network.TypedProtocol.Codec.CBOR (mkCodecCborLazyBS)
import Network.TypedProtocol.Core

codecFireForget ::
  forall m msg.
  (MonadST m, FromCBOR msg, ToCBOR msg) =>
  Codec (FireForget msg) CBOR.DeserialiseFailure m LByteString
codecFireForget :: forall (m :: * -> *) msg.
(MonadST m, FromCBOR msg, ToCBOR msg) =>
Codec (FireForget msg) DeserialiseFailure m LByteString
codecFireForget =
  (forall (st :: FireForget msg) (st' :: FireForget msg).
 (StateTokenI st, ActiveState st) =>
 Message (FireForget msg) st st' -> Encoding)
-> (forall (st :: FireForget msg) s.
    ActiveState st =>
    StateToken st -> Decoder s (SomeMessage st))
-> Codec (FireForget msg) DeserialiseFailure m LByteString
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 LByteString
mkCodecCborLazyBS Message (FireForget msg) st st' -> Encoding
forall msg' (st :: FireForget msg') (st' :: FireForget msg').
ToCBOR msg' =>
Message (FireForget msg') st st' -> Encoding
forall (st :: FireForget msg) (st' :: FireForget msg).
(StateTokenI st, ActiveState st) =>
Message (FireForget msg) st st' -> Encoding
encode StateToken st -> Decoder s (SomeMessage st)
forall msg' s (st :: FireForget msg').
(FromCBOR msg', ActiveState st) =>
StateToken st -> Decoder s (SomeMessage st)
forall (st :: FireForget msg) s.
ActiveState st =>
StateToken st -> Decoder s (SomeMessage st)
decode
 where
  encode ::
    forall msg' (st :: FireForget msg') (st' :: FireForget msg').
    ToCBOR msg' =>
    Message (FireForget msg') st st' ->
    CBOR.Encoding
  encode :: forall msg' (st :: FireForget msg') (st' :: FireForget msg').
ToCBOR msg' =>
Message (FireForget msg') st st' -> Encoding
encode Message (FireForget msg') st st'
R:MessageFireForgetfromto (*) msg' st st'
MsgDone = Word -> Encoding
CBOR.encodeWord Word
0
  encode (MsgSend msg1
msg) = Word -> Encoding
CBOR.encodeWord Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> msg1 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR msg1
msg

  decode ::
    forall msg' s (st :: FireForget msg').
    (FromCBOR msg', ActiveState st) =>
    StateToken st ->
    CBOR.Decoder s (SomeMessage st)
  decode :: forall msg' s (st :: FireForget msg').
(FromCBOR msg', ActiveState st) =>
StateToken st -> Decoder s (SomeMessage st)
decode StateToken st
stok = do
    Word
key <- Decoder s Word
forall s. Decoder s Word
CBOR.decodeWord
    case (StateToken st
SFireForget st
stok, Word
key) of
      (SFireForget st
SingIdle, Word
0) -> SomeMessage st -> Decoder s (SomeMessage st)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeMessage st -> Decoder s (SomeMessage st))
-> SomeMessage st -> Decoder s (SomeMessage st)
forall a b. (a -> b) -> a -> b
$ Message (FireForget msg') st 'StDone -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage Message (FireForget msg') st 'StDone
Message (FireForget msg') 'StIdle 'StDone
forall {k} (msg :: k). Message (FireForget msg) 'StIdle 'StDone
MsgDone
      (SFireForget st
SingIdle, Word
1) -> Message (FireForget msg') st 'StIdle -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage (Message (FireForget msg') st 'StIdle -> SomeMessage st)
-> (msg' -> Message (FireForget msg') st 'StIdle)
-> msg'
-> SomeMessage st
forall b c a. (b -> c) -> (a -> b) -> a -> c
. msg' -> Message (FireForget msg') st 'StIdle
msg' -> Message (FireForget msg') 'StIdle 'StIdle
forall msg1. msg1 -> Message (FireForget msg1) 'StIdle 'StIdle
MsgSend (msg' -> SomeMessage st)
-> Decoder s msg' -> Decoder s (SomeMessage st)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s msg'
forall s. Decoder s msg'
forall a s. FromCBOR a => Decoder s a
fromCBOR
      (SFireForget st
_, Word
_) -> String -> Decoder s (SomeMessage st)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"codedFireForget.StIdle: unexpected"