{-|
Module      : Network.Types.ICMP
Description : Data types for ICMP types and codes
Copyright   : (c) 2021 Adam Flott
License     : BSD-3-Clause
Maintainer  : adam@adamflott.com
Stability   : experimental
Portability : POSIX

Data types and conversions for ICMP automatically built from the specification at
<https://www.iana.org/assignments/icmp-parameters/icmp-parameters.xml>


Specification date: 2020-09-25
-}
module Network.Types.ICMP (
    -- * Types
    ICMPType(..)

    -- * Codes
    , ICMPCodeNum(..)
    , ICMPCode(..)

    -- * Codes from Type
    , icmpCodesForType

    -- * Conversions
    , icmpTypeToStringNum
    , icmpTypeFromStringNum
    , icmpTypeToNum
    , icmpCodeToStringNum

    -- * Deprecated testing
    , isICMPTypeDeprecated

) where


-- base
import Data.String (IsString)
import Data.Word (Word8)
import GHC.Generics

-- | Wrap a numeric ICMP type.
--
-- @since 1.0.0
newtype ICMPTypeNum = ICMPTypeNum Word8


-- | ICMP type.
--
-- @since 1.0.0
data ICMPType
    = ICMPTypeUnknown
    | ICMPType0EchoReply -- ^ Echo Reply
    | ICMPType3DestinationUnreachable -- ^ Destination Unreachable
    | ICMPType4SourceQuenchDeprecated -- ^ Source Quench (Deprecated)
    | ICMPType5Redirect -- ^ Redirect
    | ICMPType6AlternateHostAddressDeprecated -- ^ Alternate Host Address (Deprecated)
    | ICMPType8Echo -- ^ Echo
    | ICMPType9RouterAdvertisement -- ^ Router Advertisement
    | ICMPType10RouterSolicitation -- ^ Router Solicitation
    | ICMPType11TimeExceeded -- ^ Time Exceeded
    | ICMPType12ParameterProblem -- ^ Parameter Problem
    | ICMPType13Timestamp -- ^ Timestamp
    | ICMPType14TimestampReply -- ^ Timestamp Reply
    | ICMPType15InformationRequestDeprecated -- ^ Information Request (Deprecated)
    | ICMPType16InformationReplyDeprecated -- ^ Information Reply (Deprecated)
    | ICMPType17AddressMaskRequestDeprecated -- ^ Address Mask Request (Deprecated)
    | ICMPType18AddressMaskReplyDeprecated -- ^ Address Mask Reply (Deprecated)
    | ICMPType19ReservedForSecurity -- ^ Reserved (for Security)
    | ICMPType20ReservedForRobustnessExperiment -- ^ Reserved (for Robustness Experiment)
    | ICMPType21ReservedForRobustnessExperiment -- ^ Reserved (for Robustness Experiment)
    | ICMPType22ReservedForRobustnessExperiment -- ^ Reserved (for Robustness Experiment)
    | ICMPType23ReservedForRobustnessExperiment -- ^ Reserved (for Robustness Experiment)
    | ICMPType24ReservedForRobustnessExperiment -- ^ Reserved (for Robustness Experiment)
    | ICMPType25ReservedForRobustnessExperiment -- ^ Reserved (for Robustness Experiment)
    | ICMPType26ReservedForRobustnessExperiment -- ^ Reserved (for Robustness Experiment)
    | ICMPType27ReservedForRobustnessExperiment -- ^ Reserved (for Robustness Experiment)
    | ICMPType28ReservedForRobustnessExperiment -- ^ Reserved (for Robustness Experiment)
    | ICMPType30TracerouteDeprecated -- ^ Traceroute (Deprecated)
    | ICMPType31DatagramConversionErrorDeprecated -- ^ Datagram Conversion Error (Deprecated)
    | ICMPType32MobileHostRedirectDeprecated -- ^ Mobile Host Redirect (Deprecated)
    | ICMPType33Ipv6WhereareyouDeprecated -- ^ IPv6 Where-Are-You (Deprecated)
    | ICMPType34Ipv6IamhereDeprecated -- ^ IPv6 I-Am-Here (Deprecated)
    | ICMPType35MobileRegistrationRequestDeprecated -- ^ Mobile Registration Request (Deprecated)
    | ICMPType36MobileRegistrationReplyDeprecated -- ^ Mobile Registration Reply (Deprecated)
    | ICMPType37DomainNameRequestDeprecated -- ^ Domain Name Request (Deprecated)
    | ICMPType38DomainNameReplyDeprecated -- ^ Domain Name Reply (Deprecated)
    | ICMPType39SkipDeprecated -- ^ SKIP (Deprecated)
    | ICMPType40Photuris -- ^ Photuris
    | ICMPType41IcmpMessagesUtilizedByExperimentalMobilityProtocolsSuchAsSeamoby -- ^ ICMP messages utilized by experimental         mobility protocols such as Seamoby
    | ICMPType42ExtendedEchoRequest -- ^ Extended Echo Request
    | ICMPType43ExtendedEchoReply -- ^ Extended Echo Reply
    | ICMPType253Rfc3692styleExperiment1 -- ^ RFC3692-style Experiment 1
    | ICMPType254Rfc3692styleExperiment2 -- ^ RFC3692-style Experiment 2
    | ICMPType255Reserved -- ^ Reserved
    deriving stock (ICMPType
ICMPType -> ICMPType -> Bounded ICMPType
forall a. a -> a -> Bounded a
maxBound :: ICMPType
$cmaxBound :: ICMPType
minBound :: ICMPType
$cminBound :: ICMPType
Bounded, ICMPType -> ICMPType -> Bool
(ICMPType -> ICMPType -> Bool)
-> (ICMPType -> ICMPType -> Bool) -> Eq ICMPType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ICMPType -> ICMPType -> Bool
$c/= :: ICMPType -> ICMPType -> Bool
== :: ICMPType -> ICMPType -> Bool
$c== :: ICMPType -> ICMPType -> Bool
Eq, Int -> ICMPType
ICMPType -> Int
ICMPType -> [ICMPType]
ICMPType -> ICMPType
ICMPType -> ICMPType -> [ICMPType]
ICMPType -> ICMPType -> ICMPType -> [ICMPType]
(ICMPType -> ICMPType)
-> (ICMPType -> ICMPType)
-> (Int -> ICMPType)
-> (ICMPType -> Int)
-> (ICMPType -> [ICMPType])
-> (ICMPType -> ICMPType -> [ICMPType])
-> (ICMPType -> ICMPType -> [ICMPType])
-> (ICMPType -> ICMPType -> ICMPType -> [ICMPType])
-> Enum ICMPType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ICMPType -> ICMPType -> ICMPType -> [ICMPType]
$cenumFromThenTo :: ICMPType -> ICMPType -> ICMPType -> [ICMPType]
enumFromTo :: ICMPType -> ICMPType -> [ICMPType]
$cenumFromTo :: ICMPType -> ICMPType -> [ICMPType]
enumFromThen :: ICMPType -> ICMPType -> [ICMPType]
$cenumFromThen :: ICMPType -> ICMPType -> [ICMPType]
enumFrom :: ICMPType -> [ICMPType]
$cenumFrom :: ICMPType -> [ICMPType]
fromEnum :: ICMPType -> Int
$cfromEnum :: ICMPType -> Int
toEnum :: Int -> ICMPType
$ctoEnum :: Int -> ICMPType
pred :: ICMPType -> ICMPType
$cpred :: ICMPType -> ICMPType
succ :: ICMPType -> ICMPType
$csucc :: ICMPType -> ICMPType
Enum, (forall x. ICMPType -> Rep ICMPType x)
-> (forall x. Rep ICMPType x -> ICMPType) -> Generic ICMPType
forall x. Rep ICMPType x -> ICMPType
forall x. ICMPType -> Rep ICMPType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ICMPType x -> ICMPType
$cfrom :: forall x. ICMPType -> Rep ICMPType x
Generic, Eq ICMPType
Eq ICMPType
-> (ICMPType -> ICMPType -> Ordering)
-> (ICMPType -> ICMPType -> Bool)
-> (ICMPType -> ICMPType -> Bool)
-> (ICMPType -> ICMPType -> Bool)
-> (ICMPType -> ICMPType -> Bool)
-> (ICMPType -> ICMPType -> ICMPType)
-> (ICMPType -> ICMPType -> ICMPType)
-> Ord ICMPType
ICMPType -> ICMPType -> Bool
ICMPType -> ICMPType -> Ordering
ICMPType -> ICMPType -> ICMPType
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
min :: ICMPType -> ICMPType -> ICMPType
$cmin :: ICMPType -> ICMPType -> ICMPType
max :: ICMPType -> ICMPType -> ICMPType
$cmax :: ICMPType -> ICMPType -> ICMPType
>= :: ICMPType -> ICMPType -> Bool
$c>= :: ICMPType -> ICMPType -> Bool
> :: ICMPType -> ICMPType -> Bool
$c> :: ICMPType -> ICMPType -> Bool
<= :: ICMPType -> ICMPType -> Bool
$c<= :: ICMPType -> ICMPType -> Bool
< :: ICMPType -> ICMPType -> Bool
$c< :: ICMPType -> ICMPType -> Bool
compare :: ICMPType -> ICMPType -> Ordering
$ccompare :: ICMPType -> ICMPType -> Ordering
$cp1Ord :: Eq ICMPType
Ord, Int -> ICMPType -> ShowS
[ICMPType] -> ShowS
ICMPType -> String
(Int -> ICMPType -> ShowS)
-> (ICMPType -> String) -> ([ICMPType] -> ShowS) -> Show ICMPType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ICMPType] -> ShowS
$cshowList :: [ICMPType] -> ShowS
show :: ICMPType -> String
$cshow :: ICMPType -> String
showsPrec :: Int -> ICMPType -> ShowS
$cshowsPrec :: Int -> ICMPType -> ShowS
Show)


