{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE KindSignatures      #-}
{-# 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 (DiffTime)

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

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

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

import           Ouroboros.Network.Driver.Limits
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 :: Codec KeepAlive DeserialiseFailure m ByteString
codecKeepAlive_v2 = (forall (pr :: PeerRole) (st :: KeepAlive) (st' :: KeepAlive).
 PeerHasAgency pr st -> Message KeepAlive st st' -> Encoding)
-> (forall (pr :: PeerRole) (st :: KeepAlive) s.
    PeerHasAgency pr st -> Decoder s (SomeMessage st))
-> Codec KeepAlive 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 :: KeepAlive) (st' :: KeepAlive).
PeerHasAgency pr st -> Message KeepAlive st st' -> Encoding
encodeMsg forall (pr :: PeerRole) s (st :: KeepAlive).
PeerHasAgency pr st -> Decoder s (SomeMessage st)
forall (pr :: PeerRole) (st :: KeepAlive) s.
PeerHasAgency pr st -> Decoder s (SomeMessage st)
decodeMsg
   where
     encodeMsg :: forall (pr :: PeerRole) st st'.
                  PeerHasAgency pr st
               -> Message KeepAlive st st'
               -> CBOR.Encoding
     encodeMsg :: PeerHasAgency pr st -> Message KeepAlive st st' -> Encoding
encodeMsg (ClientAgency ClientHasAgency st
TokClient) (MsgKeepAlive (Cookie 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 (ServerAgency ServerHasAgency st
TokServer) (MsgKeepAliveResponse (Cookie 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 (ClientAgency ClientHasAgency st
TokClient) Message KeepAlive 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 (pr :: PeerRole) s (st :: KeepAlive).
                  PeerHasAgency pr st
               -> CBOR.Decoder s (SomeMessage st)
     decodeMsg :: PeerHasAgency pr st -> Decoder s (SomeMessage st)
decodeMsg PeerHasAgency pr st
stok = do
       Int
len <- Decoder s Int
forall s. Decoder s Int
CBOR.decodeListLen
       Word
key <- Decoder s Word
forall s. Decoder s Word
CBOR.decodeWord
       case (PeerHasAgency pr st
stok, Int
len, Word
key) of
         (ClientAgency ClientHasAgency st
TokClient, Int
2, Word
0) -> do
             Word16
cookie <- Decoder s Word16
forall s. Decoder s Word16
CBOR.decodeWord16
             SomeMessage 'StClient -> Decoder s (SomeMessage 'StClient)
forall (m :: * -> *) a. Monad m => a -> m a
return (Message KeepAlive 'StClient 'StServer -> SomeMessage 'StClient
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage (Message KeepAlive 'StClient 'StServer -> SomeMessage 'StClient)
-> Message KeepAlive 'StClient 'StServer -> SomeMessage 'StClient
forall a b. (a -> b) -> a -> b
$ Cookie -> Message KeepAlive 'StClient 'StServer
MsgKeepAlive (Cookie -> Message KeepAlive 'StClient 'StServer)
-> Cookie -> Message KeepAlive 'StClient 'StServer
forall a b. (a -> b) -> a -> b
$ Word16 -> Cookie
Cookie Word16
cookie)
         (ServerAgency ServerHasAgency st
TokServer, Int
2, Word
1) -> do
             Word16
cookie <- Decoder s Word16
forall s. Decoder s Word16
CBOR.decodeWord16
             SomeMessage 'StServer -> Decoder s (SomeMessage 'StServer)
forall (m :: * -> *) a. Monad m => a -> m a
return (Message KeepAlive 'StServer 'StClient -> SomeMessage 'StServer
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage (Message KeepAlive 'StServer 'StClient -> SomeMessage 'StServer)
-> Message KeepAlive 'StServer 'StClient -> SomeMessage 'StServer
forall a b. (a -> b) -> a -> b
$ Cookie -> Message KeepAlive 'StServer 'StClient
MsgKeepAliveResponse (Cookie -> Message KeepAlive 'StServer 'StClient)
-> Cookie -> Message KeepAlive 'StServer 'StClient
forall a b. (a -> b) -> a -> b
$ Word16 -> Cookie
Cookie Word16
cookie)
         (ClientAgency ClientHasAgency st
TokClient, Int
1, Word
2) -> SomeMessage 'StClient -> Decoder s (SomeMessage 'StClient)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Message KeepAlive 'StClient 'StDone -> SomeMessage 'StClient
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage Message KeepAlive 'StClient 'StDone
MsgDone)

         (ClientAgency ClientHasAgency st
TokClient, Int
_, Word
_) ->
           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
"codecKeepAlive (%s) unexpected key (%d, %d)" (PeerHasAgency pr st -> String
forall a. Show a => a -> String
show PeerHasAgency pr st
stok) Word
key Int
len)
         (ServerAgency ServerHasAgency st
TokServer, Int
_, Word
_ ) ->
           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
"codecKeepAlive (%s) unexpected key (%d, %d)" (PeerHasAgency pr st -> String
forall a. Show a => a -> String
show PeerHasAgency pr st
stok) Word
key Int
len)


byteLimitsKeepAlive :: (bytes -> Word) -> ProtocolSizeLimits KeepAlive bytes
byteLimitsKeepAlive :: (bytes -> Word) -> ProtocolSizeLimits KeepAlive bytes
byteLimitsKeepAlive = (forall (pr :: PeerRole) (st :: KeepAlive).
 PeerHasAgency pr st -> Word)
-> (bytes -> Word) -> ProtocolSizeLimits KeepAlive bytes
forall ps bytes.
(forall (pr :: PeerRole) (st :: ps). PeerHasAgency pr st -> Word)
-> (bytes -> Word) -> ProtocolSizeLimits ps bytes
ProtocolSizeLimits forall (pr :: PeerRole) (st :: KeepAlive).
PeerHasAgency pr st -> Word
sizeLimitForState
  where
    sizeLimitForState :: PeerHasAgency (pr :: PeerRole) (st :: KeepAlive)
                      -> Word
    sizeLimitForState :: PeerHasAgency pr st -> Word
sizeLimitForState (ClientAgency ClientHasAgency st
TokClient) = Word
smallByteLimit
    sizeLimitForState (ServerAgency ServerHasAgency st
TokServer) = Word
smallByteLimit


timeLimitsKeepAlive :: ProtocolTimeLimits KeepAlive
timeLimitsKeepAlive :: ProtocolTimeLimits KeepAlive
timeLimitsKeepAlive = ProtocolTimeLimits :: forall ps.
(forall (pr :: PeerRole) (st :: ps).
 PeerHasAgency pr st -> Maybe DiffTime)
-> ProtocolTimeLimits ps
ProtocolTimeLimits { forall (pr :: PeerRole) (st :: KeepAlive).
PeerHasAgency pr st -> Maybe DiffTime
timeLimitForState :: forall (pr :: PeerRole) (st :: KeepAlive).
PeerHasAgency pr st -> Maybe DiffTime
timeLimitForState :: forall (pr :: PeerRole) (st :: KeepAlive).
PeerHasAgency pr st -> Maybe DiffTime
timeLimitForState }
  where
    timeLimitForState :: PeerHasAgency (pr :: PeerRole) (st :: KeepAlive)
                      -> Maybe DiffTime
    timeLimitForState :: PeerHasAgency pr st -> Maybe DiffTime
timeLimitForState (ClientAgency ClientHasAgency st
TokClient) = Maybe DiffTime
waitForever
    timeLimitForState (ServerAgency ServerHasAgency st
TokServer) = DiffTime -> Maybe DiffTime
forall a. a -> Maybe a
Just DiffTime
60 -- TODO: #2505 should be 10s.


codecKeepAliveId
  :: forall m.
     ( Monad   m
     )
  => Codec KeepAlive CodecFailure m (AnyMessage KeepAlive)
codecKeepAliveId :: Codec KeepAlive CodecFailure m (AnyMessage KeepAlive)
codecKeepAliveId = (forall (pr :: PeerRole) (st :: KeepAlive) (st' :: KeepAlive).
 PeerHasAgency pr st
 -> Message KeepAlive st st' -> AnyMessage KeepAlive)
-> (forall (pr :: PeerRole) (st :: KeepAlive).
    PeerHasAgency pr st
    -> m (DecodeStep
            (AnyMessage KeepAlive) CodecFailure m (SomeMessage st)))
-> Codec KeepAlive CodecFailure m (AnyMessage KeepAlive)
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 :: KeepAlive) (st' :: KeepAlive).
PeerHasAgency pr st
-> Message KeepAlive st st' -> AnyMessage KeepAlive
encodeMsg forall (pr :: PeerRole) (st :: KeepAlive).
PeerHasAgency pr st
-> m (DecodeStep
        (AnyMessage KeepAlive) CodecFailure m (SomeMessage st))
decodeMsg
   where
     encodeMsg :: forall (pr :: PeerRole) st st'.
                  PeerHasAgency pr st
               -> Message KeepAlive st st'
               -> AnyMessage KeepAlive
     encodeMsg :: PeerHasAgency pr st
-> Message KeepAlive st st' -> AnyMessage KeepAlive
encodeMsg PeerHasAgency pr st
_ = Message KeepAlive st st' -> AnyMessage KeepAlive
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> AnyMessage ps
AnyMessage

     decodeMsg :: forall (pr :: PeerRole) (st :: KeepAlive).
                  PeerHasAgency pr st
               -> m (DecodeStep (AnyMessage KeepAlive)
                          CodecFailure m (SomeMessage st))
     decodeMsg :: PeerHasAgency pr st
-> m (DecodeStep
        (AnyMessage KeepAlive) CodecFailure m (SomeMessage st))
decodeMsg PeerHasAgency pr st
stok = DecodeStep (AnyMessage KeepAlive) CodecFailure m (SomeMessage st)
-> m (DecodeStep
        (AnyMessage KeepAlive) CodecFailure m (SomeMessage st))
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 (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 (PeerHasAgency pr st
stok, Maybe (AnyMessage KeepAlive)
bytes) of
         (ClientAgency ClientHasAgency st
TokClient, Just (AnyMessage 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).
Message ps st st' -> SomeMessage st
SomeMessage Message KeepAlive st st'
msg) Maybe (AnyMessage KeepAlive)
forall a. Maybe a
Nothing
         (ServerAgency ServerHasAgency st
TokServer, Just (AnyMessage 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).
Message ps st st' -> SomeMessage st
SomeMessage Message KeepAlive st st'
msg) Maybe (AnyMessage KeepAlive)
forall a. Maybe a
Nothing
         (ClientAgency ClientHasAgency st
TokClient, Just (AnyMessage msg@(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).
Message ps st st' -> SomeMessage st
SomeMessage Message KeepAlive st st'
msg) Maybe (AnyMessage KeepAlive)
forall a. Maybe a
Nothing
         (PeerHasAgency pr 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")