{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia        #-}
{-# LANGUAGE NamedFieldPuns     #-}
{-# LANGUAGE NumericUnderscores #-}

module Ouroboros.Network.Testing.Data.AbsBearerInfo
  ( AbsBearerInfoScript (..)
  , canFail
  , NonFailingAbsBearerInfo (..)
  , NonFailingAbsBearerInfoScript (..)
  , AbsDelay (..)
  , delay
  , AbsSpeed (..)
  , speedToRational
  , delayAtSpeed
  , AbsSDUSize (..)
  , toSduSize
  , AbsIOError (..)
  , AbsAttenuation (..)
  , attenuation
  , absNoAttenuation
  , AbsBearerInfo (..)
  , toNonFailingAbsBearerInfoScript
  , AbsIOErrType (..)
  ) where

import           Control.Monad.Class.MonadTime.SI (DiffTime, Time (..), addTime)

import qualified Data.List as List
import qualified Data.List.NonEmpty as NonEmpty
import           Data.Monoid (Any (..))
import           GHC.IO.Exception (IOException (..), IOErrorType (..))
import           Foreign.C.Error (Errno (..), eCONNABORTED)

import           Network.Mux.Bearer.AttenuatedChannel (Size,
                     SuccessOrFailure (..))
import           Network.Mux.Types (SDUSize (..))

import           Ouroboros.Network.Testing.Data.Script (Script (..))
import           Ouroboros.Network.Testing.Utils (Delay (..))

import           Test.QuickCheck hiding (Result (..))


data AbsDelay = SmallDelay
              | NormalDelay
              | LargeDelay

  deriving (AbsDelay -> AbsDelay -> Bool
(AbsDelay -> AbsDelay -> Bool)
-> (AbsDelay -> AbsDelay -> Bool) -> Eq AbsDelay
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AbsDelay -> AbsDelay -> Bool
== :: AbsDelay -> AbsDelay -> Bool
$c/= :: AbsDelay -> AbsDelay -> Bool
/= :: AbsDelay -> AbsDelay -> Bool
Eq, Eq AbsDelay
Eq AbsDelay =>
(AbsDelay -> AbsDelay -> Ordering)
-> (AbsDelay -> AbsDelay -> Bool)
-> (AbsDelay -> AbsDelay -> Bool)
-> (AbsDelay -> AbsDelay -> Bool)
-> (AbsDelay -> AbsDelay -> Bool)
-> (AbsDelay -> AbsDelay -> AbsDelay)
-> (AbsDelay -> AbsDelay -> AbsDelay)
-> Ord AbsDelay
AbsDelay -> AbsDelay -> Bool
AbsDelay -> AbsDelay -> Ordering
AbsDelay -> AbsDelay -> AbsDelay
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AbsDelay -> AbsDelay -> Ordering
compare :: AbsDelay -> AbsDelay -> Ordering
$c< :: AbsDelay -> AbsDelay -> Bool
< :: AbsDelay -> AbsDelay -> Bool
$c<= :: AbsDelay -> AbsDelay -> Bool
<= :: AbsDelay -> AbsDelay -> Bool
$c> :: AbsDelay -> AbsDelay -> Bool
> :: AbsDelay -> AbsDelay -> Bool
$c>= :: AbsDelay -> AbsDelay -> Bool
>= :: AbsDelay -> AbsDelay -> Bool
$cmax :: AbsDelay -> AbsDelay -> AbsDelay
max :: AbsDelay -> AbsDelay -> AbsDelay
$cmin :: AbsDelay -> AbsDelay -> AbsDelay
min :: AbsDelay -> AbsDelay -> AbsDelay
Ord, Int -> AbsDelay -> ShowS
[AbsDelay] -> ShowS
AbsDelay -> String
(Int -> AbsDelay -> ShowS)
-> (AbsDelay -> String) -> ([AbsDelay] -> ShowS) -> Show AbsDelay
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AbsDelay -> ShowS
showsPrec :: Int -> AbsDelay -> ShowS
$cshow :: AbsDelay -> String
show :: AbsDelay -> String
$cshowList :: [AbsDelay] -> ShowS
showList :: [AbsDelay] -> ShowS
Show)

delay :: AbsDelay -> DiffTime
delay :: AbsDelay -> DiffTime
delay AbsDelay
SmallDelay  = DiffTime
0.1
delay AbsDelay
NormalDelay = DiffTime
1
delay AbsDelay
LargeDelay  = DiffTime
20

instance Arbitrary AbsDelay where
    arbitrary :: Gen AbsDelay
arbitrary = [(Int, Gen AbsDelay)] -> Gen AbsDelay
forall a. [(Int, Gen a)] -> Gen a
frequency
      [ (Int
1, AbsDelay -> Gen AbsDelay
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AbsDelay
SmallDelay)
      , (Int
2, AbsDelay -> Gen AbsDelay
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AbsDelay
NormalDelay)
      , (Int
1, AbsDelay -> Gen AbsDelay
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AbsDelay
LargeDelay)
      ]
    shrink :: AbsDelay -> [AbsDelay]
shrink AbsDelay
SmallDelay  = []
    shrink AbsDelay
NormalDelay = [AbsDelay
SmallDelay]
    shrink AbsDelay
LargeDelay  = [AbsDelay
SmallDelay, AbsDelay
NormalDelay]

data AbsSpeed = SlowSpeed
              | NormalSpeed
              | FastSpeed
    deriving (AbsSpeed -> AbsSpeed -> Bool
(AbsSpeed -> AbsSpeed -> Bool)
-> (AbsSpeed -> AbsSpeed -> Bool) -> Eq AbsSpeed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AbsSpeed -> AbsSpeed -> Bool
== :: AbsSpeed -> AbsSpeed -> Bool
$c/= :: AbsSpeed -> AbsSpeed -> Bool
/= :: AbsSpeed -> AbsSpeed -> Bool
Eq, Eq AbsSpeed
Eq AbsSpeed =>
(AbsSpeed -> AbsSpeed -> Ordering)
-> (AbsSpeed -> AbsSpeed -> Bool)
-> (AbsSpeed -> AbsSpeed -> Bool)
-> (AbsSpeed -> AbsSpeed -> Bool)
-> (AbsSpeed -> AbsSpeed -> Bool)
-> (AbsSpeed -> AbsSpeed -> AbsSpeed)
-> (AbsSpeed -> AbsSpeed -> AbsSpeed)
-> Ord AbsSpeed
AbsSpeed -> AbsSpeed -> Bool
AbsSpeed -> AbsSpeed -> Ordering
AbsSpeed -> AbsSpeed -> AbsSpeed
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AbsSpeed -> AbsSpeed -> Ordering
compare :: AbsSpeed -> AbsSpeed -> Ordering
$c< :: AbsSpeed -> AbsSpeed -> Bool
< :: AbsSpeed -> AbsSpeed -> Bool
$c<= :: AbsSpeed -> AbsSpeed -> Bool
<= :: AbsSpeed -> AbsSpeed -> Bool
$c> :: AbsSpeed -> AbsSpeed -> Bool
> :: AbsSpeed -> AbsSpeed -> Bool
$c>= :: AbsSpeed -> AbsSpeed -> Bool
>= :: AbsSpeed -> AbsSpeed -> Bool
$cmax :: AbsSpeed -> AbsSpeed -> AbsSpeed
max :: AbsSpeed -> AbsSpeed -> AbsSpeed
$cmin :: AbsSpeed -> AbsSpeed -> AbsSpeed
min :: AbsSpeed -> AbsSpeed -> AbsSpeed
Ord, Int -> AbsSpeed -> ShowS
[AbsSpeed] -> ShowS
AbsSpeed -> String
(Int -> AbsSpeed -> ShowS)
-> (AbsSpeed -> String) -> ([AbsSpeed] -> ShowS) -> Show AbsSpeed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AbsSpeed -> ShowS
showsPrec :: Int -> AbsSpeed -> ShowS
$cshow :: AbsSpeed -> String
show :: AbsSpeed -> String
$cshowList :: [AbsSpeed] -> ShowS
showList :: [AbsSpeed] -> ShowS
Show)

instance Arbitrary AbsSpeed where
    arbitrary :: Gen AbsSpeed
arbitrary = [(Int, Gen AbsSpeed)] -> Gen AbsSpeed
forall a. [(Int, Gen a)] -> Gen a
frequency
      [ (Int
1, AbsSpeed -> Gen AbsSpeed
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AbsSpeed
SlowSpeed)
      , (Int
2, AbsSpeed -> Gen AbsSpeed
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AbsSpeed
NormalSpeed)
      , (Int
1, AbsSpeed -> Gen AbsSpeed
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AbsSpeed
FastSpeed)
      ]
    shrink :: AbsSpeed -> [AbsSpeed]
shrink AbsSpeed
SlowSpeed   = [AbsSpeed
FastSpeed, AbsSpeed
NormalSpeed]
    shrink AbsSpeed
NormalSpeed = [AbsSpeed
FastSpeed]
    shrink AbsSpeed
FastSpeed   = []

speedToRational :: AbsSpeed -> Rational
speedToRational :: AbsSpeed -> Rational
speedToRational AbsSpeed
SlowSpeed   = Rational
3057    -- 12228 / 4
speedToRational AbsSpeed
NormalSpeed = Rational
48912   -- 12228 * 4
speedToRational AbsSpeed
FastSpeed   = Rational
1048576 -- 1Mb/s

delayAtSpeed :: AbsSpeed -> Size -> DiffTime
delayAtSpeed :: AbsSpeed -> Size -> DiffTime
delayAtSpeed AbsSpeed
speed Size
size = Rational -> DiffTime
forall a. Fractional a => Rational -> a
fromRational (Size -> Rational
forall a. Real a => a -> Rational
toRational Size
size Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ AbsSpeed -> Rational
speedToRational AbsSpeed
speed)


data AbsSDUSize = SmallSDU
                | NormalSDU
                | LargeSDU

  deriving (AbsSDUSize -> AbsSDUSize -> Bool
(AbsSDUSize -> AbsSDUSize -> Bool)
-> (AbsSDUSize -> AbsSDUSize -> Bool) -> Eq AbsSDUSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AbsSDUSize -> AbsSDUSize -> Bool
== :: AbsSDUSize -> AbsSDUSize -> Bool
$c/= :: AbsSDUSize -> AbsSDUSize -> Bool
/= :: AbsSDUSize -> AbsSDUSize -> Bool
Eq, Int -> AbsSDUSize -> ShowS
[AbsSDUSize] -> ShowS
AbsSDUSize -> String
(Int -> AbsSDUSize -> ShowS)
-> (AbsSDUSize -> String)
-> ([AbsSDUSize] -> ShowS)
-> Show AbsSDUSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AbsSDUSize -> ShowS
showsPrec :: Int -> AbsSDUSize -> ShowS
$cshow :: AbsSDUSize -> String
show :: AbsSDUSize -> String
$cshowList :: [AbsSDUSize] -> ShowS
showList :: [AbsSDUSize] -> ShowS
Show)

instance Arbitrary AbsSDUSize where
    arbitrary :: Gen AbsSDUSize
arbitrary = [AbsSDUSize] -> Gen AbsSDUSize
forall a. [a] -> Gen a
elements [AbsSDUSize
SmallSDU, AbsSDUSize
NormalSDU, AbsSDUSize
LargeSDU]
    shrink :: AbsSDUSize -> [AbsSDUSize]
shrink AbsSDUSize
SmallSDU  = [AbsSDUSize
LargeSDU, AbsSDUSize
NormalSDU]
    shrink AbsSDUSize
NormalSDU = [AbsSDUSize
LargeSDU]
    shrink AbsSDUSize
LargeSDU  = []

toSduSize :: AbsSDUSize -> SDUSize
toSduSize :: AbsSDUSize -> SDUSize
toSduSize AbsSDUSize
SmallSDU  = Word16 -> SDUSize
SDUSize Word16
1_024
toSduSize AbsSDUSize
NormalSDU = Word16 -> SDUSize
SDUSize Word16
12_228
toSduSize AbsSDUSize
LargeSDU  = Word16 -> SDUSize
SDUSize Word16
32_768

data AbsAttenuation =
    NoAttenuation    AbsSpeed
  | SpeedAttenuation AbsSpeed Time DiffTime
  | ErrorInterval    AbsSpeed Time DiffTime IOError
  deriving (AbsAttenuation -> AbsAttenuation -> Bool
(AbsAttenuation -> AbsAttenuation -> Bool)
-> (AbsAttenuation -> AbsAttenuation -> Bool) -> Eq AbsAttenuation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AbsAttenuation -> AbsAttenuation -> Bool
== :: AbsAttenuation -> AbsAttenuation -> Bool
$c/= :: AbsAttenuation -> AbsAttenuation -> Bool
/= :: AbsAttenuation -> AbsAttenuation -> Bool
Eq, Int -> AbsAttenuation -> ShowS
[AbsAttenuation] -> ShowS
AbsAttenuation -> String
(Int -> AbsAttenuation -> ShowS)
-> (AbsAttenuation -> String)
-> ([AbsAttenuation] -> ShowS)
-> Show AbsAttenuation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AbsAttenuation -> ShowS
showsPrec :: Int -> AbsAttenuation -> ShowS
$cshow :: AbsAttenuation -> String
show :: AbsAttenuation -> String
$cshowList :: [AbsAttenuation] -> ShowS
showList :: [AbsAttenuation] -> ShowS
Show)

-- | At most `Time 20s`.
--
genTime :: Gen Time
genTime :: Gen Time
genTime = DiffTime -> Time
Time (DiffTime -> Time) -> (Delay -> DiffTime) -> Delay -> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Delay -> DiffTime
getDelay (Delay -> Time) -> Gen Delay -> Gen Time
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Delay
forall a. Arbitrary a => Gen a
arbitrary

-- | At most `1_000`s.
--
genLongDelay :: Gen DiffTime
genLongDelay :: Gen DiffTime
genLongDelay = Delay -> DiffTime
getDelay (Delay -> DiffTime) -> Gen Delay -> Gen DiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Delay -> Gen Delay
forall a. Int -> Gen a -> Gen a
resize Int
1_000 Gen Delay
forall a. Arbitrary a => Gen a
arbitrary

newtype AbsIOError = AbsIOError { AbsIOError -> IOError
getIOError :: IOError }
  deriving Int -> AbsIOError -> ShowS
[AbsIOError] -> ShowS
AbsIOError -> String
(Int -> AbsIOError -> ShowS)
-> (AbsIOError -> String)
-> ([AbsIOError] -> ShowS)
-> Show AbsIOError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AbsIOError -> ShowS
showsPrec :: Int -> AbsIOError -> ShowS
$cshow :: AbsIOError -> String
show :: AbsIOError -> String
$cshowList :: [AbsIOError] -> ShowS
showList :: [AbsIOError] -> ShowS
Show

instance Arbitrary AbsIOError where
  arbitrary :: Gen AbsIOError
arbitrary = IOError -> AbsIOError
AbsIOError (IOError -> AbsIOError) -> Gen IOError -> Gen AbsIOError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IOError] -> Gen IOError
forall a. [a] -> Gen a
elements
      [ IOErrorType -> IOError
mkIOError IOErrorType
ResourceVanished
      , IOErrorType -> IOError
mkIOError IOErrorType
ResourceExhausted
      , IOErrorType -> IOError
mkIOError IOErrorType
UnsupportedOperation
      , IOErrorType -> IOError
mkIOError IOErrorType
InvalidArgument
      , IOErrorType -> IOError
mkIOError IOErrorType
ProtocolError
      , IOError
connectionAbortedError
      ]
    where
      -- `ECONNABORTED` error which appears in `Ouroboros.Network.Server2`
      connectionAbortedError :: IOError
      connectionAbortedError :: IOError
connectionAbortedError = IOError
        { ioe_handle :: Maybe Handle
ioe_handle      = Maybe Handle
forall a. Maybe a
Nothing
        , ioe_type :: IOErrorType
ioe_type        = IOErrorType
OtherError
        , ioe_location :: String
ioe_location    = String
"Ouroboros.Network.Snocket.Sim.accept"
          -- Note: this matches the `iseCONNABORTED` on Windows, see
          -- 'Ouroboros.Network.Server2`
        , ioe_description :: String
ioe_description = String
"Software caused connection abort (WSAECONNABORTED)"
        , ioe_errno :: Maybe CInt
ioe_errno       = CInt -> Maybe CInt
forall a. a -> Maybe a
Just (case Errno
eCONNABORTED of Errno CInt
errno -> CInt
errno)
        , ioe_filename :: Maybe String
ioe_filename    = Maybe String
forall a. Maybe a
Nothing
        }

      mkIOError :: IOErrorType -> IOError
      mkIOError :: IOErrorType -> IOError
mkIOError IOErrorType
ioe_type = IOError
        { ioe_handle :: Maybe Handle
ioe_handle      = Maybe Handle
forall a. Maybe a
Nothing
        , IOErrorType
ioe_type :: IOErrorType
ioe_type :: IOErrorType
ioe_type
        , ioe_location :: String
ioe_location    = String
"AttenuationChannel"
        , ioe_description :: String
ioe_description = String
"attenuation"
        , ioe_errno :: Maybe CInt
ioe_errno       = Maybe CInt
forall a. Maybe a
Nothing
        , ioe_filename :: Maybe String
ioe_filename    = Maybe String
forall a. Maybe a
Nothing
        }

instance Arbitrary AbsAttenuation where
    arbitrary :: Gen AbsAttenuation
arbitrary =
        [(Int, Gen AbsAttenuation)] -> Gen AbsAttenuation
forall a. [(Int, Gen a)] -> Gen a
frequency
          [ (Int
2, AbsSpeed -> AbsAttenuation
NoAttenuation (AbsSpeed -> AbsAttenuation) -> Gen AbsSpeed -> Gen AbsAttenuation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen AbsSpeed
forall a. Arbitrary a => Gen a
arbitrary)
          , (Int
1, AbsSpeed -> Time -> DiffTime -> AbsAttenuation
SpeedAttenuation (AbsSpeed -> Time -> DiffTime -> AbsAttenuation)
-> Gen AbsSpeed -> Gen (Time -> DiffTime -> AbsAttenuation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen AbsSpeed
forall a. Arbitrary a => Gen a
arbitrary Gen AbsSpeed -> (AbsSpeed -> Bool) -> Gen AbsSpeed
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (AbsSpeed -> AbsSpeed -> Bool
forall a. Ord a => a -> a -> Bool
> AbsSpeed
SlowSpeed)
                                 Gen (Time -> DiffTime -> AbsAttenuation)
-> Gen Time -> Gen (DiffTime -> AbsAttenuation)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Time
genTime
                                 Gen (DiffTime -> AbsAttenuation)
-> Gen DiffTime -> Gen AbsAttenuation
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen DiffTime
genLongDelay
            )
          , (Int
1, AbsSpeed -> Time -> DiffTime -> IOError -> AbsAttenuation
ErrorInterval (AbsSpeed -> Time -> DiffTime -> IOError -> AbsAttenuation)
-> Gen AbsSpeed
-> Gen (Time -> DiffTime -> IOError -> AbsAttenuation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen AbsSpeed
forall a. Arbitrary a => Gen a
arbitrary
                              Gen (Time -> DiffTime -> IOError -> AbsAttenuation)
-> Gen Time -> Gen (DiffTime -> IOError -> AbsAttenuation)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Time
genTime
                              Gen (DiffTime -> IOError -> AbsAttenuation)
-> Gen DiffTime -> Gen (IOError -> AbsAttenuation)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen DiffTime
genLongDelay
                              Gen (IOError -> AbsAttenuation)
-> Gen IOError -> Gen AbsAttenuation
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (AbsIOError -> IOError
getIOError (AbsIOError -> IOError) -> Gen AbsIOError -> Gen IOError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen AbsIOError
forall a. Arbitrary a => Gen a
arbitrary)
            )
          ]
      where

    shrink :: AbsAttenuation -> [AbsAttenuation]
shrink (NoAttenuation AbsSpeed
speed) =
      [AbsSpeed -> AbsAttenuation
NoAttenuation AbsSpeed
speed' | AbsSpeed
speed' <- AbsSpeed -> [AbsSpeed]
forall a. Arbitrary a => a -> [a]
shrink AbsSpeed
speed ]
    shrink (SpeedAttenuation AbsSpeed
speed Time
time DiffTime
len) =
      [ if DiffTime
len' DiffTime -> DiffTime -> Bool
forall a. Ord a => a -> a -> Bool
< DiffTime
1
         then AbsSpeed -> AbsAttenuation
NoAttenuation AbsSpeed
speed
         else AbsSpeed -> Time -> DiffTime -> AbsAttenuation
SpeedAttenuation AbsSpeed
speed Time
time DiffTime
len'
      | Delay DiffTime
len' <- Delay -> [Delay]
forall a. Arbitrary a => a -> [a]
shrink (DiffTime -> Delay
Delay DiffTime
len)
      ]
    shrink (ErrorInterval AbsSpeed
speed Time
time DiffTime
len IOError
_ioe) =
      [ if DiffTime
len' DiffTime -> DiffTime -> Bool
forall a. Ord a => a -> a -> Bool
< DiffTime
1
         then AbsSpeed -> AbsAttenuation
NoAttenuation AbsSpeed
speed
         else AbsSpeed -> Time -> DiffTime -> AbsAttenuation
SpeedAttenuation AbsSpeed
speed Time
time DiffTime
len'
      | Delay DiffTime
len' <- Delay -> [Delay]
forall a. Arbitrary a => a -> [a]
shrink (DiffTime -> Delay
Delay DiffTime
len)
      ]


attenuation :: AbsAttenuation
            -> Time -> Size -> (DiffTime, SuccessOrFailure)
attenuation :: AbsAttenuation -> Time -> Size -> (DiffTime, SuccessOrFailure)
attenuation (NoAttenuation AbsSpeed
speed) =
   \Time
_ Size
size -> (AbsSpeed -> Size -> DiffTime
delayAtSpeed AbsSpeed
speed Size
size, SuccessOrFailure
Success)
attenuation (SpeedAttenuation AbsSpeed
normalSpeed Time
from DiffTime
len) =
    \Time
t Size
size ->
      let speed :: AbsSpeed
speed = if Time
t Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
< Time
from Bool -> Bool -> Bool
|| Time
t Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
>= DiffTime
len DiffTime -> Time -> Time
`addTime` Time
from
                    then AbsSpeed
normalSpeed
                    else AbsSpeed
SlowSpeed
      in ( AbsSpeed -> Size -> DiffTime
delayAtSpeed AbsSpeed
speed Size
size
         , SuccessOrFailure
Success
         )
attenuation (ErrorInterval AbsSpeed
speed Time
from DiffTime
len IOError
ioe) =
    \Time
t Size
size ->
        ( AbsSpeed -> Size -> DiffTime
delayAtSpeed AbsSpeed
speed Size
size
        , if Time
t Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
< Time
from Bool -> Bool -> Bool
|| Time
t Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
>= DiffTime
len DiffTime -> Time -> Time
`addTime` Time
from
            then SuccessOrFailure
Success
            else IOError -> SuccessOrFailure
Failure IOError
ioe
        )

data AbsIOErrType = AbsIOErrConnectionAborted
                  | AbsIOErrResourceExhausted
  deriving (AbsIOErrType -> AbsIOErrType -> Bool
(AbsIOErrType -> AbsIOErrType -> Bool)
-> (AbsIOErrType -> AbsIOErrType -> Bool) -> Eq AbsIOErrType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AbsIOErrType -> AbsIOErrType -> Bool
== :: AbsIOErrType -> AbsIOErrType -> Bool
$c/= :: AbsIOErrType -> AbsIOErrType -> Bool
/= :: AbsIOErrType -> AbsIOErrType -> Bool
Eq, Int -> AbsIOErrType -> ShowS
[AbsIOErrType] -> ShowS
AbsIOErrType -> String
(Int -> AbsIOErrType -> ShowS)
-> (AbsIOErrType -> String)
-> ([AbsIOErrType] -> ShowS)
-> Show AbsIOErrType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AbsIOErrType -> ShowS
showsPrec :: Int -> AbsIOErrType -> ShowS
$cshow :: AbsIOErrType -> String
show :: AbsIOErrType -> String
$cshowList :: [AbsIOErrType] -> ShowS
showList :: [AbsIOErrType] -> ShowS
Show)

instance Arbitrary AbsIOErrType where
    arbitrary :: Gen AbsIOErrType
arbitrary = [AbsIOErrType] -> Gen AbsIOErrType
forall a. [a] -> Gen a
elements [ AbsIOErrType
AbsIOErrConnectionAborted
                         , AbsIOErrType
AbsIOErrResourceExhausted
                         ]
    shrink :: AbsIOErrType -> [AbsIOErrType]
shrink AbsIOErrType
AbsIOErrConnectionAborted = [AbsIOErrType
AbsIOErrResourceExhausted]
    shrink AbsIOErrType
AbsIOErrResourceExhausted = []

data AbsBearerInfo = AbsBearerInfo
    { AbsBearerInfo -> AbsDelay
abiConnectionDelay      :: !AbsDelay
    , AbsBearerInfo -> AbsAttenuation
abiInboundAttenuation   :: !AbsAttenuation
    , AbsBearerInfo -> AbsAttenuation
abiOutboundAttenuation  :: !AbsAttenuation
    , AbsBearerInfo -> Maybe Int
abiInboundWriteFailure  :: !(Maybe Int)
    , AbsBearerInfo -> Maybe Int
abiOutboundWriteFailure :: !(Maybe Int)
    , AbsBearerInfo -> Maybe (AbsDelay, IOError)
abiAcceptFailure        :: !(Maybe (AbsDelay, IOError))
    , AbsBearerInfo -> AbsSDUSize
abiSDUSize              :: !AbsSDUSize
    }
  deriving (AbsBearerInfo -> AbsBearerInfo -> Bool
(AbsBearerInfo -> AbsBearerInfo -> Bool)
-> (AbsBearerInfo -> AbsBearerInfo -> Bool) -> Eq AbsBearerInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AbsBearerInfo -> AbsBearerInfo -> Bool
== :: AbsBearerInfo -> AbsBearerInfo -> Bool
$c/= :: AbsBearerInfo -> AbsBearerInfo -> Bool
/= :: AbsBearerInfo -> AbsBearerInfo -> Bool
Eq, Int -> AbsBearerInfo -> ShowS
[AbsBearerInfo] -> ShowS
AbsBearerInfo -> String
(Int -> AbsBearerInfo -> ShowS)
-> (AbsBearerInfo -> String)
-> ([AbsBearerInfo] -> ShowS)
-> Show AbsBearerInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AbsBearerInfo -> ShowS
showsPrec :: Int -> AbsBearerInfo -> ShowS
$cshow :: AbsBearerInfo -> String
show :: AbsBearerInfo -> String
$cshowList :: [AbsBearerInfo] -> ShowS
showList :: [AbsBearerInfo] -> ShowS
Show)

absNoAttenuation :: AbsBearerInfo
absNoAttenuation :: AbsBearerInfo
absNoAttenuation = AbsBearerInfo
    { abiConnectionDelay :: AbsDelay
abiConnectionDelay      = AbsDelay
NormalDelay
    , abiInboundAttenuation :: AbsAttenuation
abiInboundAttenuation   = AbsSpeed -> AbsAttenuation
NoAttenuation AbsSpeed
NormalSpeed
    , abiOutboundAttenuation :: AbsAttenuation
abiOutboundAttenuation  = AbsSpeed -> AbsAttenuation
NoAttenuation AbsSpeed
NormalSpeed
    , abiInboundWriteFailure :: Maybe Int
abiInboundWriteFailure  = Maybe Int
forall a. Maybe a
Nothing
    , abiOutboundWriteFailure :: Maybe Int
abiOutboundWriteFailure = Maybe Int
forall a. Maybe a
Nothing
    , abiAcceptFailure :: Maybe (AbsDelay, IOError)
abiAcceptFailure        = Maybe (AbsDelay, IOError)
forall a. Maybe a
Nothing
    , abiSDUSize :: AbsSDUSize
abiSDUSize              = AbsSDUSize
NormalSDU
    }

canFail :: AbsBearerInfo -> Bool
canFail :: AbsBearerInfo -> Bool
canFail AbsBearerInfo
abi = Any -> Bool
getAny (Any -> Bool) -> Any -> Bool
forall a b. (a -> b) -> a -> b
$
       case AbsBearerInfo -> AbsAttenuation
abiInboundAttenuation AbsBearerInfo
abi of
         NoAttenuation {} -> Bool -> Any
Any Bool
False
         AbsAttenuation
_                -> Bool -> Any
Any Bool
True
    Any -> Any -> Any
forall a. Semigroup a => a -> a -> a
<> case AbsBearerInfo -> AbsAttenuation
abiOutboundAttenuation AbsBearerInfo
abi of
         NoAttenuation {} -> Bool -> Any
Any Bool
False
         AbsAttenuation
_                -> Bool -> Any
Any Bool
True
    Any -> Any -> Any
forall a. Semigroup a => a -> a -> a
<> case AbsBearerInfo -> Maybe Int
abiInboundWriteFailure AbsBearerInfo
abi of
         Maybe Int
Nothing -> Bool -> Any
Any Bool
False
         Maybe Int
_       -> Bool -> Any
Any Bool
True
    Any -> Any -> Any
forall a. Semigroup a => a -> a -> a
<> case AbsBearerInfo -> Maybe Int
abiOutboundWriteFailure AbsBearerInfo
abi of
         Maybe Int
Nothing -> Bool -> Any
Any Bool
False
         Maybe Int
_       -> Bool -> Any
Any Bool
True
    Any -> Any -> Any
forall a. Semigroup a => a -> a -> a
<> case AbsBearerInfo -> Maybe (AbsDelay, IOError)
abiAcceptFailure AbsBearerInfo
abi of
         Maybe (AbsDelay, IOError)
Nothing -> Bool -> Any
Any Bool
False
         Maybe (AbsDelay, IOError)
_       -> Bool -> Any
Any Bool
True

instance Arbitrary AbsBearerInfo where
    arbitrary :: Gen AbsBearerInfo
arbitrary =
        AbsDelay
-> AbsAttenuation
-> AbsAttenuation
-> Maybe Int
-> Maybe Int
-> Maybe (AbsDelay, IOError)
-> AbsSDUSize
-> AbsBearerInfo
AbsBearerInfo (AbsDelay
 -> AbsAttenuation
 -> AbsAttenuation
 -> Maybe Int
 -> Maybe Int
 -> Maybe (AbsDelay, IOError)
 -> AbsSDUSize
 -> AbsBearerInfo)
-> Gen AbsDelay
-> Gen
     (AbsAttenuation
      -> AbsAttenuation
      -> Maybe Int
      -> Maybe Int
      -> Maybe (AbsDelay, IOError)
      -> AbsSDUSize
      -> AbsBearerInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen AbsDelay
forall a. Arbitrary a => Gen a
arbitrary
                      Gen
  (AbsAttenuation
   -> AbsAttenuation
   -> Maybe Int
   -> Maybe Int
   -> Maybe (AbsDelay, IOError)
   -> AbsSDUSize
   -> AbsBearerInfo)
-> Gen AbsAttenuation
-> Gen
     (AbsAttenuation
      -> Maybe Int
      -> Maybe Int
      -> Maybe (AbsDelay, IOError)
      -> AbsSDUSize
      -> AbsBearerInfo)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen AbsAttenuation
forall a. Arbitrary a => Gen a
arbitrary
                      Gen
  (AbsAttenuation
   -> Maybe Int
   -> Maybe Int
   -> Maybe (AbsDelay, IOError)
   -> AbsSDUSize
   -> AbsBearerInfo)
-> Gen AbsAttenuation
-> Gen
     (Maybe Int
      -> Maybe Int
      -> Maybe (AbsDelay, IOError)
      -> AbsSDUSize
      -> AbsBearerInfo)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen AbsAttenuation
forall a. Arbitrary a => Gen a
arbitrary
                      Gen
  (Maybe Int
   -> Maybe Int
   -> Maybe (AbsDelay, IOError)
   -> AbsSDUSize
   -> AbsBearerInfo)
-> Gen (Maybe Int)
-> Gen
     (Maybe Int
      -> Maybe (AbsDelay, IOError) -> AbsSDUSize -> AbsBearerInfo)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe Int)
genWriteFailure
                      Gen
  (Maybe Int
   -> Maybe (AbsDelay, IOError) -> AbsSDUSize -> AbsBearerInfo)
-> Gen (Maybe Int)
-> Gen (Maybe (AbsDelay, IOError) -> AbsSDUSize -> AbsBearerInfo)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe Int)
genWriteFailure
                      Gen (Maybe (AbsDelay, IOError) -> AbsSDUSize -> AbsBearerInfo)
-> Gen (Maybe (AbsDelay, IOError))
-> Gen (AbsSDUSize -> AbsBearerInfo)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe (AbsDelay, IOError))
genAcceptFailure
                      Gen (AbsSDUSize -> AbsBearerInfo)
-> Gen AbsSDUSize -> Gen AbsBearerInfo
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen AbsSDUSize
forall a. Arbitrary a => Gen a
arbitrary
      where
        genWriteFailure :: Gen (Maybe Int)
genWriteFailure =
          [(Int, Gen (Maybe Int))] -> Gen (Maybe Int)
forall a. [(Int, Gen a)] -> Gen a
frequency
            [ (Int
2, Maybe Int -> Gen (Maybe Int)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Int
forall a. Maybe a
Nothing)
            , (Int
1, Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Gen Int -> Gen (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Int
forall a. Integral a => Gen a
arbitrarySizedNatural)
            ]
        genAcceptFailure :: Gen (Maybe (AbsDelay, IOError))
genAcceptFailure =
          [(Int, Gen (Maybe (AbsDelay, IOError)))]
-> Gen (Maybe (AbsDelay, IOError))
forall a. [(Int, Gen a)] -> Gen a
frequency
            [ (Int
2, Maybe (AbsDelay, IOError) -> Gen (Maybe (AbsDelay, IOError))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (AbsDelay, IOError)
forall a. Maybe a
Nothing)
            , (Int
1, (\AbsDelay
a IOError
b -> (AbsDelay, IOError) -> Maybe (AbsDelay, IOError)
forall a. a -> Maybe a
Just (AbsDelay
a,IOError
b))
                (AbsDelay -> IOError -> Maybe (AbsDelay, IOError))
-> Gen AbsDelay -> Gen (IOError -> Maybe (AbsDelay, IOError))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen AbsDelay
forall a. Arbitrary a => Gen a
arbitrary
                Gen (IOError -> Maybe (AbsDelay, IOError))
-> Gen IOError -> Gen (Maybe (AbsDelay, IOError))
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (AbsIOError -> IOError
getIOError (AbsIOError -> IOError) -> Gen AbsIOError -> Gen IOError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen AbsIOError
forall a. Arbitrary a => Gen a
arbitrary))
            ]

    shrink :: AbsBearerInfo -> [AbsBearerInfo]
shrink AbsBearerInfo
abi =
      [ AbsBearerInfo
abi { abiConnectionDelay = connDelay }
      | AbsDelay
connDelay <- AbsDelay -> [AbsDelay]
forall a. Arbitrary a => a -> [a]
shrink (AbsBearerInfo -> AbsDelay
abiConnectionDelay AbsBearerInfo
abi) ]
      [AbsBearerInfo] -> [AbsBearerInfo] -> [AbsBearerInfo]
forall a. [a] -> [a] -> [a]
++
      [ AbsBearerInfo
abi { abiInboundAttenuation = a }
      | AbsAttenuation
a <- AbsAttenuation -> [AbsAttenuation]
forall a. Arbitrary a => a -> [a]
shrink (AbsBearerInfo -> AbsAttenuation
abiInboundAttenuation AbsBearerInfo
abi) ]
      [AbsBearerInfo] -> [AbsBearerInfo] -> [AbsBearerInfo]
forall a. [a] -> [a] -> [a]
++
      [ AbsBearerInfo
abi { abiOutboundAttenuation = a }
      | AbsAttenuation
a <- AbsAttenuation -> [AbsAttenuation]
forall a. Arbitrary a => a -> [a]
shrink (AbsBearerInfo -> AbsAttenuation
abiOutboundAttenuation AbsBearerInfo
abi) ]
      [AbsBearerInfo] -> [AbsBearerInfo] -> [AbsBearerInfo]
forall a. [a] -> [a] -> [a]
++
      [ AbsBearerInfo
abi { abiInboundWriteFailure = a }
      | Maybe Int
a <- Maybe Int -> [Maybe Int]
forall a. Arbitrary a => a -> [a]
shrink (AbsBearerInfo -> Maybe Int
abiInboundWriteFailure AbsBearerInfo
abi) ]
      [AbsBearerInfo] -> [AbsBearerInfo] -> [AbsBearerInfo]
forall a. [a] -> [a] -> [a]
++
      [ AbsBearerInfo
abi { abiOutboundWriteFailure = a }
      | Maybe Int
a <- Maybe Int -> [Maybe Int]
forall a. Arbitrary a => a -> [a]
shrink (AbsBearerInfo -> Maybe Int
abiOutboundWriteFailure AbsBearerInfo
abi) ]
      [AbsBearerInfo] -> [AbsBearerInfo] -> [AbsBearerInfo]
forall a. [a] -> [a] -> [a]
++
      [ AbsBearerInfo
abi { abiSDUSize = a }
      | AbsSDUSize
a <- AbsSDUSize -> [AbsSDUSize]
forall a. Arbitrary a => a -> [a]
shrink (AbsBearerInfo -> AbsSDUSize
abiSDUSize AbsBearerInfo
abi)
      ]

newtype AbsBearerInfoScript = AbsBearerInfoScript {
    AbsBearerInfoScript -> Script AbsBearerInfo
unBIScript :: Script AbsBearerInfo
  }
  deriving       Int -> AbsBearerInfoScript -> ShowS
[AbsBearerInfoScript] -> ShowS
AbsBearerInfoScript -> String
(Int -> AbsBearerInfoScript -> ShowS)
-> (AbsBearerInfoScript -> String)
-> ([AbsBearerInfoScript] -> ShowS)
-> Show AbsBearerInfoScript
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AbsBearerInfoScript -> ShowS
showsPrec :: Int -> AbsBearerInfoScript -> ShowS
$cshow :: AbsBearerInfoScript -> String
show :: AbsBearerInfoScript -> String
$cshowList :: [AbsBearerInfoScript] -> ShowS
showList :: [AbsBearerInfoScript] -> ShowS
Show via (Script AbsBearerInfo)
  deriving stock AbsBearerInfoScript -> AbsBearerInfoScript -> Bool
(AbsBearerInfoScript -> AbsBearerInfoScript -> Bool)
-> (AbsBearerInfoScript -> AbsBearerInfoScript -> Bool)
-> Eq AbsBearerInfoScript
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AbsBearerInfoScript -> AbsBearerInfoScript -> Bool
== :: AbsBearerInfoScript -> AbsBearerInfoScript -> Bool
$c/= :: AbsBearerInfoScript -> AbsBearerInfoScript -> Bool
/= :: AbsBearerInfoScript -> AbsBearerInfoScript -> Bool
Eq

fixupAbsBearerInfos :: [AbsBearerInfo] -> [AbsBearerInfo]
fixupAbsBearerInfos :: [AbsBearerInfo] -> [AbsBearerInfo]
fixupAbsBearerInfos [AbsBearerInfo]
bis =
    if AbsBearerInfo -> Bool
canFail ([AbsBearerInfo] -> AbsBearerInfo
forall a. HasCallStack => [a] -> a
last [AbsBearerInfo]
bis)
      then [AbsBearerInfo]
bis [AbsBearerInfo] -> [AbsBearerInfo] -> [AbsBearerInfo]
forall a. [a] -> [a] -> [a]
++ [AbsBearerInfo
absNoAttenuation]
      else [AbsBearerInfo]
bis

instance Arbitrary AbsBearerInfoScript where
  arbitrary :: Gen AbsBearerInfoScript
arbitrary = Script AbsBearerInfo -> AbsBearerInfoScript
AbsBearerInfoScript
            (Script AbsBearerInfo -> AbsBearerInfoScript)
-> ([AbsBearerInfo] -> Script AbsBearerInfo)
-> [AbsBearerInfo]
-> AbsBearerInfoScript
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty AbsBearerInfo -> Script AbsBearerInfo
forall a. NonEmpty a -> Script a
Script
            (NonEmpty AbsBearerInfo -> Script AbsBearerInfo)
-> ([AbsBearerInfo] -> NonEmpty AbsBearerInfo)
-> [AbsBearerInfo]
-> Script AbsBearerInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AbsBearerInfo] -> NonEmpty AbsBearerInfo
forall a. HasCallStack => [a] -> NonEmpty a
NonEmpty.fromList
            ([AbsBearerInfo] -> NonEmpty AbsBearerInfo)
-> ([AbsBearerInfo] -> [AbsBearerInfo])
-> [AbsBearerInfo]
-> NonEmpty AbsBearerInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AbsBearerInfo] -> [AbsBearerInfo]
fixupAbsBearerInfos
          ([AbsBearerInfo] -> AbsBearerInfoScript)
-> Gen [AbsBearerInfo] -> Gen AbsBearerInfoScript
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen AbsBearerInfo -> Gen [AbsBearerInfo]
forall a. Gen a -> Gen [a]
listOf1 Gen AbsBearerInfo
forall a. Arbitrary a => Gen a
arbitrary

  shrink :: AbsBearerInfoScript -> [AbsBearerInfoScript]
shrink (AbsBearerInfoScript (Script NonEmpty AbsBearerInfo
script)) =
    [ Script AbsBearerInfo -> AbsBearerInfoScript
AbsBearerInfoScript (NonEmpty AbsBearerInfo -> Script AbsBearerInfo
forall a. NonEmpty a -> Script a
Script NonEmpty AbsBearerInfo
script')
    | NonEmpty AbsBearerInfo
script'
        <- ([AbsBearerInfo] -> NonEmpty AbsBearerInfo)
-> [[AbsBearerInfo]] -> [NonEmpty AbsBearerInfo]
forall a b. (a -> b) -> [a] -> [b]
map ([AbsBearerInfo] -> NonEmpty AbsBearerInfo
forall a. HasCallStack => [a] -> NonEmpty a
NonEmpty.fromList ([AbsBearerInfo] -> NonEmpty AbsBearerInfo)
-> ([AbsBearerInfo] -> [AbsBearerInfo])
-> [AbsBearerInfo]
-> NonEmpty AbsBearerInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AbsBearerInfo] -> [AbsBearerInfo]
fixupAbsBearerInfos)
        ([[AbsBearerInfo]] -> [NonEmpty AbsBearerInfo])
-> ([[AbsBearerInfo]] -> [[AbsBearerInfo]])
-> [[AbsBearerInfo]]
-> [NonEmpty AbsBearerInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([AbsBearerInfo] -> Bool) -> [[AbsBearerInfo]] -> [[AbsBearerInfo]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ([AbsBearerInfo] -> Bool) -> [AbsBearerInfo] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AbsBearerInfo] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null)
         -- TODO: shrinking of 'AbsBearerInfo' needs to be more aggressive to use
         -- @shrinkList shrink@
         ([[AbsBearerInfo]] -> [NonEmpty AbsBearerInfo])
-> [[AbsBearerInfo]] -> [NonEmpty AbsBearerInfo]
forall a b. (a -> b) -> a -> b
$ (AbsBearerInfo -> [AbsBearerInfo])
-> [AbsBearerInfo] -> [[AbsBearerInfo]]
forall a. (a -> [a]) -> [a] -> [[a]]
shrinkList ([AbsBearerInfo] -> AbsBearerInfo -> [AbsBearerInfo]
forall a b. a -> b -> a
const []) (NonEmpty AbsBearerInfo -> [AbsBearerInfo]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty AbsBearerInfo
script)
    , NonEmpty AbsBearerInfo
script' NonEmpty AbsBearerInfo -> NonEmpty AbsBearerInfo -> Bool
forall a. Eq a => a -> a -> Bool
/= NonEmpty AbsBearerInfo
script
    ]

newtype NonFailingAbsBearerInfo = NonFailingAbsBearerInfo {
    NonFailingAbsBearerInfo -> AbsBearerInfo
unNFBI :: AbsBearerInfo
  }
  deriving       Int -> NonFailingAbsBearerInfo -> ShowS
[NonFailingAbsBearerInfo] -> ShowS
NonFailingAbsBearerInfo -> String
(Int -> NonFailingAbsBearerInfo -> ShowS)
-> (NonFailingAbsBearerInfo -> String)
-> ([NonFailingAbsBearerInfo] -> ShowS)
-> Show NonFailingAbsBearerInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NonFailingAbsBearerInfo -> ShowS
showsPrec :: Int -> NonFailingAbsBearerInfo -> ShowS
$cshow :: NonFailingAbsBearerInfo -> String
show :: NonFailingAbsBearerInfo -> String
$cshowList :: [NonFailingAbsBearerInfo] -> ShowS
showList :: [NonFailingAbsBearerInfo] -> ShowS
Show via AbsBearerInfo
  deriving stock NonFailingAbsBearerInfo -> NonFailingAbsBearerInfo -> Bool
(NonFailingAbsBearerInfo -> NonFailingAbsBearerInfo -> Bool)
-> (NonFailingAbsBearerInfo -> NonFailingAbsBearerInfo -> Bool)
-> Eq NonFailingAbsBearerInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NonFailingAbsBearerInfo -> NonFailingAbsBearerInfo -> Bool
== :: NonFailingAbsBearerInfo -> NonFailingAbsBearerInfo -> Bool
$c/= :: NonFailingAbsBearerInfo -> NonFailingAbsBearerInfo -> Bool
/= :: NonFailingAbsBearerInfo -> NonFailingAbsBearerInfo -> Bool
Eq

toNonFailingAbsBearerInfo :: AbsBearerInfo
                          -> NonFailingAbsBearerInfo
toNonFailingAbsBearerInfo :: AbsBearerInfo -> NonFailingAbsBearerInfo
toNonFailingAbsBearerInfo AbsBearerInfo
script =
    AbsBearerInfo -> NonFailingAbsBearerInfo
NonFailingAbsBearerInfo (AbsBearerInfo -> NonFailingAbsBearerInfo)
-> AbsBearerInfo -> NonFailingAbsBearerInfo
forall a b. (a -> b) -> a -> b
$ AbsBearerInfo -> AbsBearerInfo
unfail AbsBearerInfo
script
  where
    unfail :: AbsBearerInfo -> AbsBearerInfo
    unfail :: AbsBearerInfo -> AbsBearerInfo
unfail AbsBearerInfo
bi =
      AbsBearerInfo
bi { abiInboundWriteFailure  = Nothing
         , abiOutboundWriteFailure = Nothing
         , abiInboundAttenuation   = unfailAtt $ abiInboundAttenuation bi
         , abiOutboundAttenuation  = unfailAtt $ abiOutboundAttenuation bi
         , abiAcceptFailure        = Nothing
         }

    unfailAtt :: AbsAttenuation -> AbsAttenuation
unfailAtt (ErrorInterval    AbsSpeed
speed Time
_ DiffTime
_ IOError
_) = AbsSpeed -> AbsAttenuation
NoAttenuation AbsSpeed
speed
    unfailAtt (SpeedAttenuation AbsSpeed
speed Time
_ DiffTime
_)   = AbsSpeed -> AbsAttenuation
NoAttenuation AbsSpeed
speed
    unfailAtt AbsAttenuation
a                              = AbsAttenuation
a

instance Arbitrary NonFailingAbsBearerInfo where
  arbitrary :: Gen NonFailingAbsBearerInfo
arbitrary = AbsBearerInfo -> NonFailingAbsBearerInfo
toNonFailingAbsBearerInfo (AbsBearerInfo -> NonFailingAbsBearerInfo)
-> Gen AbsBearerInfo -> Gen NonFailingAbsBearerInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen AbsBearerInfo
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: NonFailingAbsBearerInfo -> [NonFailingAbsBearerInfo]
shrink (NonFailingAbsBearerInfo AbsBearerInfo
script) =
    AbsBearerInfo -> NonFailingAbsBearerInfo
NonFailingAbsBearerInfo (AbsBearerInfo -> NonFailingAbsBearerInfo)
-> [AbsBearerInfo] -> [NonFailingAbsBearerInfo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AbsBearerInfo -> [AbsBearerInfo]
forall a. Arbitrary a => a -> [a]
shrink AbsBearerInfo
script

newtype NonFailingAbsBearerInfoScript = NonFailingAbsBearerInfoScript {
    NonFailingAbsBearerInfoScript -> Script AbsBearerInfo
unNFBIScript :: Script AbsBearerInfo
  }
  deriving       Int -> NonFailingAbsBearerInfoScript -> ShowS
[NonFailingAbsBearerInfoScript] -> ShowS
NonFailingAbsBearerInfoScript -> String
(Int -> NonFailingAbsBearerInfoScript -> ShowS)
-> (NonFailingAbsBearerInfoScript -> String)
-> ([NonFailingAbsBearerInfoScript] -> ShowS)
-> Show NonFailingAbsBearerInfoScript
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NonFailingAbsBearerInfoScript -> ShowS
showsPrec :: Int -> NonFailingAbsBearerInfoScript -> ShowS
$cshow :: NonFailingAbsBearerInfoScript -> String
show :: NonFailingAbsBearerInfoScript -> String
$cshowList :: [NonFailingAbsBearerInfoScript] -> ShowS
showList :: [NonFailingAbsBearerInfoScript] -> ShowS
Show via (Script AbsBearerInfo)
  deriving stock NonFailingAbsBearerInfoScript
-> NonFailingAbsBearerInfoScript -> Bool
(NonFailingAbsBearerInfoScript
 -> NonFailingAbsBearerInfoScript -> Bool)
-> (NonFailingAbsBearerInfoScript
    -> NonFailingAbsBearerInfoScript -> Bool)
-> Eq NonFailingAbsBearerInfoScript
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NonFailingAbsBearerInfoScript
-> NonFailingAbsBearerInfoScript -> Bool
== :: NonFailingAbsBearerInfoScript
-> NonFailingAbsBearerInfoScript -> Bool
$c/= :: NonFailingAbsBearerInfoScript
-> NonFailingAbsBearerInfoScript -> Bool
/= :: NonFailingAbsBearerInfoScript
-> NonFailingAbsBearerInfoScript -> Bool
Eq

toNonFailingAbsBearerInfoScript :: AbsBearerInfoScript
                                -> NonFailingAbsBearerInfoScript
toNonFailingAbsBearerInfoScript :: AbsBearerInfoScript -> NonFailingAbsBearerInfoScript
toNonFailingAbsBearerInfoScript (AbsBearerInfoScript Script AbsBearerInfo
script) =
    Script AbsBearerInfo -> NonFailingAbsBearerInfoScript
NonFailingAbsBearerInfoScript
    (Script AbsBearerInfo -> NonFailingAbsBearerInfoScript)
-> Script AbsBearerInfo -> NonFailingAbsBearerInfoScript
forall a b. (a -> b) -> a -> b
$ (AbsBearerInfo -> AbsBearerInfo)
-> Script AbsBearerInfo -> Script AbsBearerInfo
forall a b. (a -> b) -> Script a -> Script b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NonFailingAbsBearerInfo -> AbsBearerInfo
unNFBI (NonFailingAbsBearerInfo -> AbsBearerInfo)
-> (AbsBearerInfo -> NonFailingAbsBearerInfo)
-> AbsBearerInfo
-> AbsBearerInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbsBearerInfo -> NonFailingAbsBearerInfo
toNonFailingAbsBearerInfo) Script AbsBearerInfo
script

instance Arbitrary NonFailingAbsBearerInfoScript where
  arbitrary :: Gen NonFailingAbsBearerInfoScript
arbitrary = AbsBearerInfoScript -> NonFailingAbsBearerInfoScript
toNonFailingAbsBearerInfoScript (AbsBearerInfoScript -> NonFailingAbsBearerInfoScript)
-> Gen AbsBearerInfoScript -> Gen NonFailingAbsBearerInfoScript
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen AbsBearerInfoScript
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: NonFailingAbsBearerInfoScript -> [NonFailingAbsBearerInfoScript]
shrink (NonFailingAbsBearerInfoScript Script AbsBearerInfo
script) =
    AbsBearerInfoScript -> NonFailingAbsBearerInfoScript
toNonFailingAbsBearerInfoScript (AbsBearerInfoScript -> NonFailingAbsBearerInfoScript)
-> [AbsBearerInfoScript] -> [NonFailingAbsBearerInfoScript]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AbsBearerInfoScript -> [AbsBearerInfoScript]
forall a. Arbitrary a => a -> [a]
shrink (Script AbsBearerInfo -> AbsBearerInfoScript
AbsBearerInfoScript Script AbsBearerInfo
script)