-- | Wrap a numeric ICMP code.
--
-- @since 1.0.0
newtype ICMPCodeNum = ICMPCodeNum Word8


-- | ICMP code.
--
-- @since 1.0.0
data ICMPCode
    = ICMPCodeUnknown -- ^ Unknown code
    | ICMPType0Code0 -- ^ Type 0 code 0 - No Code
    | ICMPType3Code0 -- ^ Type 3 code 0 - Net Unreachable
    | ICMPType3Code1 -- ^ Type 3 code 1 - Host Unreachable
    | ICMPType3Code2 -- ^ Type 3 code 2 - Protocol Unreachable
    | ICMPType3Code3 -- ^ Type 3 code 3 - Port Unreachable
    | ICMPType3Code4 -- ^ Type 3 code 4 - Fragmentation Needed and Don't         Fragment was Set
    | ICMPType3Code5 -- ^ Type 3 code 5 - Source Route Failed
    | ICMPType3Code6 -- ^ Type 3 code 6 - Destination Network Unknown
    | ICMPType3Code7 -- ^ Type 3 code 7 - Destination Host Unknown
    | ICMPType3Code8 -- ^ Type 3 code 8 - Source Host Isolated
    | ICMPType3Code9 -- ^ Type 3 code 9 - Communication with Destination         Network is Administratively Prohibited
    | ICMPType3Code10 -- ^ Type 3 code 10 - Communication with Destination Host is         Administratively Prohibited
    | ICMPType3Code11 -- ^ Type 3 code 11 - Destination Network Unreachable for Type         of Service
    | ICMPType3Code12 -- ^ Type 3 code 12 - Destination Host Unreachable for Type of         Service
    | ICMPType3Code13 -- ^ Type 3 code 13 - Communication Administratively Prohibited
    | ICMPType3Code14 -- ^ Type 3 code 14 - Host Precedence Violation
    | ICMPType3Code15 -- ^ Type 3 code 15 - Precedence cutoff in effect
    | ICMPType4Code0 -- ^ Type 4 code 0 - No Code
    | ICMPType5Code0 -- ^ Type 5 code 0 - Redirect Datagram for the Network (or subnet)
    | ICMPType5Code1 -- ^ Type 5 code 1 - Redirect Datagram for the Host
    | ICMPType5Code2 -- ^ Type 5 code 2 - Redirect Datagram for the Type of Service and Network
    | ICMPType5Code3 -- ^ Type 5 code 3 - Redirect Datagram for the Type of Service and Host
    | ICMPType6Code0 -- ^ Type 6 code 0 - Alternate Address for Host
    | ICMPType8Code0 -- ^ Type 8 code 0 - No Code
    | ICMPType9Code0 -- ^ Type 9 code 0 - Normal router advertisement
    | ICMPType9Code16 -- ^ Type 9 code 16 - Does not route common traffic
    | ICMPType10Code0 -- ^ Type 10 code 0 - No Code
    | ICMPType11Code0 -- ^ Type 11 code 0 - Time to Live exceeded in Transit
    | ICMPType11Code1 -- ^ Type 11 code 1 - Fragment Reassembly Time Exceeded
    | ICMPType12Code0 -- ^ Type 12 code 0 - Pointer indicates the error
    | ICMPType12Code1 -- ^ Type 12 code 1 - Missing a Required Option
    | ICMPType12Code2 -- ^ Type 12 code 2 - Bad Length
    | ICMPType13Code0 -- ^ Type 13 code 0 - No Code
    | ICMPType14Code0 -- ^ Type 14 code 0 - No Code
    | ICMPType15Code0 -- ^ Type 15 code 0 - No Code
    | ICMPType16Code0 -- ^ Type 16 code 0 - No Code
    | ICMPType17Code0 -- ^ Type 17 code 0 - No Code
    | ICMPType18Code0 -- ^ Type 18 code 0 - No Code
    | ICMPType40Code0 -- ^ Type 40 code 0 - Bad SPI
    | ICMPType40Code1 -- ^ Type 40 code 1 - Authentication Failed
    | ICMPType40Code2 -- ^ Type 40 code 2 - Decompression Failed
    | ICMPType40Code3 -- ^ Type 40 code 3 - Decryption Failed
    | ICMPType40Code4 -- ^ Type 40 code 4 - Need Authentication
    | ICMPType40Code5 -- ^ Type 40 code 5 - Need Authorization
    | ICMPType42Code0 -- ^ Type 42 code 0 - No Error
    | ICMPType43Code0 -- ^ Type 43 code 0 - No Error
    | ICMPType43Code1 -- ^ Type 43 code 1 - Malformed Query
    | ICMPType43Code2 -- ^ Type 43 code 2 - No Such Interface
    | ICMPType43Code3 -- ^ Type 43 code 3 - No Such Table Entry
    | ICMPType43Code4 -- ^ Type 43 code 4 - Multiple Interfaces Satisfy Query
    deriving stock (ICMPCode
ICMPCode -> ICMPCode -> Bounded ICMPCode
forall a. a -> a -> Bounded a
maxBound :: ICMPCode
$cmaxBound :: ICMPCode
minBound :: ICMPCode
$cminBound :: ICMPCode
Bounded, ICMPCode -> ICMPCode -> Bool
(ICMPCode -> ICMPCode -> Bool)
-> (ICMPCode -> ICMPCode -> Bool) -> Eq ICMPCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ICMPCode -> ICMPCode -> Bool
$c/= :: ICMPCode -> ICMPCode -> Bool
== :: ICMPCode -> ICMPCode -> Bool
$c== :: ICMPCode -> ICMPCode -> Bool
Eq, Int -> ICMPCode
ICMPCode -> Int
ICMPCode -> [ICMPCode]
ICMPCode -> ICMPCode
ICMPCode -> ICMPCode -> [ICMPCode]
ICMPCode -> ICMPCode -> ICMPCode -> [ICMPCode]
(ICMPCode -> ICMPCode)
-> (ICMPCode -> ICMPCode)
-> (Int -> ICMPCode)
-> (ICMPCode -> Int)
-> (ICMPCode -> [ICMPCode])
-> (ICMPCode -> ICMPCode -> [ICMPCode])
-> (ICMPCode -> ICMPCode -> [ICMPCode])
-> (ICMPCode -> ICMPCode -> ICMPCode -> [ICMPCode])
-> Enum ICMPCode
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ICMPCode -> ICMPCode -> ICMPCode -> [ICMPCode]
$cenumFromThenTo :: ICMPCode -> ICMPCode -> ICMPCode -> [ICMPCode]
enumFromTo :: ICMPCode -> ICMPCode -> [ICMPCode]
$cenumFromTo :: ICMPCode -> ICMPCode -> [ICMPCode]
enumFromThen :: ICMPCode -> ICMPCode -> [ICMPCode]
$cenumFromThen :: ICMPCode -> ICMPCode -> [ICMPCode]
enumFrom :: ICMPCode -> [ICMPCode]
$cenumFrom :: ICMPCode -> [ICMPCode]
fromEnum :: ICMPCode -> Int
$cfromEnum :: ICMPCode -> Int
toEnum :: Int -> ICMPCode
$ctoEnum :: Int -> ICMPCode
pred :: ICMPCode -> ICMPCode
$cpred :: ICMPCode -> ICMPCode
succ :: ICMPCode -> ICMPCode
$csucc :: ICMPCode -> ICMPCode
Enum, (forall x. ICMPCode -> Rep ICMPCode x)
-> (forall x. Rep ICMPCode x -> ICMPCode) -> Generic ICMPCode
forall x. Rep ICMPCode x -> ICMPCode
forall x. ICMPCode -> Rep ICMPCode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ICMPCode x -> ICMPCode
$cfrom :: forall x. ICMPCode -> Rep ICMPCode x
Generic, Eq ICMPCode
Eq ICMPCode
-> (ICMPCode -> ICMPCode -> Ordering)
-> (ICMPCode -> ICMPCode -> Bool)
-> (ICMPCode -> ICMPCode -> Bool)
-> (ICMPCode -> ICMPCode -> Bool)
-> (ICMPCode -> ICMPCode -> Bool)
-> (ICMPCode -> ICMPCode -> ICMPCode)
-> (ICMPCode -> ICMPCode -> ICMPCode)
-> Ord ICMPCode
ICMPCode -> ICMPCode -> Bool
ICMPCode -> ICMPCode -> Ordering
ICMPCode -> ICMPCode -> ICMPCode
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
min :: ICMPCode -> ICMPCode -> ICMPCode
$cmin :: ICMPCode -> ICMPCode -> ICMPCode
max :: ICMPCode -> ICMPCode -> ICMPCode
$cmax :: ICMPCode -> ICMPCode -> ICMPCode
>= :: ICMPCode -> ICMPCode -> Bool
$c>= :: ICMPCode -> ICMPCode -> Bool
> :: ICMPCode -> ICMPCode -> Bool
$c> :: ICMPCode -> ICMPCode -> Bool
<= :: ICMPCode -> ICMPCode -> Bool
$c<= :: ICMPCode -> ICMPCode -> Bool
< :: ICMPCode -> ICMPCode -> Bool
$c< :: ICMPCode -> ICMPCode -> Bool
compare :: ICMPCode -> ICMPCode -> Ordering
$ccompare :: ICMPCode -> ICMPCode -> Ordering
$cp1Ord :: Eq ICMPCode
Ord, Int -> ICMPCode -> ShowS
[ICMPCode] -> ShowS
ICMPCode -> String
(Int -> ICMPCode -> ShowS)
-> (ICMPCode -> String) -> ([ICMPCode] -> ShowS) -> Show ICMPCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ICMPCode] -> ShowS
$cshowList :: [ICMPCode] -> ShowS
show :: ICMPCode -> String
$cshow :: ICMPCode -> String
showsPrec :: Int -> ICMPCode -> ShowS
$cshowsPrec :: Int -> ICMPCode -> ShowS
Show)

