{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}

#ifdef VERSION_aeson
{-# LANGUAGE StandaloneDeriving #-}
#endif

-- |
-- Module: Network.HostAddress
-- Copyright: Copyright © 2020 Lars Kuhtz <lakuhtz@gmail.com>
-- License: MIT
-- Maintainer: Lars Kuhtz <lakuhtz@gmail.com>
-- Stability: experimental
--
-- Host addresses as described in RFC2396 section 3.2.2 with additional consideration of
--
-- * RFC1123 (additional restrictions for hostnames),
-- * RFC1034 (disambiguate domain names and IPv4 addresses),
-- * RFC4291 (parsing of IPv6 addresses), and
-- * RFC3986 and RFC5952 (IPv6 literals within host addresses).
--
-- Port numbers must be within the range @[0,2^16-1]@.
--
-- All hostnames are considered fully qualified and thus the final dot is
-- omitted.
--
-- For hostnames we follow the specification for "Server-based Naming Authority"
-- for URIs from RFC2396 section 3.2.2.:
--
-- @
--      hostport      = host [ ":" port ]
--      host          = hostname | IPv4address
--      hostname      = *( domainlabel "." ) toplabel [ "." ]
--      domainlabel   = alphanum | alphanum *( alphanum | "-" ) alphanum
--      toplabel      = alpha | alpha *( alphanum | "-" ) alphanum
--
--      IPv4address   = 1*digit "." 1*digit "." 1*digit "." 1*digit
--      port          = *digit
-- @
--
-- @1*digit@ designates the decimal representation of an octet. The specification
-- takes the form of hostnames from section 2.1 RFC1123, but limiting the
-- rightmost (top-most) label to the from given in section 3 of RFC1034, which
-- allows to disambiguate domain names and IPv4 addresses.
--
-- IPv6 Addresses are partially supported. IPv6 address are parsed as described
-- in RFC4291, but embedding of IPv4 addresses is not supported. IPv6 addresses
-- are printed exactly as they where parsed. No normalization is performed. In
-- particular the recommendations from RFC5952 are not considered. For host
-- addresses RFC3986 and RFC5952 are followed by requiring that IPv6 literals
-- are enclosed in square brackets. Anything else from RFC3986, which is
-- concerning URIs is ignored.
--
-- Additional restriction for hostname apply from RFC1123: labels must have not
-- more than 63 octets, letters are case-insensitive. The maximum length must not
-- exceed 254 octets, excluding the (optional) terminating dot.
--
-- See <https://cs.uwaterloo.ca/twiki/view/CF/HostNamingRules> for an extensive
-- overview of different standards for host names.
--
-- Non-ascii characters are encoded via Punycode and are of no concern in this
-- implementation.
--
module Network.HostAddress
(
-- * Port Numbers
  Port
, portToText
, portFromText
, readPortBytes

-- * Hostnames
, Hostname
, hostnameBytes
, readHostnameBytes
, hostnameToText
, hostnameFromText
, unsafeHostnameFromText

-- ** Pattern Synonyms
, IPv4
, IPv6
, pattern HostName
, pattern HostIPv4
, pattern HostIPv6

-- ** Special Host Names
, localhost
, localhostIPv4
, localhostIPv6
, anyIpv4
, broadcast
, loopback
, isReservedHostname
, isPrivateHostname
, isLocalIp

-- * HostAddresses
, HostAddress(..)
, hostAddressPort
, hostAddressHost
, hostAddressBytes
, readHostAddressBytes
, hostAddressToText
, hostAddressFromText
, unsafeHostAddressFromText

-- ** Special Host Addresses
, isPrivateHostAddress
, isReservedHostAddress

#ifdef VERSION_configuration_tools
-- * Configuration Tools Support
, pPort
, pHostname
, pHostAddress
, pHostAddress'
#endif

#ifdef VERSION_QuickCheck
-- * Arbitrary Values
, arbitraryPort
, arbitraryDomainName
, arbitraryIpV4
, arbitraryIpV6
, arbitraryHostname
, arbitraryHostAddress

-- * Properties
, properties
#endif
) where

#ifdef VERSION_configuration_tools
import Configuration.Utils hiding ((<?>), (<|>), FromJSON, ToJSON)
#endif

import Control.Applicative
import Control.DeepSeq (NFData)
import Control.Monad
import Control.Monad.Catch

#ifdef VERSION_aeson
import Data.Aeson hiding ((<?>))
#endif

import Data.Attoparsec.ByteString.Char8
#ifdef VERSION_configuration_tools
import Data.Bifunctor
#endif
import qualified Data.ByteString.Char8 as B8
import qualified Data.CaseInsensitive as CI
import Data.Hashable (Hashable(..))
import Data.IP hiding (IPv4, IPv6)
import qualified Data.IP as IP (IPv4)
#ifdef VERSION_QuickCheck
import qualified Data.List as L
#endif
import Data.Maybe
import Data.String
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Word (Word16, Word8)

import GHC.Generics (Generic)
import GHC.Stack (HasCallStack)

import Lens.Micro.TH (makeLenses)

#ifdef VERSION_configuration_tools
import qualified Options.Applicative as O
#endif

#ifdef VERSION_QuickCheck
import Test.QuickCheck
#endif

-- -------------------------------------------------------------------------- --
-- Utils

sshow :: Show a => IsString b => a -> b
sshow :: a -> b
sshow = String -> b
forall a. IsString a => String -> a
fromString (String -> b) -> (a -> String) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show
{-# INLINE sshow #-}

fromJuste :: HasCallStack => Maybe a -> a
fromJuste :: Maybe a -> a
fromJuste = Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust
{-# INLINE fromJuste #-}

int :: Integral a => Num b  => a -> b
int :: a -> b
int = a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE int #-}

newtype HostAddressParserException = HostAddressParserException T.Text
    deriving (Int -> HostAddressParserException -> ShowS
[HostAddressParserException] -> ShowS
HostAddressParserException -> String
(Int -> HostAddressParserException -> ShowS)
-> (HostAddressParserException -> String)
-> ([HostAddressParserException] -> ShowS)
-> Show HostAddressParserException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HostAddressParserException] -> ShowS
$cshowList :: [HostAddressParserException] -> ShowS
show :: HostAddressParserException -> String
$cshow :: HostAddressParserException -> String
showsPrec :: Int -> HostAddressParserException -> ShowS
$cshowsPrec :: Int -> HostAddressParserException -> ShowS
Show, HostAddressParserException -> HostAddressParserException -> Bool
(HostAddressParserException -> HostAddressParserException -> Bool)
-> (HostAddressParserException
    -> HostAddressParserException -> Bool)
-> Eq HostAddressParserException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HostAddressParserException -> HostAddressParserException -> Bool
$c/= :: HostAddressParserException -> HostAddressParserException -> Bool
== :: HostAddressParserException -> HostAddressParserException -> Bool
$c== :: HostAddressParserException -> HostAddressParserException -> Bool
Eq, Eq HostAddressParserException
Eq HostAddressParserException
-> (HostAddressParserException
    -> HostAddressParserException -> Ordering)
-> (HostAddressParserException
    -> HostAddressParserException -> Bool)
-> (HostAddressParserException
    -> HostAddressParserException -> Bool)
-> (HostAddressParserException
    -> HostAddressParserException -> Bool)
-> (HostAddressParserException
    -> HostAddressParserException -> Bool)
-> (HostAddressParserException
    -> HostAddressParserException -> HostAddressParserException)
-> (HostAddressParserException
    -> HostAddressParserException -> HostAddressParserException)
-> Ord HostAddressParserException
HostAddressParserException -> HostAddressParserException -> Bool
HostAddressParserException
-> HostAddressParserException -> Ordering
HostAddressParserException
-> HostAddressParserException -> HostAddressParserException
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 :: HostAddressParserException
-> HostAddressParserException -> HostAddressParserException
$cmin :: HostAddressParserException
-> HostAddressParserException -> HostAddressParserException
max :: HostAddressParserException
-> HostAddressParserException -> HostAddressParserException
$cmax :: HostAddressParserException
-> HostAddressParserException -> HostAddressParserException
>= :: HostAddressParserException -> HostAddressParserException -> Bool
$c>= :: HostAddressParserException -> HostAddressParserException -> Bool
> :: HostAddressParserException -> HostAddressParserException -> Bool
$c> :: HostAddressParserException -> HostAddressParserException -> Bool
<= :: HostAddressParserException -> HostAddressParserException -> Bool
$c<= :: HostAddressParserException -> HostAddressParserException -> Bool
< :: HostAddressParserException -> HostAddressParserException -> Bool
$c< :: HostAddressParserException -> HostAddressParserException -> Bool
compare :: HostAddressParserException
-> HostAddressParserException -> Ordering
$ccompare :: HostAddressParserException
-> HostAddressParserException -> Ordering
$cp1Ord :: Eq HostAddressParserException
Ord, (forall x.
 HostAddressParserException -> Rep HostAddressParserException x)
-> (forall x.
    Rep HostAddressParserException x -> HostAddressParserException)
-> Generic HostAddressParserException
forall x.
Rep HostAddressParserException x -> HostAddressParserException
forall x.
HostAddressParserException -> Rep HostAddressParserException x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep HostAddressParserException x -> HostAddressParserException
$cfrom :: forall x.
HostAddressParserException -> Rep HostAddressParserException x
Generic)
    deriving anyclass (Int -> HostAddressParserException -> Int
HostAddressParserException -> Int
(Int -> HostAddressParserException -> Int)
-> (HostAddressParserException -> Int)
-> Hashable HostAddressParserException
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: HostAddressParserException -> Int
$chash :: HostAddressParserException -> Int
hashWithSalt :: Int -> HostAddressParserException -> Int
$chashWithSalt :: Int -> HostAddressParserException -> Int
Hashable)
    deriving newtype (HostAddressParserException -> ()
(HostAddressParserException -> ())
-> NFData HostAddressParserException
forall a. (a -> ()) -> NFData a
rnf :: HostAddressParserException -> ()
$crnf :: HostAddressParserException -> ()
NFData)

instance Exception HostAddressParserException

-- -------------------------------------------------------------------------- --
-- Internal Parsers

data HostType = HostTypeName | HostTypeIPv4 | HostTypeIPv6
    deriving (Int -> HostType -> ShowS
[HostType] -> ShowS
HostType -> String
(Int -> HostType -> ShowS)
-> (HostType -> String) -> ([HostType] -> ShowS) -> Show HostType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HostType] -> ShowS
$cshowList :: [HostType] -> ShowS
show :: HostType -> String
$cshow :: HostType -> String
showsPrec :: Int -> HostType -> ShowS
$cshowsPrec :: Int -> HostType -> ShowS
Show, HostType -> HostType -> Bool
(HostType -> HostType -> Bool)
-> (HostType -> HostType -> Bool) -> Eq HostType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HostType -> HostType -> Bool
$c/= :: HostType -> HostType -> Bool
== :: HostType -> HostType -> Bool
$c== :: HostType -> HostType -> Bool
Eq, Eq HostType
Eq HostType
-> (HostType -> HostType -> Ordering)
-> (HostType -> HostType -> Bool)
-> (HostType -> HostType -> Bool)
-> (HostType -> HostType -> Bool)
-> (HostType -> HostType -> Bool)
-> (HostType -> HostType -> HostType)
-> (HostType -> HostType -> HostType)
-> Ord HostType
HostType -> HostType -> Bool
HostType -> HostType -> Ordering
HostType -> HostType -> HostType
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 :: HostType -> HostType -> HostType
$cmin :: HostType -> HostType -> HostType
max :: HostType -> HostType -> HostType
$cmax :: HostType -> HostType -> HostType
>= :: HostType -> HostType -> Bool
$c>= :: HostType -> HostType -> Bool
> :: HostType -> HostType -> Bool
$c> :: HostType -> HostType -> Bool
<= :: HostType -> HostType -> Bool
$c<= :: HostType -> HostType -> Bool
< :: HostType -> HostType -> Bool
$c< :: HostType -> HostType -> Bool
compare :: HostType -> HostType -> Ordering
$ccompare :: HostType -> HostType -> Ordering
$cp1Ord :: Eq HostType
Ord, (forall x. HostType -> Rep HostType x)
-> (forall x. Rep HostType x -> HostType) -> Generic HostType
forall x. Rep HostType x -> HostType
forall x. HostType -> Rep HostType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HostType x -> HostType
$cfrom :: forall x. HostType -> Rep HostType x
Generic, Int -> HostType -> Int
HostType -> Int
(Int -> HostType -> Int) -> (HostType -> Int) -> Hashable HostType
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: HostType -> Int
$chash :: HostType -> Int
hashWithSalt :: Int -> HostType -> Int
$chashWithSalt :: Int -> HostType -> Int
Hashable)

hostParser :: Parser HostType
hostParser :: Parser HostType
hostParser
    = HostType
HostTypeName HostType -> Parser ByteString () -> Parser HostType
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ByteString ()
hostNameParser
    Parser HostType -> Parser HostType -> Parser HostType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> HostType
HostTypeIPv4 HostType -> Parser ByteString IPv4 -> Parser HostType
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ByteString IPv4
ipV4Parser
    Parser HostType -> Parser HostType -> Parser HostType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> HostType
HostTypeIPv6 HostType -> Parser ByteString IPv6 -> Parser HostType
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ByteString IPv6
ipV6Parser
    Parser HostType -> String -> Parser HostType
forall i a. Parser i a -> String -> Parser i a
<?> String
"host"

hostNameParser :: Parser ()
hostNameParser :: Parser ByteString ()
hostNameParser = ()
    () -> Parser ByteString [()] -> Parser ByteString ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ByteString () -> Parser ByteString [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' (Parser ByteString ()
domainlabel Parser ByteString ()
-> Parser ByteString ByteString -> Parser ByteString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ByteString
".") Parser ByteString ()
-> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
toplabel
    Parser ByteString () -> String -> Parser ByteString ()
forall i a. Parser i a -> String -> Parser i a
<?> String
"hostname"
  where
    domainlabel :: Parser ByteString ()
domainlabel = ()
        () -> Parser ByteString Char -> Parser ByteString ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ByteString Char
alphanum Parser ByteString ()
-> Parser ByteString (Maybe ()) -> Parser ByteString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString () -> Parser ByteString (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString ()
labelTail
        Parser ByteString () -> String -> Parser ByteString ()
forall i a. Parser i a -> String -> Parser i a
<?> String
"domainlabel"

    toplabel :: Parser ByteString ()
toplabel = ()
        () -> Parser ByteString Char -> Parser ByteString ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ByteString Char
alpha Parser ByteString ()
-> Parser ByteString (Maybe ()) -> Parser ByteString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString () -> Parser ByteString (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString ()
labelTail
        Parser ByteString () -> String -> Parser ByteString ()
forall i a. Parser i a -> String -> Parser i a
<?> String
"toplabel"

    labelTail :: Parser ByteString ()
labelTail = Parser ByteString Char
alphanumhyphen Parser ByteString Char
-> (Char -> Parser ByteString ()) -> Parser ByteString ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Char
'-' -> Parser ByteString ()
labelTail
        Char
_ -> () () -> Parser ByteString (Maybe ()) -> Parser ByteString ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ByteString () -> Parser ByteString (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString ()
labelTail

    alpha :: Parser ByteString Char
alpha = (Char -> Bool) -> Parser ByteString Char
satisfy Char -> Bool
isAlpha_ascii
        Parser ByteString Char -> String -> Parser ByteString Char
forall i a. Parser i a -> String -> Parser i a
<?> String
"alpha"

    alphanum :: Parser ByteString Char
alphanum = (Char -> Bool) -> Parser ByteString Char
satisfy (\Char
c -> Char -> Bool
isAlpha_ascii Char
c Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
c)
        Parser ByteString Char -> String -> Parser ByteString Char
forall i a. Parser i a -> String -> Parser i a
<?> String
"alphanum"

    alphanumhyphen :: Parser ByteString Char
alphanumhyphen = (Char -> Bool) -> Parser ByteString Char
satisfy (\Char
c -> Char -> Bool
isAlpha_ascii Char
c Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-')
        Parser ByteString Char -> String -> Parser ByteString Char
forall i a. Parser i a -> String -> Parser i a
<?> String
"alphahumhypen"

type IPv4 =  (Word8, Word8, Word8, Word8)

ipV4Parser :: Parser IPv4
ipV4Parser :: Parser ByteString IPv4
ipV4Parser = (,,,)
    (Word8 -> Word8 -> Word8 -> Word8 -> IPv4)
-> Parser ByteString Word8
-> Parser ByteString (Word8 -> Word8 -> Word8 -> IPv4)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ByteString Word8
octet Parser ByteString Word8
-> Parser ByteString ByteString -> Parser ByteString Word8
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ByteString
".") Parser ByteString (Word8 -> Word8 -> Word8 -> IPv4)
-> Parser ByteString Word8
-> Parser ByteString (Word8 -> Word8 -> IPv4)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString Word8
octet Parser ByteString Word8
-> Parser ByteString ByteString -> Parser ByteString Word8
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ByteString
".") Parser ByteString (Word8 -> Word8 -> IPv4)
-> Parser ByteString Word8 -> Parser ByteString (Word8 -> IPv4)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString Word8
octet Parser ByteString Word8
-> Parser ByteString ByteString -> Parser ByteString Word8
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ByteString
".") Parser ByteString (Word8 -> IPv4)
-> Parser ByteString Word8 -> Parser ByteString IPv4
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Word8
octet
    Parser ByteString IPv4 -> String -> Parser ByteString IPv4
forall i a. Parser i a -> String -> Parser i a
<?> String
"ipv4address"
  where
    octet :: Parser Word8
    octet :: Parser ByteString Word8
octet = (Parser Integer
forall a. Integral a => Parser a
decimal Parser Integer
-> (Integer -> Parser ByteString Word8) -> Parser ByteString Word8
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Integer
d :: Integer) -> Integer -> Word8
forall a b. (Integral a, Num b) => a -> b
int Integer
d Word8 -> Parser ByteString () -> Parser ByteString Word8
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Parser ByteString ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Integer
d Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
256))
        Parser ByteString Word8 -> String -> Parser ByteString Word8
