Internal.hs

{-# LANGUAGE DeriveDataTypeable #-}
{-# OPTIONS_HADDOCK hide #-}

-- Some code in this file was adapted from the @network-conduit@ library by
-- Michael Snoyman. Copyright (c) 2011. See its licensing terms (BSD3) at:
--   https://github.com/snoyberg/conduit/blob/master/network-conduit/LICENSE

module Network.Simple.Internal
  ( HostPreference(..)
  , hpHostName
  , ipv4mapped_to_ipv4
  , isIPv4addr
  , isIPv6addr
  , prioritize
  , happyEyeballSort
  , getServicePortNumber'
  ) where

import Data.Bits (shiftR, (.&.))
import qualified Data.List as List
import Data.String (IsString (fromString))
import Data.Word (byteSwap16)
import qualified Network.Socket as NS
import qualified Network.BSD as NS (getServicePortNumber)
import Text.Read (readMaybe)

-- | Preferred host to bind.
data HostPreference
  = HostAny          -- ^Any available host.
  | HostIPv4         -- ^Any available IPv4 host.
  | HostIPv6         -- ^Any available IPv6 host.
  | Host NS.HostName -- ^An explicit host name.
  deriving (Eq, Ord, Show, Read)

-- | The following special values are recognized:
--
-- * @*@ means 'HostAny'
--
-- * @*4@ means 'HostIPv4'
--
-- * @*6@ means 'HostIPv6'
--
-- * Any other string is 'Host'
instance IsString HostPreference where
  fromString "*"  = HostAny
  fromString "*4" = HostIPv4
  fromString "*6" = HostIPv6
  fromString s    = Host s

-- | Extract the 'NS.HostName' from a 'Host' preference, or 'Nothing' otherwise.
hpHostName:: HostPreference -> Maybe NS.HostName
hpHostName (Host s) = Just s
hpHostName _        = Nothing

-- | Convert IPv4-Mapped IPv6 Addresses to IPv4.
ipv4mapped_to_ipv4:: NS.SockAddr -> NS.SockAddr
ipv4mapped_to_ipv4 (NS.SockAddrInet6 p _ (0, 0, 0xFFFF, h) _)
  = NS.SockAddrInet p (NS.tupleToHostAddress
      (fromIntegral (shiftR (h .&. 0xFF000000) 24),
       fromIntegral (shiftR (h .&. 0x00FF0000) 16),
       fromIntegral (shiftR (h .&. 0x0000FF00) 8),
       fromIntegral         (h .&. 0x000000FF)))
ipv4mapped_to_ipv4 sa = sa

-- | Given a list of 'NS.AddrInfo's, reorder it so that ipv6 and ipv4 addresses,
-- when available, are intercalated, with a ipv6 address first.
happyEyeballSort :: [NS.AddrInfo] -> [NS.AddrInfo]
happyEyeballSort l =
    concat (List.transpose ((\(a,b) -> [a,b]) (List.partition isIPv6addr l)))

isIPv4addr :: NS.AddrInfo -> Bool
isIPv4addr x = NS.addrFamily x == NS.AF_INET

isIPv6addr :: NS.AddrInfo -> Bool
isIPv6addr x = NS.addrFamily x == NS.AF_INET6

-- | Move the elements that match the predicate closer to the head of the list.
-- Sorting is stable.
prioritize :: (a -> Bool) -> [a] -> [a]
prioritize p = uncurry (++) . List.partition p

-- | Like 'NS.getServicePortNumber', but it will accept numeric values such as
-- @\"80\"@ as input.
getServicePortNumber' :: NS.ServiceName -> IO NS.PortNumber
getServicePortNumber' sn = case readMaybe sn of
  Just w16 -> pure (fromIntegral (byteSwap16 w16))
  Nothing -> NS.getServicePortNumber sn
    -- the @socks5@ library is broken and uses port numbers in the
    -- wrong byte order. here we work around that.