-- | Get a list of 'ICMPCode' for a given 'ICMPType'.
--
-- @since 1.0.0
icmpCodesForType :: ICMPType -> [ICMPCode]
icmpCodesForType :: ICMPType -> [ICMPCode]
icmpCodesForType ICMPType
ty = case ICMPType
ty of
    ICMPType
ICMPTypeUnknown -> []
    ICMPType
ICMPType0EchoReply -> [
        ICMPCode
ICMPType0Code0
        ]
    ICMPType
ICMPType3DestinationUnreachable -> [
        ICMPCode
ICMPType3Code0,
        ICMPCode
ICMPType3Code1,
        ICMPCode
ICMPType3Code2,
        ICMPCode
ICMPType3Code3,
        ICMPCode
ICMPType3Code4,
        ICMPCode
ICMPType3Code5,
        ICMPCode
ICMPType3Code6,
        ICMPCode
ICMPType3Code7,
        ICMPCode
ICMPType3Code8,
        ICMPCode
ICMPType3Code9,
        ICMPCode
ICMPType3Code10,
        ICMPCode
ICMPType3Code11,
        ICMPCode
ICMPType3Code12,
        ICMPCode
ICMPType3Code13,
        ICMPCode
ICMPType3Code14,
        ICMPCode
ICMPType3Code15
        ]
    ICMPType