forall i a. Parser i a -> String -> Parser i a
<?> String
"octet"

type IPv6 = [Maybe Word16]

ipV6Parser :: Parser IPv6
ipV6Parser :: Parser ByteString IPv6
ipV6Parser = Parser ByteString IPv6
p0
  where
    p0 :: Parser ByteString IPv6
p0 = Maybe Word16 -> IPv6
forall a. a -> [a]
l1 (Maybe Word16 -> IPv6)
-> Parser ByteString (Maybe Word16) -> Parser ByteString IPv6
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString (Maybe Word16)
elision Parser ByteString IPv6
-> Parser ByteString () -> Parser ByteString IPv6
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
endOfInput
        Parser ByteString IPv6
-> Parser ByteString IPv6 -> Parser ByteString IPv6
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Word16 -> Maybe Word16 -> IPv6 -> IPv6
forall a. a -> a -> [a] -> [a]
l3 (Maybe Word16 -> Maybe Word16 -> IPv6 -> IPv6)
-> Parser ByteString (Maybe Word16)
-> Parser ByteString (Maybe Word16 -> IPv6 -> IPv6)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString (Maybe Word16)
elision Parser ByteString (Maybe Word16 -> IPv6 -> IPv6)
-> Parser ByteString (Maybe Word16)
-> Parser ByteString (IPv6 -> IPv6)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (Maybe Word16)
h16 Parser ByteString (IPv6 -> IPv6)
-> Parser ByteString IPv6 -> Parser ByteString IPv6
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Parser ByteString IPv6
p2 Int
6
        Parser ByteString IPv6
