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

module Ouroboros.Network.Protocol.KeepAlive.Codec
  ( codecKeepAlive_v2
  , codecKeepAliveId
  , byteLimitsKeepAlive
  , timeLimitsKeepAlive
  ) where

import Control.Monad.Class.MonadST
import Control.Monad.Class.MonadTime.SI (DiffTime)

import Data.ByteString.Lazy (ByteString)
import Text.Printf

import Codec.CBOR.Decoding qualified as CBOR (Decoder, decodeListLen,
           decodeWord, decodeWord16)
import Codec.CBOR.Encoding qualified as CBOR (Encoding, encodeListLen,
           encodeWord, encodeWord16)
import Codec.CBOR.Read qualified as CBOR

import Network.TypedProtocol.Codec.CBOR
import Network.TypedProtocol.Core

import Ouroboros.Network.Protocol.KeepAlive.Type
import Ouroboros.Network.Protocol.Limits


codecKeepAlive_v2
  :: forall m.
     MonadST m
  => Codec KeepAlive CBOR.DeserialiseFailure m ByteString
codecKeepAlive_v2 :: forall (m :: * -> *).
MonadST m =>
Codec KeepAlive DeserialiseFailure m ByteString
codecKeepAlive_v2 = (forall (st :: KeepAlive) (st' :: KeepAlive).
 (StateTokenI st, ActiveState st) =>
 Message KeepAlive st st' -> Encoding)
-> (forall (st :: KeepAlive) s.
    ActiveState st =>
    StateToken st -> Decoder s (SomeMessage st))
-> Codec KeepAlive 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 KeepAlive st st' -> Encoding
forall (st :: KeepAlive) (st' :: KeepAlive).
Message KeepAlive st st' -> Encoding
forall (st :: KeepAlive) (st' :: KeepAlive).
(StateTokenI st, ActiveState st) =>
Message KeepAlive st st' -> Encoding
encodeMsg StateToken st -> Decoder s (SomeMessage st)
forall s (st :: KeepAlive).
ActiveState st =>
StateToken st -> Decoder s (SomeMessage st)
forall (st :: KeepAlive) s.
ActiveState st =>
StateToken st -> Decoder s (SomeMessage st)
decodeMsg
   where
     encodeMsg :: forall st st'.
                  Message KeepAlive st st'
               -> CBOR.Encoding
     encodeMsg :: forall (st :: KeepAlive) (st' :: KeepAlive).
Message KeepAlive st st' -> Encoding
encodeMsg (MsgKeepAlive (Cookie Word16
c)) =
          Word -> Encoding
CBOR.encodeListLen Word
2
       Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeWord Word
0
       Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word16 -> Encoding
CBOR.encodeWord16 Word16
c
     encodeMsg (MsgKeepAliveResponse (Cookie Word16
c)) =
          Word -> Encoding
CBOR.encodeListLen Word
2
       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
<> Word16 -> Encoding
CBOR.encodeWord16 Word16
c
     encodeMsg Message KeepAlive st st'
R:MessageKeepAlivefromto st st'
MsgDone =
          Word -> Encoding
CBOR.encodeListLen Word
1
       Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeWord Word
2

     decodeMsg :: forall s (st :: KeepAlive).
                  ActiveState st
               => StateToken st
               -> CBOR.Decoder s (SomeMessage st)
     decodeMsg :: forall s (st :: KeepAlive).
ActiveState st =>
StateToken st -> Decoder s (SomeMessage st)
decodeMsg StateToken st
stok = do
       len <- Decoder s Int
forall s. Decoder s Int
CBOR.decodeListLen
       key <- CBOR.decodeWord
       case (stok, len, key) of
         (SingKeepAlive st
SingClient, Int
2, Word
0) -> do
             cookie <- Decoder s Word16
forall s. Decoder s Word16
CBOR.decodeWord16
             return (SomeMessage $ MsgKeepAlive $ Cookie cookie)
         (SingKeepAlive st
SingServer, Int
2, Word
1) -> do
             cookie <- Decoder s Word16
forall s. Decoder s Word16
CBOR.decodeWord16
             return (SomeMessage $ MsgKeepAliveResponse $ Cookie cookie)
         (SingKeepAlive st
SingClient, Int
1, Word
2) -> SomeMessage st -> Decoder s (SomeMessage st)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Message KeepAlive st 'StDone -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage Message KeepAlive st 'StDone
Message KeepAlive 'StClient 'StDone
MsgDone)

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

         (SingKeepAlive st
_, Int
_, Word
_) ->
           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
"codecKeepAlive (%s, %s) unexpected key (%d, %d)" (ActiveAgency' st (StateAgency st) -> String
forall a. Show a => a -> String
show (ActiveAgency' st (StateAgency st)
forall {ps} (st :: ps) (agency :: Agency).
IsActiveState st agency =>
ActiveAgency' st agency
activeAgency :: ActiveAgency st)) (SingKeepAlive st -> String
forall a. Show a => a -> String
show StateToken st
SingKeepAlive st
stok) Word
key Int
len)


byteLimitsKeepAlive :: (bytes -> Word) -> ProtocolSizeLimits KeepAlive bytes
byteLimitsKeepAlive :: forall bytes. (bytes -> Word) -> ProtocolSizeLimits KeepAlive bytes
byteLimitsKeepAlive = (forall (st :: KeepAlive). ActiveState st => StateToken st -> Word)
-> (bytes -> Word) -> ProtocolSizeLimits KeepAlive bytes
forall ps bytes.
(forall (st :: ps). ActiveState st => StateToken st -> Word)
-> (bytes -> Word) -> ProtocolSizeLimits ps bytes
ProtocolSizeLimits StateToken st -> Word
forall (st :: KeepAlive). ActiveState st => StateToken st -> Word
sizeLimitForState
  where
    sizeLimitForState :: ActiveState st
                      => StateToken (st :: KeepAlive)
                      -> Word
    sizeLimitForState :: forall (st :: KeepAlive). ActiveState st => StateToken st -> Word
sizeLimitForState StateToken st
SingKeepAlive st
SingClient = Word
smallByteLimit
    sizeLimitForState StateToken st
SingKeepAlive st
SingServer = Word
smallByteLimit
    sizeLimitForState a :: StateToken st
a@StateToken st
SingKeepAlive 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


timeLimitsKeepAlive :: ProtocolTimeLimits KeepAlive
timeLimitsKeepAlive :: ProtocolTimeLimits KeepAlive
timeLimitsKeepAlive = ProtocolTimeLimits { StateToken st -> Maybe DiffTime
forall (st :: KeepAlive).
ActiveState st =>
StateToken st -> Maybe DiffTime
timeLimitForState :: forall (st :: KeepAlive).
ActiveState st =>
StateToken st -> Maybe DiffTime
timeLimitForState :: forall (st :: KeepAlive).
ActiveState st =>
StateToken st -> Maybe DiffTime
timeLimitForState }
  where
    timeLimitForState :: ActiveState st
                      => StateToken (st :: KeepAlive)
                      -> Maybe DiffTime
    timeLimitForState :: forall (st :: KeepAlive).
ActiveState st =>
StateToken st -> Maybe DiffTime
timeLimitForState StateToken st
SingKeepAlive st
SingClient = DiffTime -> Maybe DiffTime
forall a. a -> Maybe a
Just DiffTime
97
    timeLimitForState StateToken st
SingKeepAlive st
SingServer = DiffTime -> Maybe DiffTime
forall a. a -> Maybe a
Just DiffTime
60 -- TODO: #2505 should be 10s.
    timeLimitForState a :: StateToken st
a@StateToken st
SingKeepAlive 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


codecKeepAliveId
  :: forall m.
     ( Monad   m
     )
  => Codec KeepAlive CodecFailure m (AnyMessage KeepAlive)
codecKeepAliveId :: forall (m :: * -> *).
Monad m =>
Codec KeepAlive CodecFailure m (AnyMessage KeepAlive)
codecKeepAliveId = (forall (st :: KeepAlive) (st' :: KeepAlive).
 (StateTokenI st, ActiveState st) =>
 Message KeepAlive st st' -> AnyMessage KeepAlive)
-> (forall (st :: KeepAlive).
    ActiveState st =>
    StateToken st
    -> m (DecodeStep
            (AnyMessage KeepAlive) CodecFailure m (SomeMessage st)))
-> Codec KeepAlive CodecFailure m (AnyMessage KeepAlive)
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 KeepAlive st st' -> AnyMessage KeepAlive
forall (st :: KeepAlive) (st' :: KeepAlive).
(StateTokenI st, ActiveState st) =>
Message KeepAlive st st' -> AnyMessage KeepAlive
encodeMsg StateToken st
-> m (DecodeStep
        (AnyMessage KeepAlive) CodecFailure m (SomeMessage st))
forall (st :: KeepAlive).
ActiveState st =>
StateToken st
-> m (DecodeStep
        (AnyMessage KeepAlive) CodecFailure m (SomeMessage st))
decodeMsg
   where
     encodeMsg :: forall st st'.
                  StateTokenI st
               => ActiveState st
               => Message KeepAlive st st'
               -> AnyMessage KeepAlive
     encodeMsg :: forall (st :: KeepAlive) (st' :: KeepAlive).
(StateTokenI st, ActiveState st) =>
Message KeepAlive st st' -> AnyMessage KeepAlive
encodeMsg = Message KeepAlive st st' -> AnyMessage KeepAlive
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
Message ps st st' -> AnyMessage ps
AnyMessage

     decodeMsg :: forall (st :: KeepAlive).
                  ActiveState st
               => StateToken st
               -> m (DecodeStep (AnyMessage KeepAlive)
                                CodecFailure m (SomeMessage st))
     decodeMsg :: forall (st :: KeepAlive).
ActiveState st =>
StateToken st
-> m (DecodeStep
        (AnyMessage KeepAlive) CodecFailure m (SomeMessage st))
decodeMsg StateToken st
stok = DecodeStep (AnyMessage KeepAlive) CodecFailure m (SomeMessage st)
-> m (DecodeStep
        (AnyMessage KeepAlive) CodecFailure m (SomeMessage st))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (DecodeStep (AnyMessage KeepAlive) CodecFailure m (SomeMessage st)
 -> m (DecodeStep
         (AnyMessage KeepAlive) CodecFailure m (SomeMessage st)))
-> DecodeStep
     (AnyMessage KeepAlive) CodecFailure m (SomeMessage st)
-> m (DecodeStep
        (AnyMessage KeepAlive) CodecFailure m (SomeMessage st))
forall a b. (a -> b) -> a -> b
$ (Maybe (AnyMessage KeepAlive)
 -> m (DecodeStep
         (AnyMessage KeepAlive) CodecFailure m (SomeMessage st)))
-> DecodeStep
     (AnyMessage KeepAlive) 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 KeepAlive)
  -> m (DecodeStep
          (AnyMessage KeepAlive) CodecFailure m (SomeMessage st)))
 -> DecodeStep
      (AnyMessage KeepAlive) CodecFailure m (SomeMessage st))
-> (Maybe (AnyMessage KeepAlive)
    -> m (DecodeStep
            (AnyMessage KeepAlive) CodecFailure m (SomeMessage st)))
-> DecodeStep
     (AnyMessage KeepAlive) CodecFailure m (SomeMessage st)
forall a b. (a -> b) -> a -> b
$ \Maybe (AnyMessage KeepAlive)
bytes -> DecodeStep (AnyMessage KeepAlive) CodecFailure m (SomeMessage st)
-> m (DecodeStep
        (AnyMessage KeepAlive) CodecFailure m (SomeMessage st))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (DecodeStep (AnyMessage KeepAlive) CodecFailure m (SomeMessage st)
 -> m (DecodeStep
         (AnyMessage KeepAlive) CodecFailure m (SomeMessage st)))
-> DecodeStep
     (AnyMessage KeepAlive) CodecFailure m (SomeMessage st)
-> m (DecodeStep
        (AnyMessage KeepAlive) CodecFailure m (SomeMessage st))
forall a b. (a -> b) -> a -> b
$
        case (StateToken st
SingKeepAlive st
stok, Maybe (AnyMessage KeepAlive)
bytes) of
         (SingKeepAlive st
SingClient, Just (AnyMessage msg :: Message KeepAlive st st'
msg@(MsgKeepAlive {})))
             -> SomeMessage st
-> Maybe (AnyMessage KeepAlive)
-> DecodeStep
     (AnyMessage KeepAlive) CodecFailure m (SomeMessage st)
forall bytes failure (m :: * -> *) a.
a -> Maybe bytes -> DecodeStep bytes failure m a
DecodeDone (Message KeepAlive st st' -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage Message KeepAlive st st'
Message KeepAlive st st'
msg) Maybe (AnyMessage KeepAlive)
forall a. Maybe a
Nothing
         (SingKeepAlive st
SingServer, Just (AnyMessage msg :: Message KeepAlive st st'
msg@(MsgKeepAliveResponse {})))
             -> SomeMessage st
-> Maybe (AnyMessage KeepAlive)
-> DecodeStep
     (AnyMessage KeepAlive) CodecFailure m (SomeMessage st)
forall bytes failure (m :: * -> *) a.
a -> Maybe bytes -> DecodeStep bytes failure m a
DecodeDone (Message KeepAlive st st' -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage Message KeepAlive st st'
Message KeepAlive st st'
msg) Maybe (AnyMessage KeepAlive)
forall a. Maybe a
Nothing
         (SingKeepAlive st
SingClient, Just (AnyMessage msg :: Message KeepAlive st st'
msg@(Message KeepAlive st st'
R:MessageKeepAlivefromto st st'
MsgDone)))
             -> SomeMessage st
-> Maybe (AnyMessage KeepAlive)
-> DecodeStep
     (AnyMessage KeepAlive) CodecFailure m (SomeMessage st)
forall bytes failure (m :: * -> *) a.
a -> Maybe bytes -> DecodeStep bytes failure m a
DecodeDone (Message KeepAlive st st' -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage Message KeepAlive st st'
Message KeepAlive st st'
msg) Maybe (AnyMessage KeepAlive)
forall a. Maybe a
Nothing
         (SingKeepAlive st
SingDone, Maybe (AnyMessage KeepAlive)
_)
             -> 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
         (SingKeepAlive st
_, Maybe (AnyMessage KeepAlive)
_) -> CodecFailure
-> DecodeStep
     (AnyMessage KeepAlive) CodecFailure m (SomeMessage st)
forall bytes failure (m :: * -> *) a.
failure -> DecodeStep bytes failure m a
DecodeFail (String -> CodecFailure
CodecFailure String
"codecKeepAliveId: no matching message")