ICMPType4SourceQuenchDeprecated -> [
        ICMPCode
ICMPType4Code0
        ]
    ICMPType
ICMPType5Redirect -> [
        ICMPCode
ICMPType5Code0,
        ICMPCode
ICMPType5Code1,
        ICMPCode
ICMPType5Code2,
        ICMPCode
ICMPType5Code3
        ]
    ICMPType
ICMPType6AlternateHostAddressDeprecated -> [
        ICMPCode
ICMPType6Code0
        ]
    ICMPType
ICMPType8Echo -> [
        ICMPCode
ICMPType8Code0
        ]
    ICMPType
ICMPType9RouterAdvertisement -> [
        ICMPCode
ICMPType9Code0,
        ICMPCode
ICMPType9Code16
        ]
    ICMPType
ICMPType10RouterSolicitation -> [
        ICMPCode
ICMPType10Code0
        ]
    ICMPType
ICMPType11TimeExceeded -> [
        ICMPCode
ICMPType11Code0,
        ICMPCode
ICMPType11Code1
        ]
    ICMPType
ICMPType12ParameterProblem -> [
        ICMPCode
ICMPType12Code0,
        ICMPCode
ICMPType12Code1,
        ICMPCode
ICMPType12Code2
        ]
    ICMPType
ICMPType13Timestamp -> [
        ICMPCode
ICMPType13Code0
        ]
    ICMPType
ICMPType14TimestampReply -> [
        ICMPCode
ICMPType14Code0
        ]
    ICMPType
ICMPType15InformationRequestDeprecated -> [
        ICMPCode
ICMPType15Code0
        ]
    ICMPType
ICMPType16InformationReplyDeprecated -> [
        ICMPCode
ICMPType16Code0
        ]
    ICMPType
ICMPType17AddressMaskRequestDeprecated -> [
        ICMPCode
ICMPType17Code0
        ]
    ICMPType
ICMPType18AddressMaskReplyDeprecated -> [
        ICMPCode
ICMPType18Code0
        ]
    ICMPType
ICMPType19ReservedForSecurity -> [
        ]
    ICMPType
ICMPType20ReservedForRobustnessExperiment -> [
        ]
    ICMPType
ICMPType21ReservedForRobustnessExperiment -> [
        ]
    ICMPType
ICMPType22ReservedForRobustnessExperiment -> [
        ]
    ICMPType
ICMPType23ReservedForRobustnessExperiment -> [
        ]
    ICMPType
ICMPType24ReservedForRobustnessExperiment -> [
        ]
    ICMPType
ICMPType25ReservedForRobustnessExperiment -> [
        ]
    ICMPType
ICMPType26ReservedForRobustnessExperiment -> [
        ]
    ICMPType