-> Parser ByteString IPv6 -> Parser ByteString IPv6
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Word16 -> IPv6 -> IPv6
forall a. a -> [a] -> [a]
l2 (Maybe Word16 -> IPv6 -> IPv6)
-> Parser ByteString (Maybe Word16)
-> Parser ByteString (IPv6 -> IPv6)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString (Maybe Word16)
h16 Parser ByteString (IPv6 -> IPv6)
-> Parser ByteString IPv6 -> Parser ByteString IPv6
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Parser ByteString IPv6
p1 Int
7
        Parser ByteString IPv6 -> String -> Parser ByteString IPv6
forall i a. Parser i a -> String -> Parser i a
<?> String
"IPv6address"

    p1 :: Int -> Parser [Maybe Word16]
    p1 :: Int -> Parser ByteString IPv6
p1 Int
0 = IPv6
forall a. [a]
l0 IPv6 -> Parser ByteString () -> Parser ByteString IPv6
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ByteString ()
forall t. Chunk t => Parser t ()
endOfInput Parser ByteString IPv6 -> String -> Parser ByteString IPv6
forall i a. Parser i a -> String -> Parser i a
<?> String
"IPv6 prefix: too many segments"
    p1 Int
i = Maybe Word16 -> IPv6
forall a. a -> [a]
l1 (Maybe Word16 -> IPv6)
-> Parser ByteString (Maybe Word16) -> Parser ByteString IPv6
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString (Maybe Word16)
elision Parser ByteString IPv6
-> Parser ByteString () -> Parser ByteString IPv6
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
endOfInput
        Parser ByteString IPv6
-> Parser ByteString IPv6 -> Parser ByteString IPv6
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Word16 -> Maybe Word16 -> IPv6 -> IPv6
forall a. a -> a -> [a] -> [a]
l3 (Maybe Word16 -> Maybe Word16 -> IPv6 -> IPv6)
-> Parser ByteString (Maybe Word16)
-> Parser ByteString (Maybe Word16 -> IPv6 -> IPv6)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString (Maybe Word16)
elision Parser ByteString (Maybe Word16 -> IPv6 -> IPv6)
-> Parser ByteString (Maybe Word16)
-> Parser ByteString (IPv6 -> IPv6)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (Maybe Word16)
h16 Parser ByteString (IPv6 -> IPv6)
-> Parser ByteString IPv6 -> Parser ByteString IPv6
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Parser ByteString IPv6
p2 (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)
        Parser ByteString IPv6
-> Parser ByteString IPv6 -> Parser ByteString IPv6
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Word16 -> IPv6 -> IPv6
forall a. a -> [a] -> [a]
l2 (Maybe Word16 -> IPv6 -> IPv6)
-> Parser ByteString ByteString
-> Parser ByteString (Maybe Word16 -> IPv6 -> IPv6)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ByteString ByteString
":" Parser ByteString (Maybe Word16 -> IPv6 -> IPv6)
-> Parser ByteString (Maybe Word16)
-> Parser ByteString (IPv6 -> IPv6)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (Maybe Word16)
h16 Parser ByteString (IPv6 -> IPv6)
-> Parser ByteString IPv6 -> Parser ByteString IPv6
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Parser ByteString IPv6
p1 (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        Parser ByteString IPv6 -> String -> Parser ByteString IPv6
forall i a. Parser i a -> String -> Parser i a
<?> String
"IPv6 prefix"

    p2 :: Int -> Parser [Maybe Word16]
    p2 :: Int -> Parser ByteString IPv6
p2 Int
0 = IPv6
forall a. [a]
l0 IPv6 -> Parser ByteString () -> Parser ByteString IPv6
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ByteString ()
forall t. Chunk t => Parser t ()
endOfInput Parser ByteString IPv6 -> String -> Parser ByteString IPv6
forall i a. Parser i a -> String -> Parser i a
<?> String
"IPv6 suffix: too many segments"
    p2 Int
i = Maybe Word16 -> IPv6 -> IPv6
forall a. a -> [a] -> [a]
l2 (Maybe Word16 -> IPv6 -> IPv6)
-> Parser ByteString ByteString
-> Parser ByteString (Maybe Word16 -> IPv6 -> IPv6)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ByteString ByteString
":" Parser ByteString (Maybe Word16 -> IPv6 -> IPv6)
-> Parser ByteString (Maybe Word16)
-> Parser ByteString (IPv6 -> IPv6)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (Maybe Word16)
h16 Parser ByteString (IPv6 -> IPv6)
-> Parser ByteString IPv6 -> Parser ByteString IPv6
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Parser ByteString IPv6
p2 (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        Parser ByteString IPv6
-> Parser ByteString IPv6 -> Parser ByteString IPv6
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> IPv6
forall a. [a]
l0 IPv6 -> Parser ByteString () -> Parser ByteString IPv6
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ByteString ()
forall t. Chunk t => Parser t ()
endOfInput
        Parser ByteString IPv6 -> String -> Parser ByteString IPv6
forall i a. Parser i a -> String -> Parser i a
<?> String
"IPv6 suffix"

    elision :: Parser (Maybe Word16)
    elision :: Parser ByteString (Maybe Word16)
elision = Maybe Word16
forall a. Maybe a
Nothing Maybe Word16
-> Parser ByteString ByteString -> Parser ByteString (Maybe Word16)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ByteString ByteString
"::"

    h16 :: Parser (Maybe Word16)
    h16 :: Parser ByteString (Maybe Word16)
h16 = Word16 -> Maybe Word16
forall a. a -> Maybe a
Just (Word16 -> Maybe Word16)
-> Parser ByteString Word16 -> Parser ByteString (Maybe Word16)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
        Integer
h <- (Integral Integer, Bits Integer) => Parser Integer
forall a. (Integral a, Bits a) => Parser a
hexadecimal @Integer
        Bool -> Parser ByteString ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser ByteString ()) -> Bool -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ Integer
h Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Word16 -> Integer
forall a b. (Integral a, Num b) => a -> b
int (Bounded Word16 => Word16
forall a. Bounded a => a
maxBound @Word16)
        Word16 -> Parser ByteString Word16
forall (m :: * -> *) a. Monad m => a -> m a
return (Word16 -> Parser ByteString Word16)
-> Word16 -> Parser ByteString Word16
forall a b. (a -> b) -> a -> b
$! Integer -> Word16
forall a b. (Integral a, Num b) => a -> b
int Integer
h
        Parser ByteString (Maybe Word16)
-> String -> Parser ByteString (Maybe Word16)
forall i a. Parser i a -> String -> Parser i a
<?> String
"h16"

    l0 :: [a]
l0 = []
    l1 :: a -> [a]
l1 = a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    l2 :: a -> [a] -> [a]
l2 = (:)
    l3 :: a -> a -> [a] -> [a]
l3 a
a a
b [a]
t = a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:a
ba -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
t

portParser :: Parser Port
portParser :: Parser Port
portParser = Word16 -> Port
Port
    (Word16 -> Port) -> Parser ByteString Word16 -> Parser Port
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Integer
forall a. Integral a => Parser a
decimal Parser Integer
-> (Integer -> Parser ByteString Word16)
-> Parser ByteString Word16
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Integer
d :: Integer) -> Integer -> Word16
forall a b. (Integral a, Num b) => a -> b
int Integer
d Word16 -> Parser ByteString () -> Parser ByteString Word16
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Parser ByteString ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Integer
d Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
2Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
16 :: Int)))
    Parser Port -> String -> Parser Port
forall i a. Parser i a -> String -> Parser i a
<?> String
"port"

parseBytes :: MonadThrow m => T.Text -> Parser a -> B8.ByteString -> m a
parseBytes :: Text -> Parser a -> ByteString -> m a
parseBytes Text
name Parser a
parser ByteString
b = (String -> m a) -> (a -> m a) -> Either String a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (HostAddressParserException -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (HostAddressParserException -> m a)
-> (String -> HostAddressParserException) -> String -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> HostAddressParserException
HostAddressParserException (Text -> HostAddressParserException)
-> (String -> Text) -> String -> HostAddressParserException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
msg) a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
    (Either String a -> m a) -> Either String a -> m a
