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

module Ouroboros.Network.Protocol.Limits where

import Control.Exception
import Control.Monad.Class.MonadTime.SI

import Network.TypedProtocol.Core

import Ouroboros.Network.Util.ShowProxy


data ProtocolSizeLimits ps bytes = ProtocolSizeLimits {
       forall ps bytes.
ProtocolSizeLimits ps bytes
-> forall (st :: ps). ActiveState st => StateToken st -> Word
sizeLimitForState :: forall (st :: ps). ActiveState st
                         => StateToken st -> Word,

       forall ps bytes. ProtocolSizeLimits ps bytes -> bytes -> Word
dataSize          :: bytes -> Word
     }

newtype ProtocolTimeLimits ps = ProtocolTimeLimits {
       forall ps.
ProtocolTimeLimits ps
-> forall (st :: ps).
   ActiveState st =>
   StateToken st -> Maybe DiffTime
timeLimitForState :: forall  (st :: ps). ActiveState st
                         => StateToken st -> Maybe DiffTime
     }

data ProtocolLimitFailure where
    ExceededSizeLimit :: forall ps (st :: ps).
                         ( Show (StateToken st)
                         , ShowProxy ps
                         , ActiveState st
                         )
                      => StateToken st
                      -> ProtocolLimitFailure
    ExceededTimeLimit :: forall ps (st :: ps).
                         ( Show (StateToken st)
                         , ShowProxy ps
                         , ActiveState st
                         )
                      => StateToken st
                      -> ProtocolLimitFailure

instance Show ProtocolLimitFailure where
    show :: ProtocolLimitFailure -> String
show (ExceededSizeLimit (StateToken st
stok :: StateToken (st :: ps))) =
      [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ String
"ExceededSizeLimit ("
        , Proxy ps -> String
forall {k} (p :: k). ShowProxy p => Proxy p -> String
showProxy (Proxy ps
forall {k} (t :: k). Proxy t
Proxy :: Proxy ps)
        , String
") "
        , 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)
        , String
" ("
        , StateToken st -> String
forall a. Show a => a -> String
show StateToken st
stok
        , String
")"
        ]
    show (ExceededTimeLimit (StateToken st
stok :: StateToken (st :: ps))) =
      [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ String
"ExceededTimeLimit ("
        , Proxy ps -> String
forall {k} (p :: k). ShowProxy p => Proxy p -> String
showProxy (Proxy ps
forall {k} (t :: k). Proxy t
Proxy :: Proxy ps)
        , String
") "
        , 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)
        , String
" ("
        , StateToken st -> String
forall a. Show a => a -> String
show StateToken st
stok
        , String
")"
        ]

instance Exception ProtocolLimitFailure where


-- TODO: better limits

largeByteLimit :: Word
largeByteLimit :: Word
largeByteLimit = Word
2500000

smallByteLimit :: Word
smallByteLimit :: Word
smallByteLimit = Word
0xffff

shortWait :: Maybe DiffTime
shortWait :: Maybe DiffTime
shortWait = DiffTime -> Maybe DiffTime
forall a. a -> Maybe a
Just DiffTime
10

longWait :: Maybe DiffTime
longWait :: Maybe DiffTime
longWait = DiffTime -> Maybe DiffTime
forall a. a -> Maybe a
Just DiffTime
60

waitForever :: Maybe DiffTime
waitForever :: Maybe DiffTime
waitForever = Maybe DiffTime
forall a. Maybe a
Nothing