ICMPType27ReservedForRobustnessExperiment -> [
        ]
    ICMPType
ICMPType28ReservedForRobustnessExperiment -> [
        ]
    ICMPType
ICMPType30TracerouteDeprecated -> [
        ]
    ICMPType
ICMPType31DatagramConversionErrorDeprecated -> [
        ]
    ICMPType
ICMPType32MobileHostRedirectDeprecated -> [
        ]
    ICMPType
ICMPType33Ipv6WhereareyouDeprecated -> [
        ]
    ICMPType
ICMPType34Ipv6IamhereDeprecated -> [
        ]
    ICMPType
ICMPType35MobileRegistrationRequestDeprecated -> [
        ]
    ICMPType
ICMPType36MobileRegistrationReplyDeprecated -> [
        ]
    ICMPType
ICMPType37DomainNameRequestDeprecated -> [
        ]
    ICMPType
ICMPType38DomainNameReplyDeprecated -> [
        ]
    ICMPType
ICMPType39SkipDeprecated -> [
        ]
    ICMPType
ICMPType40Photuris -> [
        ICMPCode
ICMPType40Code0,
        ICMPCode
ICMPType40Code1,
        ICMPCode
ICMPType40Code2,
        ICMPCode
ICMPType40Code3,
        ICMPCode
ICMPType40Code4,
        ICMPCode
ICMPType40Code5
        ]
    ICMPType
ICMPType41IcmpMessagesUtilizedByExperimentalMobilityProtocolsSuchAsSeamoby -> [
        ]
    ICMPType
ICMPType42ExtendedEchoRequest -> [
        ICMPCode
ICMPType42Code0
        ]
    ICMPType
ICMPType43ExtendedEchoReply -> [
        ICMPCode
ICMPType43Code0,
        ICMPCode
ICMPType43Code1,
        ICMPCode
ICMPType43Code2,
        ICMPCode
ICMPType43Code3,
        ICMPCode
ICMPType43Code4
        ]
    ICMPType
ICMPType253Rfc3692styleExperiment1 -> [
        ]
    ICMPType
ICMPType254Rfc3692styleExperiment2 -> [
        ]
    ICMPType
ICMPType255Reserved -> [
        ]

-- | Convert a 'ICMPType' into a string.
--
-- @since 1.0.0
icmpTypeToStringNum :: IsString a => ICMPType -> a
icmpTypeToStringNum :: ICMPType -> a
icmpTypeToStringNum ICMPType
t = case ICMPType
t of
    ICMPType
ICMPType0EchoReply -> a
"0"
    ICMPType
ICMPType3DestinationUnreachable -> a
"3"
    ICMPType
ICMPType4SourceQuenchDeprecated -> a
"4"
    ICMPType
ICMPType5Redirect -> a
"5"
    ICMPType
ICMPType6AlternateHostAddressDeprecated -> a
"6"
    ICMPType
ICMPType8Echo -> a
"8"
    ICMPType
ICMPType9RouterAdvertisement -> a
"9"
    ICMPType
ICMPType10RouterSolicitation -> a
"10"
    ICMPType
ICMPType11TimeExceeded -> a
"11"
    ICMPType
ICMPType12ParameterProblem -> a
"12"
    ICMPType
ICMPType13Timestamp -> a
"13"
    ICMPType
ICMPType14TimestampReply -> a
"14"
    ICMPType
ICMPType15InformationRequestDeprecated -> a
"15"
    ICMPType
ICMPType16InformationReplyDeprecated -> a
"16"
    ICMPType
ICMPType17AddressMaskRequestDeprecated -> a
"17"
    ICMPType
ICMPType18AddressMaskReplyDeprecated -> a
"18"
    ICMPType
ICMPType19ReservedForSecurity -> a
"19"
    ICMPType
ICMPType20ReservedForRobustnessExperiment -> a
"20"
    ICMPType
ICMPType21ReservedForRobustnessExperiment -> a
"21"
    ICMPType
ICMPType22ReservedForRobustnessExperiment -> a
"22"
    ICMPType
ICMPType23ReservedForRobustnessExperiment -> a
"23"
    ICMPType
ICMPType24ReservedForRobustnessExperiment -> a
"24"
    ICMPType
ICMPType25ReservedForRobustnessExperiment -> a
"25"
    ICMPType
ICMPType26ReservedForRobustnessExperiment -> a
"26"
    ICMPType
ICMPType27ReservedForRobustnessExperiment -> a
"27"
    ICMPType
ICMPType28ReservedForRobustnessExperiment -> a
"28"
    ICMPType
ICMPType30TracerouteDeprecated -> a
"30"
    ICMPType
ICMPType31DatagramConversionErrorDeprecated -> a
"31"
    ICMPType
ICMPType32MobileHostRedirectDeprecated -> a
"32"
    ICMPType
ICMPType33Ipv6WhereareyouDeprecated -> a
"33"
    ICMPType
ICMPType34Ipv6IamhereDeprecated -> a
"34"
    ICMPType
ICMPType35MobileRegistrationRequestDeprecated -> a
"35"
    ICMPType
ICMPType36MobileRegistrationReplyDeprecated -> a
"36"
    ICMPType
ICMPType37DomainNameRequestDeprecated -> a
"37"
    ICMPType
ICMPType38DomainNameReplyDeprecated -> a
"38"
    ICMPType
ICMPType39SkipDeprecated -> a
"39"
    ICMPType
ICMPType40Photuris -> a
"40"
    ICMPType
ICMPType41IcmpMessagesUtilizedByExperimentalMobilityProtocolsSuchAsSeamoby -> a
"41"
    ICMPType
ICMPType42ExtendedEchoRequest -> a
"42"
    ICMPType
ICMPType43ExtendedEchoReply -> a
"43"
    ICMPType
ICMPType253Rfc3692styleExperiment1 -> a
"253"
    ICMPType
ICMPType254Rfc3692styleExperiment2 -> a
"254"
    ICMPType
ICMPType255Reserved -> a
"255"
    ICMPType