forall a b. (a -> b) -> a -> b
$ Parser a -> ByteString -> Either String a
forall a. Parser a -> ByteString -> Either String a
parseOnly (Parser a
parser Parser a -> Parser ByteString () -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
endOfInput) ByteString
b
  where
    msg :: String -> Text
msg String
e = Text
"Failed to parse " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
forall a b. (Show a, IsString b) => a -> b
sshow ByteString
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" as " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
e

parseIPv4 :: MonadThrow m => B8.ByteString -> m IPv4
parseIPv4 :: ByteString -> m IPv4
parseIPv4 = Text -> Parser ByteString IPv4 -> ByteString -> m IPv4
forall (m :: * -> *) a.
MonadThrow m =>
Text -> Parser a -> ByteString -> m a
parseBytes Text
"IPv4" (Parser ByteString IPv4
ipV4Parser Parser ByteString IPv4
-> Parser ByteString () -> Parser ByteString IPv4
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
endOfInput)
{-# INLINE parseIPv4 #-}

parseIPv6 :: MonadThrow m => B8.ByteString -> m IPv6
parseIPv6 :: ByteString -> m IPv6
parseIPv6 = Text -> Parser ByteString IPv6 -> ByteString -> m IPv6
forall (m :: * -> *) a.
MonadThrow m =>
Text -> Parser a -> ByteString -> m a
parseBytes Text
"IPv6" (Parser ByteString IPv6
ipV6Parser Parser ByteString IPv6
-> Parser ByteString () -> Parser ByteString IPv6
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
endOfInput)
{-# INLINE parseIPv6 #-}

-- -------------------------------------------------------------------------- --
-- Port Numbers

newtype Port = Port Word16
    deriving (Port -> Port -> Bool
(Port -> Port -> Bool) -> (Port -> Port -> Bool) -> Eq Port
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Port -> Port -> Bool
$c/= :: Port -> Port -> Bool
== :: Port -> Port -> Bool
$c== :: Port -> Port -> Bool
Eq, Eq Port
Eq Port
-> (Port -> Port -> Ordering)
-> (Port -> Port -> Bool)
-> (Port -> Port -> Bool)
-> (Port -> Port -> Bool)
-> (Port -> Port -> Bool)
-> (Port -> Port -> Port)
-> (Port -> Port -> Port)
-> Ord Port
Port -> Port -> Bool
Port -> Port -> Ordering
Port -> Port -> Port
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 :: Port -> Port -> Port
$cmin :: Port -> Port -> Port
max :: Port -> Port -> Port
$cmax :: Port -> Port -> Port
>= :: Port -> Port -> Bool
$c>= :: Port -> Port -> Bool
> :: Port -> Port -> Bool
$c> :: Port -> Port -> Bool
<= :: Port -> Port -> Bool
$c<= :: Port -> Port -> Bool
< :: Port -> Port -> Bool
$c< :: Port -> Port -> Bool
compare :: Port -> Port -> Ordering
$ccompare :: Port -> Port -> Ordering
$cp1Ord :: Eq Port
Ord, (forall x. Port -> Rep Port x)
-> (forall x. Rep Port x -> Port) -> Generic Port
forall x. Rep Port x -> Port
forall x. Port -> Rep Port x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Port x -> Port
$cfrom :: forall x. Port -> Rep Port x
Generic)
    deriving anyclass (Int -> Port -> Int
Port -> Int
(Int -> Port -> Int) -> (Port -> Int) -> Hashable Port
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Port -> Int
$chash :: Port -> Int
hashWithSalt :: Int -> Port -> Int
$chashWithSalt :: Int -> Port -> Int
Hashable, Port -> ()
(Port -> ()) -> NFData Port
forall a. (a -> ()) -> NFData a
rnf :: Port -> ()
$crnf :: Port -> ()
NFData)
    deriving newtype (Int -> Port -> ShowS
[Port] -> ShowS
Port -> String
(Int -> Port -> ShowS)
-> (Port -> String) -> ([Port] -> ShowS) -> Show Port
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Port] -> ShowS
$cshowList :: [Port] -> ShowS
show :: Port -> String
$cshow :: Port -> String
showsPrec :: Int -> Port -> ShowS
$cshowsPrec :: Int -> Port -> ShowS
Show, Num Port
Ord Port
Num Port -> Ord Port -> (Port -> Rational) -> Real Port
Port -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Port -> Rational
$ctoRational :: Port -> Rational
$cp2Real :: Ord Port
$cp1Real :: Num Port
Real, Enum Port
Real Port
Real Port
-> Enum Port
-> (Port -> Port -> Port)
-> (Port -> Port -> Port)
-> (Port -> Port -> Port)
-> (Port -> Port -> Port)
-> (Port -> Port -> (Port, Port))
-> (Port -> Port -> (Port, Port))
-> (Port -> Integer)
-> Integral Port
Port -> Integer
Port -> Port -> (Port, Port)
Port -> Port -> Port
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Port -> Integer
$ctoInteger :: Port -> Integer
divMod :: Port -> Port -> (Port, Port)
$cdivMod :: Port -> Port -> (Port, Port)
quotRem :: Port -> Port -> (Port, Port)
$cquotRem :: Port -> Port -> (Port, Port)
mod :: Port -> Port -> Port
$cmod :: Port -> Port -> Port
div :: Port -> Port -> Port
$cdiv :: Port -> Port -> Port
rem :: Port -> Port -> Port
$crem :: Port -> Port -> Port
quot :: Port -> Port -> Port
$cquot :: Port -> Port -> Port
$cp2Integral :: Enum Port
$cp1Integral :: Real Port
Integral, Integer -> Port
Port -> Port
Port -> Port -> Port
(Port -> Port -> Port)
-> (Port -> Port -> Port)
-> (Port -> Port -> Port)
-> (Port -> Port)
-> (Port -> Port)
-> (Port -> Port)
-> (Integer -> Port)
-> Num Port
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Port
$cfromInteger :: Integer -> Port
signum :: Port -> Port
$csignum :: Port -> Port
abs :: Port -> Port
$cabs :: Port -> Port
negate :: Port -> Port
$cnegate :: Port -> Port
* :: Port -> Port -> Port
$c* :: Port -> Port -> Port
- :: Port -> Port -> Port
$c- :: Port -> Port -> Port
+ :: Port -> Port -> Port
$c+ :: Port -> Port -> Port
Num, Port
Port -> Port -> Bounded Port
forall a. a -> a -> Bounded a
maxBound :: Port
$cmaxBound :: Port
minBound :: Port
$cminBound :: Port
Bounded, Int -> Port
Port -> Int
Port -> [Port]
Port -> Port
Port -> Port -> [Port]
Port -> Port -> Port -> [Port]
(Port -> Port)
-> (Port -> Port)
-> (Int -> Port)
-> (Port -> Int)
-> (Port -> [Port])
-> (Port -> Port -> [Port])
-> (Port -> Port -> [Port])
-> (Port -> Port -> Port -> [Port])
-> Enum Port
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 :: Port -> Port -> Port -> [Port]
$cenumFromThenTo :: Port -> Port -> Port -> [Port]
enumFromTo :: Port -> Port -> [Port]
$cenumFromTo :: Port -> Port -> [Port]
enumFromThen :: Port -> Port -> [Port]
$cenumFromThen :: Port -> Port -> [Port]
enumFrom :: Port -> [Port]
$cenumFrom :: Port -> [Port]
fromEnum :: Port -> Int
$cfromEnum :: Port -> Int
toEnum :: Int -> Port
$ctoEnum :: Int -> Port
pred :: Port -> Port
$cpred :: Port -> Port
succ :: Port -> Port
$csucc :: Port -> Port
Enum)

readPortBytes :: MonadThrow m => B8.ByteString -> m Port
readPortBytes :: ByteString -> m Port
readPortBytes = Text -> Parser Port -> ByteString -> m Port
forall (m :: * -> *) a.
MonadThrow m =>
Text -> Parser a -> ByteString -> m a
parseBytes Text
"port" Parser Port
portParser
{-# INLINE readPortBytes #-}

portToText :: Port -> T.Text
portToText :: Port -> Text
portToText = Port -> Text
forall a b. (Show a, IsString b) => a -> b
sshow
{-# INLINE portToText #-}

portFromText :: MonadThrow m => T.Text -> m Port
portFromText :: Text -> m Port
portFromText = ByteString -> m Port
forall (m :: * -> *). MonadThrow m => ByteString -> m Port
readPortBytes (ByteString -> m Port) -> (Text -> ByteString) -> Text -> m Port
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8
{-# INLINE portFromText #-}

-- -------------------------------------------------------------------------- --
-- Hostnames

data Hostname
    = HostnameName (CI.CI B8.ByteString)
    | HostnameIPv4 (CI.CI B8.ByteString)
    | HostnameIPv6 (CI.CI B8.ByteString)
    deriving (Hostname -> Hostname -> Bool
(Hostname -> Hostname -> Bool)
-> (Hostname -> Hostname -> Bool) -> Eq Hostname
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Hostname -> Hostname -> Bool
$c/= :: Hostname -> Hostname -> Bool
== :: Hostname -> Hostname -> Bool
$c== :: Hostname -> Hostname -> Bool
Eq, Eq Hostname
Eq Hostname
-> (Hostname -> Hostname -> Ordering)
-> (Hostname -> Hostname -> Bool)
-> (Hostname -> Hostname -> Bool)
-> (Hostname -> Hostname -> Bool)
-> (Hostname -> Hostname -> Bool)
-> (Hostname -> Hostname -> Hostname)
-> (Hostname -> Hostname -> Hostname)
-> Ord Hostname
Hostname -> Hostname -> Bool
Hostname -> Hostname -> Ordering
Hostname -> Hostname -> Hostname
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 :: Hostname -> Hostname -> Hostname
$cmin :: Hostname -> Hostname -> Hostname
max :: Hostname -> Hostname -> Hostname
$cmax :: Hostname -> Hostname -> Hostname
>= :: Hostname -> Hostname -> Bool
$c>= :: Hostname -> Hostname -> Bool
> :: Hostname -> Hostname -> Bool
$c> :: Hostname -> Hostname -> Bool
<= :: Hostname -> Hostname -> Bool
$c<= :: Hostname -> Hostname -> Bool
< :: Hostname -> Hostname -> Bool
$c< :: Hostname -> Hostname -> Bool
compare :: Hostname -> Hostname -> Ordering
$ccompare :: Hostname -> Hostname -> Ordering
$cp1Ord :: Eq Hostname
Ord, (forall x. Hostname -> Rep Hostname x)
-> (forall x. Rep Hostname x -> Hostname) -> Generic Hostname
forall x. Rep Hostname x -> Hostname
forall x. Hostname -> Rep Hostname x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Hostname x -> Hostname
$cfrom :: forall x. Hostname -> Rep Hostname x
Generic)
    deriving anyclass (Int -> Hostname -> Int
Hostname -> Int
(Int -> Hostname -> Int) -> (Hostname -> Int) -> Hashable Hostname
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Hostname -> Int
$chash :: Hostname -> Int
hashWithSalt :: Int -> Hostname -> Int
$chashWithSalt :: Int -> Hostname -> Int
Hashable, Hostname -> ()
(Hostname -> ()) -> NFData Hostname
forall a. (a -> ()) -> NFData a
rnf :: Hostname -> ()
$crnf :: Hostname -> ()
NFData)

instance Show Hostname where
    show :: Hostname -> String
show = ByteString -> String
B8.unpack (ByteString -> String)
-> (Hostname -> ByteString) -> Hostname -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hostname -> ByteString
hostnameBytes

readHostnameBytes :: MonadThrow m => B8.ByteString -> m Hostname
readHostnameBytes :: ByteString -> m Hostname
readHostnameBytes ByteString
b = Text -> Parser Hostname -> ByteString -> m Hostname
forall (m :: * -> *) a.
MonadThrow m =>
Text -> Parser a -> ByteString -> m a
parseBytes Text
"hostname" Parser Hostname
parser ByteString
b
  where
    parser :: Parser Hostname
parser = Parser HostType
hostParser Parser HostType -> Parser ByteString () -> Parser HostType
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
endOfInput Parser HostType -> (HostType -> Parser Hostname) -> Parser Hostname
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        HostType
HostTypeName -> Hostname -> Parser Hostname
forall (m :: * -> *) a. Monad m => a -> m a
return (Hostname -> Parser Hostname) -> Hostname -> Parser Hostname
forall a b. (a -> b) -> a -> b
$! CI ByteString -> Hostname
HostnameName (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk ByteString
b)
        HostType
HostTypeIPv4 -> Hostname -> Parser Hostname
forall (m :: * -> *) a. Monad m => a -> m a
return (Hostname -> Parser Hostname) -> Hostname -> Parser Hostname
forall a b. (a -> b) -> a -> b
$! CI ByteString -> Hostname
HostnameIPv4 (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk ByteString
b)
        HostType
HostTypeIPv6 -> Hostname -> Parser Hostname
forall (m :: * -> *) a. Monad m => a -> m a
return (Hostname -> Parser Hostname) -> Hostname -> Parser Hostname
forall a b. (a -> b) -> a -> b
$! CI ByteString -> Hostname
HostnameIPv6 (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk ByteString
b)
{-# INLINE readHostnameBytes #-}

localhost :: Hostname
localhost :: Hostname
localhost = CI ByteString -> Hostname
HostnameName CI ByteString
"localhost"
{-# INLINE localhost #-}

-- | Using explicit IP addresses and not to "localhost" greatly improves
-- networking performance and Mac OS X.
--
localhostIPv4 :: Hostname
localhostIPv4 :: Hostname
localhostIPv4 = CI ByteString -> Hostname
HostnameIPv4 CI ByteString
"127.0.0.1"
{-# INLINE localhostIPv4 #-}

-- | Using explicit IP addresses and not to "localhost" greatly improves
-- networking performance and Mac OS X.
--
localhostIPv6 :: Hostname
localhostIPv6 :: Hostname
localhostIPv6 = CI ByteString -> Hostname
HostnameIPv6 CI ByteString
"::1"
{-# INLINE localhostIPv6 #-}

anyIpv4 :: Hostname
anyIpv4 :: Hostname
anyIpv4 = CI ByteString -> Hostname
HostnameIPv4 CI ByteString
"0.0.0.0"
{-# INLINE anyIpv4 #-}

loopback :: Hostname
loopback :: Hostname
loopback = CI ByteString -> Hostname
HostnameIPv4 CI ByteString
"127.0.0.1"
{-# INLINE loopback #-}

broadcast :: Hostname
broadcast :: Hostname
broadcast = CI ByteString -> Hostname
HostnameIPv4 CI ByteString
"255.255.255.255"
{-# INLINE broadcast #-}

isPrivateHostname :: Hostname -> Bool
isPrivateHostname :: Hostname -> Bool
isPrivateHostname (HostnameIPv4 CI ByteString
ip) = IPv4 -> Bool
isPrivateIp (String -> IPv4
forall a. Read a => String -> a
read (String -> IPv4) -> String -> IPv4
forall a b. (a -> b) -> a -> b
$ ByteString -> String
B8.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ CI ByteString -> ByteString
forall s. CI s -> s
CI.original CI ByteString
ip)
isPrivateHostname Hostname
h
    | Hostname
h Hostname -> Hostname -> Bool
forall a. Eq a => a -> a -> Bool
== Hostname
localhost = Bool
True
    | Hostname
h Hostname -> Hostname -> Bool
forall a. Eq a => a -> a -> Bool
== Hostname
localhostIPv4 = Bool
True
    | Hostname
h Hostname -> Hostname -> Bool
forall a. Eq a => a -> a -> Bool
== Hostname
localhostIPv6 = Bool
True
    | Bool
otherwise = Bool
False

isReservedHostname :: Hostname -> Bool
isReservedHostname :: Hostname -> Bool
isReservedHostname (HostnameIPv4 CI ByteString
ip) = IPv4 -> Bool
isReservedIp (String -> IPv4
forall a. Read a => String -> a
read (String -> IPv4) -> String -> IPv4
forall a b. (a -> b) -> a -> b
$ ByteString -> String
B8.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ CI ByteString -> ByteString
forall s. CI s -> s
CI.original CI ByteString
ip)
isReservedHostname Hostname
h = Hostname -> Bool
isPrivateHostname Hostname
h

ip2ip :: IPv4 -> IP.IPv4
ip2ip :: IPv4 -> IPv4
ip2ip (Word8
i0, Word8
i1, Word8
i2, Word8
i3) = [Int] -> IPv4
toIPv4 ([Int] -> IPv4) -> [Int] -> IPv4
forall a b. (a -> b) -> a -> b
$ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
int (Word8 -> Int) -> [Word8] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Word8
i0, Word8
i1, Word8
i2, Word8
i3]
{-# INLINE ip2ip #-}

isLocalIp :: IPv4 -> Bool
isLocalIp :: IPv4 -> Bool
isLocalIp IPv4
i =
    IPv4 -> AddrRange IPv4 -> Bool
forall a. Addr a => a -> AddrRange a -> Bool
isMatchedTo IPv4
ip (AddrRange IPv4 -> Bool) -> AddrRange IPv4 -> Bool
forall a b. (a -> b) -> a -> b
$ IPv4 -> Int -> AddrRange IPv4
forall a. Addr a => a -> Int -> AddrRange a
makeAddrRange ([Int] -> IPv4
toIPv4 [Int
127,Int
0,Int
0,Int
0]) Int
8
  where
    ip :: IPv4
ip = IPv4 -> IPv4
ip2ip IPv4
i

isPrivateIp :: IPv4 -> Bool
isPrivateIp :: IPv4 -> Bool
isPrivateIp IPv4
i = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or
    [ IPv4 -> AddrRange IPv4 -> Bool
forall a. Addr a => a -> AddrRange a -> Bool
isMatchedTo IPv4
ip (AddrRange IPv4 -> Bool) -> AddrRange IPv4 -> Bool
forall a b. (a -> b) -> a -> b
$ IPv4 -> Int -> AddrRange IPv4
forall a. Addr a => a -> Int -> AddrRange a
makeAddrRange ([Int] -> IPv4
toIPv4 [Int
10,Int
0,Int
0,Int
0]) Int
8
    , IPv4 -> AddrRange IPv4 -> Bool
forall a. Addr a => a -> AddrRange a -> Bool
isMatchedTo IPv4
ip (AddrRange IPv4 -> Bool) -> AddrRange IPv4 -> Bool
forall a b. (a -> b) -> a -> b
$ IPv4 -> Int -> AddrRange IPv4
forall a. Addr a => a -> Int -> AddrRange a
makeAddrRange ([Int] -> IPv4
toIPv4 [Int
172,Int
16,Int
0,Int
0]) Int
12
    , IPv4 -> AddrRange IPv4 -> Bool
forall a. Addr a => a -> AddrRange a -> Bool
isMatchedTo IPv4
ip (AddrRange IPv4 -> Bool) -> AddrRange IPv4 -> Bool
forall a b. (a -> b) -> a -> b
$ IPv4 -> Int -> AddrRange IPv4
forall a. Addr a => a -> Int -> AddrRange a
makeAddrRange ([Int] -> IPv4
toIPv4 [Int
192,Int
168,Int
0,Int
0]) Int
16
    ]
  where
    ip :: IPv4
ip = IPv4 -> IPv4
ip2ip IPv4
i

isReservedIp :: IPv4 -> Bool
isReservedIp :: IPv4 -> Bool
isReservedIp IPv4
i = IPv4 -> Bool
isLocalIp IPv4
i Bool -> Bool -> Bool
|| IPv4 -> Bool
isPrivateIp IPv4
i Bool -> Bool -> Bool
|| [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or
    [ IPv4 -> AddrRange IPv4 -> Bool
forall a. Addr a => a -> AddrRange a -> Bool
isMatchedTo IPv4
ip (AddrRange IPv4 -> Bool) -> AddrRange IPv4 -> Bool
forall a b. (a -> b) -> a -> b
$ IPv4 -> Int -> AddrRange IPv4
forall a. Addr a => a -> Int -> AddrRange a
makeAddrRange ([Int] -> IPv4
toIPv4 [Int
0,Int
0,Int
0,Int
0]) Int
8
    , IPv4 -> AddrRange IPv4 -> Bool
forall a. Addr a => a -> AddrRange a -> Bool
isMatchedTo IPv4
ip (AddrRange IPv4 -> Bool) -> AddrRange IPv4 -> Bool
forall a b. (a -> b) -> a -> b
$ IPv4 -> Int -> AddrRange IPv4
forall a. Addr a => a -> Int -> AddrRange a
makeAddrRange ([Int] -> IPv4
toIPv4 [Int
100,Int
64,Int
0,Int
0]) Int
10
    , IPv4 -> AddrRange IPv4 -> Bool
forall a. Addr a => a -> AddrRange a -> Bool
isMatchedTo IPv4
ip (AddrRange IPv4 -> Bool) -> AddrRange IPv4 -> Bool
forall a b. (a -> b) -> a -> b
$ IPv4 -> Int -> AddrRange IPv4
forall a. Addr a => a -> Int -> AddrRange a
makeAddrRange ([Int] -> IPv4
toIPv4 [Int
169,Int
254,Int
0,Int
0]) Int
16
    , IPv4 -> AddrRange IPv4 -> Bool
forall a. Addr a => a -> AddrRange a -> Bool
isMatchedTo IPv4
ip (AddrRange IPv4 -> Bool) -> AddrRange IPv4 -> Bool
forall a b. (a -> b) -> a -> b
$ IPv4 -> Int -> AddrRange IPv4
forall a. Addr a => a -> Int -> AddrRange a
makeAddrRange ([Int] -> IPv4
toIPv4 [Int
192,Int
0,Int
0,Int
0]) Int
24
    , IPv4 -> AddrRange IPv4 -> Bool
forall a. Addr a => a -> AddrRange a -> Bool
isMatchedTo IPv4
ip (AddrRange IPv4 -> Bool) -> AddrRange IPv4 -> Bool
forall a b. (a -> b) -> a -> b
$ IPv4 -> Int -> AddrRange IPv4
forall a. Addr a => a -> Int -> AddrRange a
makeAddrRange ([Int] -> IPv4
toIPv4 [Int
192,Int
0,Int
2,Int
0]) Int
24
    , IPv4 -> AddrRange IPv4 -> Bool
forall a. Addr a => a -> AddrRange a -> Bool
isMatchedTo IPv4
ip (AddrRange IPv4 -> Bool) -> AddrRange IPv4 -> Bool
forall a b. (a -> b) -> a -> b
$ IPv4 -> Int -> AddrRange IPv4
forall a. Addr a => a -> Int -> AddrRange a
makeAddrRange ([Int] -> IPv4
toIPv4 [Int
192,Int
88,Int
99,Int
0]) Int
24
    , IPv4 -> AddrRange IPv4 -> Bool
forall a. Addr a => a -> AddrRange a -> Bool
isMatchedTo IPv4
ip (AddrRange IPv4 -> Bool) -> AddrRange IPv4 -> Bool
forall a b. (a -> b) -> a -> b
$ IPv4 -> Int -> AddrRange IPv4
forall a. Addr a => a -> Int -> AddrRange a
makeAddrRange ([Int] -> IPv4
toIPv4 [Int
192,Int
18,Int
0,Int
0]) Int
15
    , IPv4 -> AddrRange IPv4 -> Bool
forall a. Addr a => a -> AddrRange a -> Bool
isMatchedTo IPv4
ip (AddrRange IPv4 -> Bool) -> AddrRange IPv4 -> Bool
forall a b. (a -> b) -> a -> b
$ IPv4 -> Int -> AddrRange IPv4
forall a. Addr a => a -> Int -> AddrRange a
makeAddrRange ([Int] -> IPv4
toIPv4 [Int
198,Int
51,Int
100,Int
0]) Int
24
    , IPv4 -> AddrRange IPv4 -> Bool
forall a. Addr a => a -> AddrRange a -> Bool
isMatchedTo IPv4
ip (AddrRange IPv4 -> Bool) -> AddrRange IPv4 -> Bool
forall a b. (a -> b) -> a -> b
$ IPv4 -> Int -> AddrRange IPv4
forall a. Addr a => a -> Int -> AddrRange a
makeAddrRange ([Int] -> IPv4
toIPv4 [Int
203,Int
0,Int
113,Int
0]) Int
24
    , IPv4 -> AddrRange IPv4 -> Bool
forall a. Addr a => a -> AddrRange a -> Bool
isMatchedTo IPv4
ip (AddrRange IPv4 -> Bool) -> AddrRange IPv4 -> Bool
forall a b. (a -> b) -> a -> b
$ IPv4 -> Int -> AddrRange IPv4
forall a. Addr a => a -> Int -> AddrRange a
makeAddrRange ([Int] -> IPv4
toIPv4 [Int
224,Int
0,Int
0,Int
0]) Int
4
    , IPv4 -> AddrRange IPv4 -> Bool
forall a. Addr a => a -> AddrRange a -> Bool
isMatchedTo IPv4
ip (AddrRange IPv4 -> Bool) -> AddrRange IPv4 -> Bool
forall a b. (a -> b) -> a -> b
$ IPv4 -> Int -> AddrRange IPv4
forall a. Addr a => a -> Int -> AddrRange a
makeAddrRange ([Int] -> IPv4
toIPv4 [Int
240,Int
0,Int
0,Int
0]) Int
4
    , IPv4 -> AddrRange IPv4 -> Bool
forall a. Addr a => a -> AddrRange a -> Bool
isMatchedTo IPv4
ip (AddrRange IPv4 -> Bool) -> AddrRange IPv4 -> Bool
forall a b. (a -> b) -> a -> b
$ IPv4 -> Int -> AddrRange IPv4
forall a. Addr a => a -> Int -> AddrRange a
makeAddrRange ([Int] -> IPv4
toIPv4 [Int
255,Int
255,Int
255,Int
255]) Int
32
    ]
  where
    ip :: IPv4
ip = IPv4 -> IPv4
ip2ip IPv4
i

hostnameBytes :: Hostname -> B8.ByteString
hostnameBytes :: Hostname -> ByteString
hostnameBytes (HostnameName CI ByteString
b) = CI ByteString -> ByteString
forall s. CI s -> s
CI.original CI ByteString
b
hostnameBytes (HostnameIPv4 CI ByteString
b) = CI ByteString -> ByteString
forall s. CI s -> s
CI.original CI ByteString
b
hostnameBytes (HostnameIPv6 CI ByteString
b) = CI ByteString -> ByteString
forall s. CI s -> s
CI.original CI ByteString
b
{-# INLINE hostnameBytes #-}

hostnameToText :: Hostname -> T.Text
hostnameToText :: Hostname -> Text
hostnameToText = ByteString -> Text
T.decodeUtf8 (ByteString -> Text)
-> (Hostname -> ByteString) -> Hostname -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hostname -> ByteString
hostnameBytes
{-# INLINE hostnameToText #-}

hostnameFromText :: MonadThrow m => T.Text -> m Hostname
hostnameFromText :: Text -> m Hostname
hostnameFromText = ByteString -> m Hostname
forall (m :: * -> *). MonadThrow m => ByteString -> m Hostname
readHostnameBytes (ByteString -> m Hostname)
-> (Text -> ByteString) -> Text -> m Hostname
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8
{-# INLINE hostnameFromText #-}

unsafeHostnameFromText :: HasCallStack => T.Text -> Hostname
unsafeHostnameFromText :: Text -> Hostname
unsafeHostnameFromText = Maybe Hostname -> Hostname
forall a. HasCallStack => Maybe a -> a
fromJuste (Maybe Hostname -> Hostname)
-> (Text -> Maybe Hostname) -> Text -> Hostname
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Hostname
forall (m :: * -> *). MonadThrow m => Text -> m Hostname
hostnameFromText
{-# INLINE unsafeHostnameFromText #-}

-- -------------------------------------------------------------------------- --
-- Hostname Pattern Synonyms

pattern HostName :: CI.CI B8.ByteString -> Hostname
pattern $mHostName :: forall r. Hostname -> (CI ByteString -> r) -> (Void# -> r) -> r
HostName n <- HostnameName n

pattern HostIPv4 :: IPv4 -> Hostname
pattern $bHostIPv4 :: IPv4 -> Hostname
$mHostIPv4 :: forall r. Hostname -> (IPv4 -> r) -> (Void# -> r) -> r
HostIPv4 i <- (viewIPv4 -> Just i)
  where
    HostIPv4 IPv4
i = CI ByteString -> Hostname
HostnameIPv4 (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk (ByteString -> CI ByteString) -> ByteString -> CI ByteString
forall a b. (a -> b) -> a -> b
$ IPv4 -> ByteString
forall a b. (Show a, IsString b) => a -> b
sshow IPv4
i)

pattern HostIPv6 :: IPv6 -> Hostname
pattern $bHostIPv6 :: IPv6 -> Hostname
$mHostIPv6 :: forall r. Hostname -> (IPv6 -> r) -> (Void# -> r) -> r
HostIPv6 i <- (viewIPv6 -> Just i)
  where
    HostIPv6 IPv6
i = CI ByteString -> Hostname
HostnameIPv6 (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk (ByteString -> CI ByteString) -> ByteString -> CI ByteString
forall a b. (a -> b) -> a -> b
$ IPv6 -> ByteString
forall a b. (Show a, IsString b) => a -> b
sshow IPv6
i)

{-# COMPLETE HostIPv4, HostIPv6, HostName #-}

viewIPv4 :: Hostname -> Maybe IPv4
viewIPv4 :: Hostname -> Maybe IPv4
viewIPv4 (HostnameIPv4 CI ByteString
bytes) = ByteString -> Maybe IPv4
forall (m :: * -> *). MonadThrow m => ByteString -> m IPv4
parseIPv4 (ByteString -> Maybe IPv4) -> ByteString -> Maybe IPv4
forall a b. (a -> b) -> a -> b
$ CI ByteString -> ByteString
forall s. CI s -> s
CI.original CI ByteString
bytes
viewIPv4 Hostname
_ = Maybe IPv4
forall a. Maybe a
Nothing

viewIPv6 :: Hostname -> Maybe IPv6
viewIPv6 :: Hostname -> Maybe IPv6
viewIPv6 (HostnameIPv6 CI ByteString
bytes) = ByteString -> Maybe IPv6
forall (m :: * -> *). MonadThrow m => ByteString -> m IPv6
parseIPv6 (ByteString -> Maybe IPv6) -> ByteString -> Maybe IPv6
forall a b. (a -> b) -> a -> b
$ CI ByteString -> ByteString
forall s. CI s -> s
CI.original CI ByteString
bytes
viewIPv6 Hostname
_ = Maybe IPv6
forall a. Maybe a
Nothing

-- -------------------------------------------------------------------------- --
-- Host Addresses

data HostAddress = HostAddress
    { HostAddress -> Hostname
_hostAddressHost :: !Hostname
    , HostAddress -> Port
_hostAddressPort :: !Port
    }
    deriving (Int -> HostAddress -> ShowS
[HostAddress] -> ShowS
HostAddress -> String
(Int -> HostAddress -> ShowS)
-> (HostAddress -> String)
-> ([HostAddress] -> ShowS)
-> Show HostAddress
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HostAddress] -> ShowS
$cshowList :: [HostAddress] -> ShowS
show :: HostAddress -> String
$cshow :: HostAddress -> String
showsPrec :: Int -> HostAddress -> ShowS
$cshowsPrec :: Int -> HostAddress -> ShowS
Show, HostAddress -> HostAddress -> Bool
(HostAddress -> HostAddress -> Bool)
-> (HostAddress -> HostAddress -> Bool) -> Eq HostAddress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HostAddress -> HostAddress -> Bool
$c/= :: HostAddress -> HostAddress -> Bool
== :: HostAddress -> HostAddress -> Bool
$c== :: HostAddress -> HostAddress -> Bool
Eq, Eq HostAddress
Eq HostAddress
-> (HostAddress -> HostAddress -> Ordering)
-> (HostAddress -> HostAddress -> Bool)
-> (HostAddress -> HostAddress -> Bool)
-> (HostAddress -> HostAddress -> Bool)
-> (HostAddress -> HostAddress -> Bool)
-> (HostAddress -> HostAddress -> HostAddress)
-> (HostAddress -> HostAddress -> HostAddress)
-> Ord HostAddress
HostAddress -> HostAddress -> Bool
HostAddress -> HostAddress -> Ordering
HostAddress -> HostAddress -> HostAddress
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 :: HostAddress -> HostAddress -> HostAddress
$cmin :: HostAddress -> HostAddress -> HostAddress
max :: HostAddress -> HostAddress -> HostAddress
$cmax :: HostAddress -> HostAddress -> HostAddress
>= :: HostAddress -> HostAddress -> Bool
$c>= :: HostAddress -> HostAddress -> Bool
> :: HostAddress -> HostAddress -> Bool
$c> :: HostAddress -> HostAddress -> Bool
<= :: HostAddress -> HostAddress -> Bool
$c<= :: HostAddress -> HostAddress -> Bool
< :: HostAddress -> HostAddress -> Bool
$c< :: HostAddress -> HostAddress -> Bool
compare :: HostAddress -> HostAddress -> Ordering
$ccompare :: HostAddress -> HostAddress -> Ordering
$cp1Ord :: Eq HostAddress
Ord, (forall x. HostAddress -> Rep HostAddress x)
-> (forall x. Rep HostAddress x -> HostAddress)
-> Generic HostAddress
forall x. Rep HostAddress x -> HostAddress
forall x. HostAddress -> Rep HostAddress x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HostAddress x -> HostAddress
$cfrom :: forall x. HostAddress -> Rep HostAddress x
Generic)
    deriving anyclass (Int -> HostAddress -> Int
HostAddress -> Int
(Int -> HostAddress -> Int)
-> (HostAddress -> Int) -> Hashable HostAddress
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: HostAddress -> Int
$chash :: HostAddress -> Int
hashWithSalt :: Int -> HostAddress -> Int
$chashWithSalt :: Int -> HostAddress -> Int
Hashable, HostAddress -> ()
(HostAddress -> ()) -> NFData HostAddress
forall a. (a -> ()) -> NFData a
rnf :: HostAddress -> ()
$crnf :: HostAddress -> ()
NFData)

makeLenses ''HostAddress

hostAddressBytes :: HostAddress -> B8.ByteString
hostAddressBytes :: HostAddress -> ByteString
hostAddressBytes HostAddress
a = ByteString
host ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
":" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Port -> ByteString
forall a b. (Show a, IsString b) => a -> b
sshow (HostAddress -> Port
_hostAddressPort HostAddress
a)
  where
    ha :: Hostname
ha = HostAddress -> Hostname
_hostAddressHost HostAddress
a
    host :: ByteString
host = case Hostname
ha of
        HostnameIPv6 CI ByteString
_ -> ByteString
"[" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Hostname -> ByteString
hostnameBytes Hostname
ha ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"]"
        Hostname
_ -> Hostname -> ByteString
hostnameBytes Hostname
ha
{-# INLINE hostAddressBytes #-}

readHostAddressBytes :: MonadThrow m => B8.ByteString -> m HostAddress
readHostAddressBytes :: ByteString -> m HostAddress
readHostAddressBytes ByteString
bytes = Text -> Parser HostAddress -> ByteString -> m HostAddress
forall (m :: * -> *) a.
MonadThrow m =>
Text -> Parser a -> ByteString -> m a
parseBytes Text
"hostaddress" (ByteString -> Parser HostAddress
hostAddressParser ByteString
bytes) ByteString
bytes

-- | Parser a host address. The input bytestring isn't used for parsing but for
-- the constructing the reslt HostAddress.
--
hostAddressParser :: B8.ByteString -> Parser HostAddress
hostAddressParser :: ByteString -> Parser HostAddress
hostAddressParser ByteString
b = Hostname -> Port -> HostAddress
HostAddress
    (Hostname -> Port -> HostAddress)
-> Parser Hostname -> Parser ByteString (Port -> HostAddress)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Hostname
hostnameParser'
    Parser ByteString (Port -> HostAddress)
-> Parser ByteString ByteString
-> Parser ByteString (Port -> HostAddress)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ByteString
":"
    Parser ByteString (Port -> HostAddress)
-> Parser Port -> Parser HostAddress
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Port
portParser
  where
    host :: ByteString
host = ByteString -> ByteString
B8.init (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, ByteString) -> ByteString)
-> (ByteString, ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ByteString -> (ByteString, ByteString)
B8.breakEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') ByteString
b
    hostnameParser' :: Parser Hostname
hostnameParser'
        = CI ByteString -> Hostname
HostnameName (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk ByteString
host) Hostname -> Parser ByteString () -> Parser Hostname
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ByteString ()
hostNameParser
        Parser Hostname -> Parser Hostname -> Parser Hostname
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CI ByteString -> Hostname
HostnameIPv4 (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk ByteString
host) Hostname -> Parser ByteString IPv4 -> Parser Hostname
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ByteString IPv4
ipV4Parser
        Parser Hostname -> Parser Hostname -> Parser Hostname
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CI ByteString -> Hostname
HostnameIPv6 (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk (ByteString -> CI ByteString) -> ByteString -> CI ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B8.init (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B8.tail ByteString
host) Hostname -> Parser ByteString ByteString -> Parser Hostname
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ByteString ByteString
"[" Parser Hostname -> Parser ByteString IPv6 -> Parser Hostname
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString IPv6
ipV6Parser Parser Hostname -> Parser ByteString ByteString -> Parser Hostname
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ByteString
"]"
        Parser Hostname -> String -> Parser Hostname
forall i a. Parser i a -> String -> Parser i a
<?> String
"host"

hostAddressToText :: HostAddress -> T.Text
hostAddressToText :: HostAddress -> Text
hostAddressToText = ByteString -> Text
T.decodeUtf8 (ByteString -> Text)
-> (HostAddress -> ByteString) -> HostAddress -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HostAddress -> ByteString
hostAddressBytes
{-# INLINE hostAddressToText #-}

hostAddressFromText :: MonadThrow m => T.Text -> m HostAddress
hostAddressFromText :: Text -> m HostAddress
hostAddressFromText = ByteString -> m HostAddress
forall (m :: * -> *). MonadThrow m => ByteString -> m HostAddress
readHostAddressBytes (ByteString -> m HostAddress)
-> (Text -> ByteString) -> Text -> m HostAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8
{-# INLINE hostAddressFromText #-}

unsafeHostAddressFromText :: HasCallStack => T.Text -> HostAddress
unsafeHostAddressFromText :: Text -> HostAddress
unsafeHostAddressFromText = Maybe HostAddress -> HostAddress
forall a. HasCallStack => Maybe a -> a
fromJuste (Maybe HostAddress -> HostAddress)
-> (Text -> Maybe HostAddress) -> Text -> HostAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe HostAddress
forall (m :: * -> *). MonadThrow m => Text -> m HostAddress
hostAddressFromText
{-# INLINE unsafeHostAddressFromText #-}

isPrivateHostAddress :: HostAddress -> Bool
isPrivateHostAddress :: HostAddress -> Bool
isPrivateHostAddress (HostAddress Hostname
n Port
_) = Hostname -> Bool
isPrivateHostname Hostname
n
{-# INLINE isPrivateHostAddress #-}

isReservedHostAddress :: HostAddress -> Bool
isReservedHostAddress :: HostAddress -> Bool
isReservedHostAddress (HostAddress Hostname
n Port
_) = Hostname -> Bool
isReservedHostname Hostname
n
{-# INLINE isReservedHostAddress #-}

#ifdef VERSION_aeson
-- -------------------------------------------------------------------------- --
-- Aeson Instances

eitherFromText
    :: (T.Text -> Either SomeException a)
    -> T.Text
    -> Either String a
eitherFromText p = either f return . p
  where
    f e = Left $ case fromException e of
        Just (HostAddressParserException err) -> T.unpack err
        _ -> displayException e
{-# INLINE eitherFromText #-}

deriving newtype instance ToJSON Port
deriving newtype instance FromJSON Port

instance ToJSON HostAddress where
    toJSON o = object
        [ "hostname" .= _hostAddressHost o
        , "port" .= _hostAddressPort o
        ]
    {-# INLINE toJSON #-}

instance FromJSON HostAddress where
    parseJSON = withObject "HostAddress" $ \o -> HostAddress
        <$> o .: "hostname"
        <*> o .: "port"
    {-# INLINE parseJSON #-}

instance ToJSON Hostname where
    toJSON = toJSON . hostnameToText
    {-# INLINE toJSON #-}

instance FromJSON Hostname where
    parseJSON = withText "Hostname"
        $! either fail return . eitherFromText hostnameFromText
    {-# INLINE parseJSON #-}

#endif

#ifdef VERSION_configuration_tools
-- -------------------------------------------------------------------------- --
-- Configuration Tools Support

prefixLong :: HasName f => Maybe String -> String -> Mod f a
prefixLong prefix l = long $ maybe "" (<> "-") prefix <> l

suffixHelp :: Maybe String -> String -> Mod f a
suffixHelp suffix l = help $ l <> maybe "" (" for " <>) suffix

textReader :: (T.Text -> Either SomeException a) -> ReadM a
textReader p = eitherReader $ first show . p . T.pack
{-# INLINE textReader #-}

-- | Simple options parser for Port
--
pPort :: Maybe String -> O.Parser Port
pPort service = O.option (textReader portFromText)
    % prefixLong service "port"
    <> suffixHelp service "port number"
{-# INLINE pPort #-}

-- | Simpe option parser for Hostname
--
pHostname :: Maybe String -> O.Parser Hostname
pHostname service = O.option (textReader hostnameFromText)
    % prefixLong service "hostname"
    <> suffixHelp service "hostname"
{-# INLINE pHostname #-}

instance FromJSON (HostAddress -> HostAddress) where
    parseJSON = withObject "HostAddress" $ \o -> id
        <$< hostAddressHost ..: "hostname" % o
        <*< hostAddressPort ..: "port" % o
    {-# INLINE parseJSON #-}

-- | Configuration tools option parser for HostAddress
--
pHostAddress :: Maybe String -> MParser HostAddress
pHostAddress service = id
    <$< hostAddressHost .:: pHostname service
    <*< hostAddressPort .:: pPort service

-- | Simple Option parser for HostAddress
--
pHostAddress' :: Maybe String -> O.Parser HostAddress
pHostAddress' service = HostAddress <$> pHostname service <*> pPort service

#endif

#ifdef VERSION_QuickCheck
-- -------------------------------------------------------------------------- --
-- Arbitrary Values

-- TODO should we exclude network, broadcast, otherwise special values?

-- | Arbitary IPv4 addresses
--
arbitraryIpV4 :: Gen Hostname
arbitraryIpV4 = HostnameIPv4 . CI.mk . B8.intercalate "." . fmap sshow
    <$> replicateM 4 (arbitrary :: Gen Word8)

-- | Arbitary IPv6 addresses
--
arbitraryIpV6 :: Gen Hostname
arbitraryIpV6 = HostnameIPv6 . CI.mk . B8.intercalate ":" . fmap sshow
    <$> replicateM 8 (arbitrary :: Gen Word8)

-- | Arbitary domain names
--
arbitraryDomainName :: Gen Hostname
arbitraryDomainName = sized $ \n -> resize (min n 254)
    . fmap (HostnameName . mconcat . L.intersperse ".")
    $ (<>)
        <$> listOf (arbitraryDomainLabel False)
        <*> vectorOf 1 (arbitraryDomainLabel True)

-- TODO add frequency or used sized to yield a better distribution

-- | Arbitary domain labels
--
arbitraryDomainLabel :: Bool -> Gen (CI.CI B8.ByteString)
arbitraryDomainLabel isTop = sized $ \n -> resize (min n 63)
    $ CI.mk . B8.pack <$> oneof
        [ vectorOf 1 (if isTop then letter else letterOrDigit)
        , foldM (\l a -> (l <>) <$> a) []
            [ vectorOf 1 (if isTop then letter else letterOrDigit)
            , listOf letterOrDigitOrHyphen
            , vectorOf 1 letterOrDigit
            ]
        ]
  where
    letter = elements $ ['a'..'z'] <> ['A'..'Z']
    letterOrDigit = elements $ ['a'..'z'] <> ['A'..'Z'] <> ['0'..'9']
    letterOrDigitOrHyphen = elements $ ['a'..'z'] <> ['A'..'Z'] <> ['-']

-- | Arbitrary port numbers
--
arbitraryPort :: Gen Port
arbitraryPort = Port <$> arbitrary

instance Arbitrary Port where
    arbitrary = arbitraryPort

-- | Arbitrary host names
--
arbitraryHostname :: Gen Hostname
arbitraryHostname = oneof
    [ arbitraryIpV4
    , arbitraryIpV4
    , arbitraryDomainName
        --  Note that not every valid domain name is also a valid host name.
        --  Generally, a hostname has at least one associated IP address.
        --  Also, syntactic restriction apply for certain top-level domains.
    , pure (HostnameName "localhost")
    , pure localhost
    ]

instance Arbitrary Hostname where
    arbitrary = arbitraryHostname

-- | Arbitrary host adresses
--
arbitraryHostAddress :: Gen HostAddress
arbitraryHostAddress = HostAddress <$> arbitrary <*> arbitrary

instance Arbitrary HostAddress where
    arbitrary = arbitraryHostAddress

-- -------------------------------------------------------------------------- --
-- Properties

prop_readHostAddressBytes :: HostAddress -> Property
prop_readHostAddressBytes a = readHostAddressBytes (hostAddressBytes a) === Just a

prop_readHostnameBytes :: Hostname -> Property
prop_readHostnameBytes h = readHostnameBytes (hostnameBytes h) === Just h

properties :: [(String, Property)]
properties =
    [ ("readHostnameBytes", property prop_readHostnameBytes)
    , ("readHostAddressBytes", property prop_readHostAddressBytes)
    ]
#endif