hostaddress (empty) → 0.1.0.0
raw patch · 5 files changed
+810/−0 lines, 5 filesdep +QuickCheckdep +aesondep +attoparsec
Dependencies added: QuickCheck, aeson, attoparsec, base, bytestring, case-insensitive, configuration-tools, deepseq, exceptions, hashable, iproute, microlens-th, optparse-applicative, text
Files
- CHANGELOG.md +5/−0
- LICENSE +20/−0
- README.md +34/−0
- hostaddress.cabal +79/−0
- src/Network/HostAddress.hs +672/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for hostaddress++## 0.1.0.0 -- 2020-02-12++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2020, Lars Kuhtz <lakuhtz@gmail.com>++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,34 @@+++# Haskell Tools for Host Addresses++This package implements 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).++# Build from Source++```sh+cabal v2-build+```++The following optional build flags are available:++* `-fwith-aeson`: build `ToJSON` and `FromJSON` instance for use with+ [aeson](https://hackage.haskell.org/package/aeson).++* `-fwith-configuration-tools`: build instances and functions for supporting+ the use with+ [configuration-tools](https://hackage.haskell.org/package/configuration-tools).++* `-fwith-quickcheck`: include function for generating arbitrary values and+ `Arbitrary` instance for use with+ [QuickCheck](https://hackage.haskell.org/package/QuickCheck).++# Documentation++Documentation is available at [https://hackage.haskell.org/package/hostaddress/]().
+ hostaddress.cabal view
@@ -0,0 +1,79 @@+cabal-version: 2.2+name: hostaddress+version: 0.1.0.0+synopsis: Network Host Addresses+description:+ 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).++homepage: https://github.com/larskuhtz/hostaddress+bug-reports: https://github.com/larskuhtz/hostaddress/issues+license: MIT+license-file: LICENSE+author: Lars Kuhtz+maintainer: Lars Kuhtz <lakuhtz@gmail.com>+copyright: Copyright (c) 2020, Lars Kuhtz <lakuhtz@gmail.com>+category: Data+tested-with:+ GHC==8.6.5+ , GHC==8.8.2+extra-source-files:+ README.md+ CHANGELOG.md++source-repository head+ type: git+ location: https://github.com/larskuhtz/hostaddress.git++flag with-configuration-tools+ description: add support functions and instances for configuration-tools+ default: False+ manual: True++flag with-aeson+ description: generate ToJSON and FromJSON instances+ default: False+ manual: True++flag with-quickcheck+ description: include functions for generating arbitrary values and generate Arbitrary instances+ default: False+ manual: True++library+ hs-source-dirs: src+ default-language: Haskell2010+ ghc-options:+ -Wall+ exposed-modules:+ Network.HostAddress+ build-depends:+ base >=4.10 && <4.15+ , bytestring >=0.10+ , deepseq >=1.4+ , text >=1.2+ , hashable >=1.3+ , case-insensitive >=1.2+ , microlens-th >=0.4+ , exceptions >=0.10+ , attoparsec >=0.13+ , iproute >=1.7++ if flag(with-aeson)+ build-depends:+ aeson >=1.4++ if flag(with-configuration-tools)+ build-depends:+ configuration-tools >=0.4+ , optparse-applicative >=0.15+ , aeson >=1.4++ if flag(with-quickcheck)+ build-depends:+ QuickCheck >=2.13+
+ src/Network/HostAddress.hs view
@@ -0,0 +1,672 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}++#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++-- ** 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+#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 = fromString . show+{-# INLINE sshow #-}++fromJuste :: HasCallStack => Maybe a -> a+fromJuste = fromJust+{-# INLINE fromJuste #-}++int :: Integral a => Num b => a -> b+int = fromIntegral+{-# INLINE int #-}++newtype HostAddressParserException = HostAddressParserException T.Text+ deriving (Show, Eq, Ord, Generic)+ deriving anyclass (Hashable)+ deriving newtype (NFData)++instance Exception HostAddressParserException++-- -------------------------------------------------------------------------- --+-- Internal Parsers++data HostType = HostTypeName | HostTypeIPv4 | HostTypeIPv6+ deriving (Show, Eq, Ord, Generic, Hashable)++hostParser :: Parser HostType+hostParser+ = HostTypeName <$ hostNameParser+ <|> HostTypeIPv4 <$ ipV4Parser+ <|> HostTypeIPv6 <$ ipV6Parser+ <?> "host"++hostNameParser :: Parser ()+hostNameParser = ()+ <$ many' (domainlabel <* ".") <* toplabel+ <?> "hostname"+ where+ domainlabel = ()+ <$ alphanum <* optional labelTail+ <?> "domainlabel"++ toplabel = ()+ <$ alpha <* optional labelTail+ <?> "toplabel"++ labelTail = alphanumhyphen >>= \case+ '-' -> labelTail+ _ -> () <$ optional labelTail++ alpha = satisfy isAlpha_ascii+ <?> "alpha"++ alphanum = satisfy (\c -> isAlpha_ascii c || isDigit c)+ <?> "alphanum"++ alphanumhyphen = satisfy (\c -> isAlpha_ascii c || isDigit c || c == '-')+ <?> "alphahumhypen"++ipV4Parser :: Parser (Word8, Word8, Word8, Word8)+ipV4Parser = (,,,)+ <$> (octet <* ".") <*> (octet <* ".") <*> (octet <* ".") <*> octet+ <?> "ipv4address"+ where+ octet :: Parser Word8+ octet = (decimal >>= \(d :: Integer) -> int d <$ guard (d < 256))+ <?> "octet"++ipV6Parser :: Parser [Maybe Word16]+ipV6Parser = p0+ where+ p0 = l1 <$> elision <* endOfInput+ <|> l3 <$> elision <*> h16 <*> p2 6+ <|> l2 <$> h16 <*> p1 7+ <?> "IPv6address"++ p1 :: Int -> Parser [Maybe Word16]+ p1 0 = l0 <$ endOfInput <?> "IPv6 prefix: too many segments"+ p1 i = l1 <$> elision <* endOfInput+ <|> l3 <$> elision <*> h16 <*> p2 (i - 2)+ <|> l2 <$ ":" <*> h16 <*> p1 (i - 1)+ <?> "IPv6 prefix"++ p2 :: Int -> Parser [Maybe Word16]+ p2 0 = l0 <$ endOfInput <?> "IPv6 suffix: too many segments"+ p2 i = l2 <$ ":" <*> h16 <*> p2 (i - 1)+ <|> l0 <$ endOfInput+ <?> "IPv6 suffix"++ elision :: Parser (Maybe Word16)+ elision = Nothing <$ "::"++ h16 :: Parser (Maybe Word16)+ h16 = Just <$> do+ h <- hexadecimal @Integer+ guard $ h < int (maxBound @Word16)+ return $! int h+ <?> "h16"++ l0 = []+ l1 = pure+ l2 = (:)+ l3 a b t = a:b:t++portParser :: Parser Port+portParser = Port+ <$> (decimal >>= \(d :: Integer) -> int d <$ guard (d < 2^(16 :: Int)))+ <?> "port"++parseBytes :: MonadThrow m => T.Text -> Parser a -> B8.ByteString -> m a+parseBytes name parser b = either (throwM . HostAddressParserException . msg) return+ $ parseOnly (parser <* endOfInput) b+ where+ msg e = "Failed to parse " <> sshow b <> " as " <> name <> ": "+ <> T.pack e++-- -------------------------------------------------------------------------- --+-- Port Numbers++newtype Port = Port Word16+ deriving (Eq, Ord, Generic)+ deriving anyclass (Hashable, NFData)+ deriving newtype (Show, Real, Integral, Num, Bounded, Enum)++readPortBytes :: MonadThrow m => B8.ByteString -> m Port+readPortBytes = parseBytes "port" portParser+{-# INLINE readPortBytes #-}++portToText :: Port -> T.Text+portToText = sshow+{-# INLINE portToText #-}++portFromText :: MonadThrow m => T.Text -> m Port+portFromText = readPortBytes . T.encodeUtf8+{-# INLINE portFromText #-}++-- -------------------------------------------------------------------------- --+-- Hostnames++data Hostname+ = HostnameName (CI.CI B8.ByteString)+ | HostnameIPv4 (CI.CI B8.ByteString)+ | HostnameIPv6 (CI.CI B8.ByteString)+ deriving (Eq, Ord, Generic)+ deriving anyclass (Hashable, NFData)++instance Show Hostname where+ show = B8.unpack . hostnameBytes++readHostnameBytes :: MonadThrow m => B8.ByteString -> m Hostname+readHostnameBytes b = parseBytes "hostname" parser b+ where+ parser = hostParser <* endOfInput >>= \case+ HostTypeName -> return $! HostnameName (CI.mk b)+ HostTypeIPv4 -> return $! HostnameIPv4 (CI.mk b)+ HostTypeIPv6 -> return $! HostnameIPv6 (CI.mk b)+{-# INLINE readHostnameBytes #-}++localhost :: Hostname+localhost = HostnameName "localhost"+{-# INLINE localhost #-}++-- | Using explicit IP addresses and not to "localhost" greatly improves+-- networking performance and Mac OS X.+--+localhostIPv4 :: Hostname+localhostIPv4 = HostnameIPv4 "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 = HostnameIPv6 "::1"+{-# INLINE localhostIPv6 #-}++anyIpv4 :: Hostname+anyIpv4 = HostnameIPv4 "0.0.0.0"+{-# INLINE anyIpv4 #-}++loopback :: Hostname+loopback = HostnameIPv4 "127.0.0.1"+{-# INLINE loopback #-}++broadcast :: Hostname+broadcast = HostnameIPv4 "255.255.255.255"+{-# INLINE broadcast #-}++isPrivateHostname :: Hostname -> Bool+isPrivateHostname (HostnameIPv4 ip) = isPrivateIp (read $ B8.unpack $ CI.original ip)+isPrivateHostname h+ | h == localhost = True+ | h == localhostIPv4 = True+ | h == localhostIPv6 = True+ | otherwise = False++isReservedHostname :: Hostname -> Bool+isReservedHostname (HostnameIPv4 ip) = isReservedIp (read $ B8.unpack $ CI.original ip)+isReservedHostname h = isPrivateHostname h++isLocalIp :: IPv4 -> Bool+isLocalIp ip =+ isMatchedTo ip $ makeAddrRange (toIPv4 [127,0,0,0]) 8++isPrivateIp :: IPv4 -> Bool+isPrivateIp ip = or+ [ isMatchedTo ip $ makeAddrRange (toIPv4 [10,0,0,0]) 8+ , isMatchedTo ip $ makeAddrRange (toIPv4 [172,16,0,0]) 12+ , isMatchedTo ip $ makeAddrRange (toIPv4 [192,168,0,0]) 16+ ]++isReservedIp :: IPv4 -> Bool+isReservedIp ip = isLocalIp ip || isPrivateIp ip || or+ [ isMatchedTo ip $ makeAddrRange (toIPv4 [0,0,0,0]) 8+ , isMatchedTo ip $ makeAddrRange (toIPv4 [100,64,0,0]) 10+ , isMatchedTo ip $ makeAddrRange (toIPv4 [169,254,0,0]) 16+ , isMatchedTo ip $ makeAddrRange (toIPv4 [192,0,0,0]) 24+ , isMatchedTo ip $ makeAddrRange (toIPv4 [192,0,2,0]) 24+ , isMatchedTo ip $ makeAddrRange (toIPv4 [192,88,99,0]) 24+ , isMatchedTo ip $ makeAddrRange (toIPv4 [192,18,0,0]) 15+ , isMatchedTo ip $ makeAddrRange (toIPv4 [198,51,100,0]) 24+ , isMatchedTo ip $ makeAddrRange (toIPv4 [203,0,113,0]) 24+ , isMatchedTo ip $ makeAddrRange (toIPv4 [224,0,0,0]) 4+ , isMatchedTo ip $ makeAddrRange (toIPv4 [240,0,0,0]) 4+ , isMatchedTo ip $ makeAddrRange (toIPv4 [255,255,255,255]) 32+ ]++hostnameBytes :: Hostname -> B8.ByteString+hostnameBytes (HostnameName b) = CI.original b+hostnameBytes (HostnameIPv4 b) = CI.original b+hostnameBytes (HostnameIPv6 b) = CI.original b+{-# INLINE hostnameBytes #-}++hostnameToText :: Hostname -> T.Text+hostnameToText = T.decodeUtf8 . hostnameBytes+{-# INLINE hostnameToText #-}++hostnameFromText :: MonadThrow m => T.Text -> m Hostname+hostnameFromText = readHostnameBytes . T.encodeUtf8+{-# INLINE hostnameFromText #-}++unsafeHostnameFromText :: HasCallStack => T.Text -> Hostname+unsafeHostnameFromText = fromJuste . hostnameFromText+{-# INLINE unsafeHostnameFromText #-}++-- -------------------------------------------------------------------------- --+-- Host Addresses++data HostAddress = HostAddress+ { _hostAddressHost :: !Hostname+ , _hostAddressPort :: !Port+ }+ deriving (Show, Eq, Ord, Generic)+ deriving anyclass (Hashable, NFData)++makeLenses ''HostAddress++hostAddressBytes :: HostAddress -> B8.ByteString+hostAddressBytes a = host <> ":" <> sshow (_hostAddressPort a)+ where+ ha = _hostAddressHost a+ host = case ha of+ HostnameIPv6 _ -> "[" <> hostnameBytes ha <> "]"+ _ -> hostnameBytes ha+{-# INLINE hostAddressBytes #-}++readHostAddressBytes :: MonadThrow m => B8.ByteString -> m HostAddress+readHostAddressBytes bytes = parseBytes "hostaddress" (hostAddressParser bytes) 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 b = HostAddress+ <$> hostnameParser'+ <* ":"+ <*> portParser+ where+ host = B8.init $ fst $ B8.breakEnd (== ':') b+ hostnameParser'+ = HostnameName (CI.mk host) <$ hostNameParser+ <|> HostnameIPv4 (CI.mk host) <$ ipV4Parser+ <|> HostnameIPv6 (CI.mk $ B8.init $ B8.tail host) <$ "[" <* ipV6Parser <* "]"+ <?> "host"++hostAddressToText :: HostAddress -> T.Text+hostAddressToText = T.decodeUtf8 . hostAddressBytes+{-# INLINE hostAddressToText #-}++hostAddressFromText :: MonadThrow m => T.Text -> m HostAddress+hostAddressFromText = readHostAddressBytes . T.encodeUtf8+{-# INLINE hostAddressFromText #-}++unsafeHostAddressFromText :: HasCallStack => T.Text -> HostAddress+unsafeHostAddressFromText = fromJuste . hostAddressFromText+{-# INLINE unsafeHostAddressFromText #-}++isPrivateHostAddress :: HostAddress -> Bool+isPrivateHostAddress (HostAddress n _) = isPrivateHostname n+{-# INLINE isPrivateHostAddress #-}++isReservedHostAddress :: HostAddress -> Bool+isReservedHostAddress (HostAddress n _) = isReservedHostname 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