ICMPTypeUnknown -> a
"?"


-- | Convert a string into a 'ICMPType'.
--
-- @since 1.0.0
icmpTypeFromStringNum :: (Eq a, IsString a) => a -> ICMPType
icmpTypeFromStringNum :: a -> ICMPType
icmpTypeFromStringNum a
s = case a
s of
    a
"0" -> ICMPType
ICMPType0EchoReply
    a
"3" -> ICMPType
ICMPType3DestinationUnreachable
    a
"4" -> ICMPType
ICMPType4SourceQuenchDeprecated
    a
"5" -> ICMPType
ICMPType5Redirect
    a
"6" -> ICMPType
ICMPType6AlternateHostAddressDeprecated
    a
"8" -> ICMPType
ICMPType8Echo
    a
"9" -> ICMPType
ICMPType9RouterAdvertisement
    a
"10" -> ICMPType
ICMPType10RouterSolicitation
    a
"11" -> ICMPType
ICMPType11TimeExceeded
    a
"12" -> ICMPType
ICMPType12ParameterProblem
    a
"13" -> ICMPType
ICMPType13Timestamp
    a
"14" -> ICMPType
ICMPType14TimestampReply
    a
"15" -> ICMPType
ICMPType15InformationRequestDeprecated
    a
"16" -> ICMPType
ICMPType16InformationReplyDeprecated
    a
"17" -> ICMPType
ICMPType17AddressMaskRequestDeprecated
    a
"18" -> ICMPType
ICMPType18AddressMaskReplyDeprecated
    a
"19" -> ICMPType
ICMPType19ReservedForSecurity
    a
"20" -> ICMPType
ICMPType20ReservedForRobustnessExperiment
    a
"21" -> ICMPType
ICMPType21ReservedForRobustnessExperiment
    a
"22" -> ICMPType
ICMPType22ReservedForRobustnessExperiment
    a
"23" -> ICMPType
ICMPType23ReservedForRobustnessExperiment
    a
"24" -> ICMPType
ICMPType24ReservedForRobustnessExperiment
    a
"25" -> ICMPType
ICMPType25ReservedForRobustnessExperiment
    a
"26" -> ICMPType
ICMPType26ReservedForRobustnessExperiment
    a
"27" -> ICMPType
ICMPType27ReservedForRobustnessExperiment
    a
"28" -> ICMPType
ICMPType28ReservedForRobustnessExperiment
    a
"30" -> ICMPType
ICMPType30TracerouteDeprecated
    a
"31" -> ICMPType
ICMPType31DatagramConversionErrorDeprecated
    a
"32" -> ICMPType
ICMPType32MobileHostRedirectDeprecated
    a
"33" -> ICMPType
ICMPType33Ipv6WhereareyouDeprecated
    a
"34" -> ICMPType
ICMPType34Ipv6IamhereDeprecated
    a
"35" -> ICMPType
ICMPType35MobileRegistrationRequestDeprecated
    a
"36" -> ICMPType
ICMPType36MobileRegistrationReplyDeprecated
    a
"37" -> ICMPType
ICMPType37DomainNameRequestDeprecated
    a
"38" -> ICMPType
ICMPType38DomainNameReplyDeprecated
    a
"39" -> ICMPType
ICMPType39SkipDeprecated
    a
"40" -> ICMPType
ICMPType40Photuris
    a
"41" -> ICMPType
ICMPType41IcmpMessagesUtilizedByExperimentalMobilityProtocolsSuchAsSeamoby
    a
"42" -> ICMPType
ICMPType42ExtendedEchoRequest
    a
"43" -> ICMPType
ICMPType43ExtendedEchoReply
    a
"253" -> ICMPType
ICMPType253Rfc3692styleExperiment1
    a
"254" -> ICMPType
ICMPType254Rfc3692styleExperiment2
    a
"255" -> ICMPType
ICMPType255Reserved
    a
_ -> ICMPType
ICMPTypeUnknown


-- | Turn an 'ICMPType' into a 'ICMPTypeNum'.
--
-- @since 1.0.0
icmpTypeToNum :: ICMPType -> ICMPTypeNum
icmpTypeToNum :: ICMPType -> ICMPTypeNum
icmpTypeToNum ICMPType
t = case ICMPType
t of
    ICMPType
ICMPType0EchoReply -> Word8 -> ICMPTypeNum
ICMPTypeNum Word8
0
    ICMPType
ICMPType3DestinationUnreachable -> Word8 -> ICMPTypeNum
ICMPTypeNum Word8
3
    ICMPType
ICMPType4SourceQuenchDeprecated -> Word8 -> ICMPTypeNum
ICMPTypeNum Word8
4
    ICMPType
ICMPType5Redirect -> Word8 -> ICMPTypeNum
ICMPTypeNum Word8
5
    ICMPType
ICMPType6AlternateHostAddressDeprecated -> Word8 -> ICMPTypeNum
ICMPTypeNum Word8
6
    ICMPType
ICMPType8Echo -> Word8 -> ICMPTypeNum
ICMPTypeNum Word8
8
    ICMPType
ICMPType9RouterAdvertisement -> Word8 -> ICMPTypeNum
ICMPTypeNum Word8
9
    ICMPType
ICMPType10RouterSolicitation -> Word8 -> ICMPTypeNum
ICMPTypeNum Word8
10
    ICMPType
ICMPType11TimeExceeded -> Word8 -> ICMPTypeNum
ICMPTypeNum Word8
11
    ICMPType
ICMPType12ParameterProblem -> Word8 -> ICMPTypeNum
ICMPTypeNum Word8
12
    ICMPType
ICMPType13Timestamp -> Word8 -> ICMPTypeNum
ICMPTypeNum Word8
13
    ICMPType
ICMPType14TimestampReply -> Word8 -> ICMPTypeNum
ICMPTypeNum Word8
14
    ICMPType
ICMPType15InformationRequestDeprecated -> Word8 -> ICMPTypeNum
ICMPTypeNum Word8
15
    ICMPType
