{-# language DerivingStrategies #-}
{-# language DeriveAnyClass #-}

-- | All of the exceptions defined in this module indicate either misuse
-- of the library or an implementation mistake in the libary.
module Network.Unexceptional.Types
  ( NonpositiveReceptionSize(..)
  , ReceivedTooManyBytes(..)
  ) where

import Control.Exception (Exception)

-- | Thrown when any of the @receive@ functions are called with
-- a length less than 1. This includes zero and any negative numbers.
-- This indicates misuse of the API and is not considered a recoverable
-- exception.
--
-- Requesting a negative number is bytes is clear misuse of the API.
-- But what about zero? This deserves some justification. POSIX allows
-- requesting zero bytes with @recv@, and the result is that it copies
-- no bytes into the buffer and returns 0. Essentially, it's a no-op.
-- However, the return length 0 is also used to indicate a shutdown.
-- This overloaded meaning of the return value 0 makes it difficult to
-- interpret what it means. (It would be nice if @recv@ instead set the
-- error code to something indicating EOF when the peer had shutdown,
-- but we live in a more difficult world.) To correctly interpret the
-- meaning of return length 0, an application must consider what buffer
-- size it passed to @recv@. To prevent the caller from having to do this
-- bookkeeping, this library simply forbids requesting 0 bytes with @recv@.
-- If you do request 0 bytes with @recv@, you get this exception, and you
-- can fix the part of your program that failed to satisfy the
-- precondition.
data NonpositiveReceptionSize = NonpositiveReceptionSize
  deriving stock (Int -> NonpositiveReceptionSize -> ShowS
[NonpositiveReceptionSize] -> ShowS
NonpositiveReceptionSize -> String
(Int -> NonpositiveReceptionSize -> ShowS)
-> (NonpositiveReceptionSize -> String)
-> ([NonpositiveReceptionSize] -> ShowS)
-> Show NonpositiveReceptionSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NonpositiveReceptionSize -> ShowS
showsPrec :: Int -> NonpositiveReceptionSize -> ShowS
$cshow :: NonpositiveReceptionSize -> String
show :: NonpositiveReceptionSize -> String
$cshowList :: [NonpositiveReceptionSize] -> ShowS
showList :: [NonpositiveReceptionSize] -> ShowS
Show)
  deriving anyclass (Show NonpositiveReceptionSize
Typeable NonpositiveReceptionSize
(Typeable NonpositiveReceptionSize,
 Show NonpositiveReceptionSize) =>
(NonpositiveReceptionSize -> SomeException)
-> (SomeException -> Maybe NonpositiveReceptionSize)
-> (NonpositiveReceptionSize -> String)
-> Exception NonpositiveReceptionSize
SomeException -> Maybe NonpositiveReceptionSize
NonpositiveReceptionSize -> String
NonpositiveReceptionSize -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> String) -> Exception e
$ctoException :: NonpositiveReceptionSize -> SomeException
toException :: NonpositiveReceptionSize -> SomeException
$cfromException :: SomeException -> Maybe NonpositiveReceptionSize
fromException :: SomeException -> Maybe NonpositiveReceptionSize
$cdisplayException :: NonpositiveReceptionSize -> String
displayException :: NonpositiveReceptionSize -> String
Exception)

-- | This indicates a mistake in this library. Open an issue if this
-- exception is ever thrown. 
data ReceivedTooManyBytes = ReceivedTooManyBytes
  deriving stock (Int -> ReceivedTooManyBytes -> ShowS
[ReceivedTooManyBytes] -> ShowS
ReceivedTooManyBytes -> String
(Int -> ReceivedTooManyBytes -> ShowS)
-> (ReceivedTooManyBytes -> String)
-> ([ReceivedTooManyBytes] -> ShowS)
-> Show ReceivedTooManyBytes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReceivedTooManyBytes -> ShowS
showsPrec :: Int -> ReceivedTooManyBytes -> ShowS
$cshow :: ReceivedTooManyBytes -> String
show :: ReceivedTooManyBytes -> String
$cshowList :: [ReceivedTooManyBytes] -> ShowS
showList :: [ReceivedTooManyBytes] -> ShowS
Show)
  deriving anyclass (Show ReceivedTooManyBytes
Typeable ReceivedTooManyBytes
(Typeable ReceivedTooManyBytes, Show ReceivedTooManyBytes) =>
(ReceivedTooManyBytes -> SomeException)
-> (SomeException -> Maybe ReceivedTooManyBytes)
-> (ReceivedTooManyBytes -> String)
-> Exception ReceivedTooManyBytes
SomeException -> Maybe ReceivedTooManyBytes
ReceivedTooManyBytes -> String
ReceivedTooManyBytes -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> String) -> Exception e
$ctoException :: ReceivedTooManyBytes -> SomeException
toException :: ReceivedTooManyBytes -> SomeException
$cfromException :: SomeException -> Maybe ReceivedTooManyBytes
fromException :: SomeException -> Maybe ReceivedTooManyBytes
$cdisplayException :: ReceivedTooManyBytes -> String
displayException :: ReceivedTooManyBytes -> String
Exception)