ICMPType16InformationReplyDeprecated -> Word8 -> ICMPTypeNum
ICMPTypeNum Word8
16
    ICMPType
ICMPType17AddressMaskRequestDeprecated -> Word8 -> ICMPTypeNum
ICMPTypeNum Word8
17
    ICMPType
ICMPType18AddressMaskReplyDeprecated -> Word8 -> ICMPTypeNum
ICMPTypeNum Word8
18
    ICMPType
ICMPType19ReservedForSecurity -> Word8 -> ICMPTypeNum
ICMPTypeNum Word8
19
    ICMPType
ICMPType20ReservedForRobustnessExperiment -> Word8 -> ICMPTypeNum
ICMPTypeNum Word8
20
    ICMPType
ICMPType21ReservedForRobustnessExperiment -> Word8 -> ICMPTypeNum
ICMPTypeNum Word8
21
    ICMPType
ICMPType22ReservedForRobustnessExperiment -> Word8 -> ICMPTypeNum
ICMPTypeNum Word8
22
    ICMPType
ICMPType23ReservedForRobustnessExperiment -> Word8 -> ICMPTypeNum
ICMPTypeNum Word8
23
    ICMPType
ICMPType24ReservedForRobustnessExperiment -> Word8 -> ICMPTypeNum
ICMPTypeNum Word8
24
    ICMPType
ICMPType25ReservedForRobustnessExperiment -> Word8 -> ICMPTypeNum
ICMPTypeNum Word8
25
    ICMPType
ICMPType26ReservedForRobustnessExperiment -> Word8 -> ICMPTypeNum
ICMPTypeNum Word8
26
    ICMPType
ICMPType27ReservedForRobustnessExperiment -> Word8 -> ICMPTypeNum
ICMPTypeNum Word8
27
    ICMPType
ICMPType28ReservedForRobustnessExperiment -> Word8 -> ICMPTypeNum
ICMPTypeNum Word8
28
    ICMPType
ICMPType30TracerouteDeprecated -> Word8 -> ICMPTypeNum
ICMPTypeNum Word8
30
    ICMPType
ICMPType31DatagramConversionErrorDeprecated -> Word8 -> ICMPTypeNum
ICMPTypeNum Word8
31
    ICMPType
ICMPType32MobileHostRedirectDeprecated -> Word8 -> ICMPTypeNum
ICMPTypeNum Word8
32
    ICMPType
ICMPType33Ipv6WhereareyouDeprecated -> Word8 -> ICMPTypeNum
ICMPTypeNum Word8
33
    ICMPType
ICMPType34Ipv6IamhereDeprecated -> Word8 -> ICMPTypeNum
ICMPTypeNum Word8
34
    ICMPType
ICMPType35MobileRegistrationRequestDeprecated -> Word8 -> ICMPTypeNum
ICMPTypeNum Word8
35
    ICMPType
ICMPType36MobileRegistrationReplyDeprecated -> Word8 -> ICMPTypeNum
ICMPTypeNum Word8
36
    ICMPType
ICMPType37DomainNameRequestDeprecated -> Word8 -> ICMPTypeNum
ICMPTypeNum Word8
37
    ICMPType
ICMPType38DomainNameReplyDeprecated -> Word8 -> ICMPTypeNum
ICMPTypeNum Word8
38
    ICMPType
ICMPType39SkipDeprecated -> Word8 -> ICMPTypeNum
ICMPTypeNum Word8
39
    ICMPType
ICMPType40Photuris -> Word8 -> ICMPTypeNum
ICMPTypeNum Word8
40
    ICMPType
ICMPType41IcmpMessagesUtilizedByExperimentalMobilityProtocolsSuchAsSeamoby -> Word8 -> ICMPTypeNum
ICMPTypeNum Word8
41
    ICMPType
ICMPType42ExtendedEchoRequest -> Word8 -> ICMPTypeNum
ICMPTypeNum Word8
42
    ICMPType
ICMPType43ExtendedEchoReply -> Word8 -> ICMPTypeNum
ICMPTypeNum Word8
43
    ICMPType
ICMPType253Rfc3692styleExperiment1 -> Word8 -> ICMPTypeNum
ICMPTypeNum Word8
253
    ICMPType
ICMPType254Rfc3692styleExperiment2 -> Word8 -> ICMPTypeNum
ICMPTypeNum Word8
254
    ICMPType
ICMPType255Reserved -> Word8 -> ICMPTypeNum
ICMPTypeNum Word8
255
    ICMPType
ICMPTypeUnknown -> Word8 -> ICMPTypeNum
ICMPTypeNum Word8
0


-- | Test if an 'ICMPType' has been deprecated.
--
-- @since 1.0.0
isICMPTypeDeprecated :: ICMPType -> Bool
isICMPTypeDeprecated :: ICMPType -> Bool
isICMPTypeDeprecated ICMPType
ty = case ICMPType
ty of
   ICMPType
ICMPType0EchoReply-> Bool
False
   ICMPType
ICMPType3DestinationUnreachable-> Bool
False
   ICMPType
ICMPType4SourceQuenchDeprecated-> Bool
True
   ICMPType
ICMPType5Redirect-> Bool
False
   ICMPType
ICMPType6AlternateHostAddressDeprecated-> Bool
True
   ICMPType
ICMPType8Echo-> Bool
False
   ICMPType
ICMPType9RouterAdvertisement-> Bool
False
   ICMPType
ICMPType10RouterSolicitation-> Bool
False
   ICMPType
ICMPType11TimeExceeded-> Bool
False
   ICMPType
ICMPType12ParameterProblem-> Bool
False
   ICMPType
ICMPType13Timestamp-> Bool
False
   ICMPType
ICMPType14TimestampReply-> Bool
False
   ICMPType
ICMPType15InformationRequestDeprecated-> Bool
True
   ICMPType
ICMPType16InformationReplyDeprecated-> Bool
True
   ICMPType
ICMPType17AddressMaskRequestDeprecated-> Bool
True
   ICMPType
ICMPType18AddressMaskReplyDeprecated-> Bool
True
   ICMPType
ICMPType19ReservedForSecurity-> Bool
False
   ICMPType
ICMPType20ReservedForRobustnessExperiment-> Bool
False
   ICMPType
ICMPType21ReservedForRobustnessExperiment-> Bool
False
   ICMPType
ICMPType22ReservedForRobustnessExperiment-> Bool
False
   ICMPType
ICMPType23ReservedForRobustnessExperiment-> Bool
False
   ICMPType
ICMPType24ReservedForRobustnessExperiment-> Bool
False
   ICMPType
ICMPType25ReservedForRobustnessExperiment-> Bool
False
   ICMPType
ICMPType26ReservedForRobustnessExperiment-> Bool
False
   ICMPType
ICMPType27ReservedForRobustnessExperiment-> Bool
False
   ICMPType
ICMPType28ReservedForRobustnessExperiment-> Bool
False
   ICMPType
ICMPType30TracerouteDeprecated-> Bool
True
   ICMPType
ICMPType31DatagramConversionErrorDeprecated-> Bool
True
   ICMPType
ICMPType32MobileHostRedirectDeprecated-> Bool
True
   ICMPType
ICMPType33Ipv6WhereareyouDeprecated-> Bool
True
   ICMPType
ICMPType34Ipv6IamhereDeprecated-> Bool
True
   ICMPType
ICMPType35MobileRegistrationRequestDeprecated-> Bool
True
   ICMPType
ICMPType36MobileRegistrationReplyDeprecated-> Bool
True
   ICMPType
ICMPType37DomainNameRequestDeprecated-> Bool
True
   ICMPType
ICMPType38DomainNameReplyDeprecated-> Bool
True
   ICMPType
ICMPType39SkipDeprecated-> Bool
True
   ICMPType
ICMPType40Photuris-> Bool
False
   ICMPType
ICMPType41IcmpMessagesUtilizedByExperimentalMobilityProtocolsSuchAsSeamoby-> Bool
False
   ICMPType
ICMPType42ExtendedEchoRequest-> Bool
False
   ICMPType
ICMPType43ExtendedEchoReply-> Bool
False
   ICMPType
ICMPType253Rfc3692styleExperiment1-> Bool
False
   ICMPType
ICMPType254Rfc3692styleExperiment2-> Bool
False
   ICMPType
ICMPType255Reserved-> Bool
False
   ICMPType
ICMPTypeUnknown -> Bool
False


-- | Convert a 'ICMPCode' into a string.
--
-- @since 1.0.1
icmpCodeToStringNum :: IsString a => ICMPCode -> a
icmpCodeToStringNum :: ICMPCode -> a
icmpCodeToStringNum ICMPCode
t = case ICMPCode
t of
        ICMPCode
ICMPType0Code0 -> a
"0"
        ICMPCode
ICMPType3Code0 -> a
"0"
        ICMPCode
ICMPType3Code1 -> a
"1"
        ICMPCode
ICMPType3Code2 -> a
"2"
        ICMPCode
ICMPType3Code3 -> a
"3"
        ICMPCode
ICMPType3Code4 -> a
"4"
        ICMPCode
ICMPType3Code5 -> a
"5"
        ICMPCode
ICMPType3Code6 -> a
"6"
        ICMPCode
ICMPType3Code7 -> a
"7"
        ICMPCode
ICMPType3Code8 -> a
"8"
        ICMPCode
ICMPType3Code9 -> a
"9"
        ICMPCode
ICMPType3Code10 -> a
"10"
        ICMPCode
ICMPType3Code11 -> a
"11"
        ICMPCode
ICMPType3Code12 -> a
"12"
        ICMPCode
ICMPType3Code13 -> a
"13"
        ICMPCode
ICMPType3Code14 -> a
"14"
        ICMPCode
ICMPType3Code15 -> a
"15"
        ICMPCode
ICMPType4Code0 -> a
"0"
        ICMPCode
ICMPType5Code0 -> a
"0"
        ICMPCode
ICMPType5Code1 -> a
"1"
        ICMPCode
ICMPType5Code2 -> a
"2"
        ICMPCode
ICMPType5Code3 -> a
"3"
        ICMPCode
ICMPType6Code0 -> a
"0"
        ICMPCode
ICMPType8Code0 -> a
"0"
        ICMPCode
ICMPType9Code0 -> a
"0"
        ICMPCode
ICMPType9Code16 -> a
"16"
        ICMPCode
ICMPType10Code0 -> a
"0"
        ICMPCode
ICMPType11Code0 -> a
"0"
        ICMPCode
ICMPType11Code1 -> a
"1"
        ICMPCode
ICMPType12Code0 -> a
"0"
        ICMPCode
ICMPType12Code1 -> a
"1"
        ICMPCode
ICMPType12Code2 -> a
"2"
        ICMPCode
ICMPType13Code0 -> a
"0"
        ICMPCode
ICMPType14Code0 -> a
"0"
        ICMPCode
ICMPType15Code0 -> a
"0"
        ICMPCode
ICMPType16Code0 -> a
"0"
        ICMPCode
ICMPType17Code0 -> a
"0"
        ICMPCode
ICMPType18Code0 -> a
"0"
        ICMPCode
ICMPType40Code0 -> a
"0"
        ICMPCode
ICMPType40Code1 -> a
"1"
        ICMPCode
ICMPType40Code2 -> a
"2"
        ICMPCode
ICMPType40Code3 -> a
"3"
        ICMPCode
ICMPType40Code4 -> a
"4"
        ICMPCode
ICMPType40Code5 -> a
"5"
        ICMPCode
ICMPType42Code0 -> a
"0"
        ICMPCode
ICMPType43Code0 -> a
"0"
        ICMPCode
ICMPType43Code1 -> a
"1"
        ICMPCode
ICMPType43Code2 -> a
"2"
        ICMPCode
ICMPType43Code3 -> a
"3"
        ICMPCode
ICMPType43Code4 -> a
"4"
        ICMPCode
ICMPCodeUnknown -> a
"?"