{-# LINE 1 "Network/Socket/Types.hsc" #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LINE 2 "Network/Socket/Types.hsc" #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module Network.Socket.Types
    (
    -- * Socket
      Socket(..)
    , sockFd
    , sockFamily
    , sockType
    , sockProtocol
    , sockStatus
    , SocketStatus(..)

    -- * Socket types
    , SocketType(..)
    , isSupportedSocketType
    , packSocketType
    , packSocketType'
    , packSocketTypeOrThrow
    , unpackSocketType
    , unpackSocketType'

    -- * Family
    , Family(..)
    , isSupportedFamily
    , packFamily
    , unpackFamily

    -- * Socket addresses
    , SockAddr(..)
    , HostAddress

{-# LINE 34 "Network/Socket/Types.hsc" #-}
    , HostAddress6
    , FlowInfo
    , ScopeID

{-# LINE 38 "Network/Socket/Types.hsc" #-}
    , peekSockAddr
    , pokeSockAddr
    , sizeOfSockAddr
    , sizeOfSockAddrByFamily
    , withSockAddr
    , withNewSockAddr

    -- * Unsorted
    , ProtocolNumber
    , PortNumber(..)

    -- * Low-level helpers
    , zeroMemory
    ) where


{-# LINE 54 "Network/Socket/Types.hsc" #-}

import Control.Concurrent.MVar
import Control.Monad
import Data.Bits
import Data.Maybe
import Data.Ratio
import Data.Typeable
import Data.Word
import Foreign.C
import Foreign.Marshal.Alloc
import Foreign.Marshal.Array
import Foreign.Ptr
import Foreign.Storable

data Socket
  = MkSocket
            CInt                 -- File Descriptor
            Family
            SocketType
            ProtocolNumber       -- Protocol Number
            (MVar SocketStatus)  -- Status Flag
  deriving Typeable

sockFd       (MkSocket n _ _ _ _) = n
sockFamily   (MkSocket _ f _ _ _) = f
sockType     (MkSocket _ _ t _ _) = t
sockProtocol (MkSocket _ _ _ p _) = p
sockStatus   (MkSocket _ _ _ _ s) = s

instance Eq Socket where
  (MkSocket _ _ _ _ m1) == (MkSocket _ _ _ _ m2) = m1 == m2

instance Show Socket where
  showsPrec _n (MkSocket fd _ _ _ _) =
        showString "<socket: " . shows fd . showString ">"

type ProtocolNumber = CInt

data SocketStatus
  -- Returned Status    Function called
  = NotConnected        -- socket
  | Bound               -- bind
  | Listening           -- listen
  | Connected           -- connect/accept
  | ConvertedToHandle   -- is now a Handle, don't touch
  | Closed              -- close
    deriving (Eq, Show, Typeable)

-----------------------------------------------------------------------------
-- Socket types

-- There are a few possible ways to do this.  The first is convert the
-- structs used in the C library into an equivalent Haskell type. An
-- other possible implementation is to keep all the internals in the C
-- code and use an Int## and a status flag. The second method is used
-- here since a lot of the C structures are not required to be
-- manipulated.

-- Originally the status was non-mutable so we had to return a new
-- socket each time we changed the status.  This version now uses
-- mutable variables to avoid the need to do this.  The result is a
-- cleaner interface and better security since the application
-- programmer now can't circumvent the status information to perform
-- invalid operations on sockets.

-- | Socket Types.
--
-- The existence of a constructor does not necessarily imply that that
-- socket type is supported on your system: see 'isSupportedSocketType'.
data SocketType
        = NoSocketType -- ^ 0, used in getAddrInfo hints, for example
        | Stream -- ^ SOCK_STREAM
        | Datagram -- ^ SOCK_DGRAM
        | Raw -- ^ SOCK_RAW
        | RDM -- ^ SOCK_RDM
        | SeqPacket -- ^ SOCK_SEQPACKET
        deriving (Eq, Ord, Read, Show, Typeable)

-- | Does the SOCK_ constant corresponding to the given SocketType exist on
-- this system?
isSupportedSocketType :: SocketType -> Bool
isSupportedSocketType = isJust . packSocketType'

-- | Find the SOCK_ constant corresponding to the SocketType value.
packSocketType' :: SocketType -> Maybe CInt
packSocketType' stype = case Just stype of
    -- the Just above is to disable GHC's overlapping pattern
    -- detection: see comments for packSocketOption
    Just NoSocketType -> Just 0

{-# LINE 144 "Network/Socket/Types.hsc" #-}
    Just Stream -> Just 1
{-# LINE 145 "Network/Socket/Types.hsc" #-}

{-# LINE 146 "Network/Socket/Types.hsc" #-}

{-# LINE 147 "Network/Socket/Types.hsc" #-}
    Just Datagram -> Just 2
{-# LINE 148 "Network/Socket/Types.hsc" #-}

{-# LINE 149 "Network/Socket/Types.hsc" #-}

{-# LINE 150 "Network/Socket/Types.hsc" #-}
    Just Raw -> Just 3
{-# LINE 151 "Network/Socket/Types.hsc" #-}

{-# LINE 152 "Network/Socket/Types.hsc" #-}

{-# LINE 153 "Network/Socket/Types.hsc" #-}
    Just RDM -> Just 4
{-# LINE 154 "Network/Socket/Types.hsc" #-}

{-# LINE 155 "Network/Socket/Types.hsc" #-}

{-# LINE 156 "Network/Socket/Types.hsc" #-}
    Just SeqPacket -> Just 5
{-# LINE 157 "Network/Socket/Types.hsc" #-}

{-# LINE 158 "Network/Socket/Types.hsc" #-}
    _ -> Nothing

packSocketType :: SocketType -> CInt
packSocketType stype = fromMaybe (error errMsg) (packSocketType' stype)
  where
    errMsg = concat ["Network.Socket.packSocketType: ",
                     "socket type ", show stype, " unsupported on this system"]

-- | Try packSocketType' on the SocketType, if it fails throw an error with
-- message starting "Network.Socket." ++ the String parameter
packSocketTypeOrThrow :: String -> SocketType -> IO CInt
packSocketTypeOrThrow caller stype = maybe err return (packSocketType' stype)
 where
  err = ioError . userError . concat $ ["Network.Socket.", caller, ": ",
    "socket type ", show stype, " unsupported on this system"]


unpackSocketType:: CInt -> Maybe SocketType
unpackSocketType t = case t of
        0 -> Just NoSocketType

{-# LINE 179 "Network/Socket/Types.hsc" #-}
        (1) -> Just Stream
{-# LINE 180 "Network/Socket/Types.hsc" #-}

{-# LINE 181 "Network/Socket/Types.hsc" #-}

{-# LINE 182 "Network/Socket/Types.hsc" #-}
        (2) -> Just Datagram
{-# LINE 183 "Network/Socket/Types.hsc" #-}

{-# LINE 184 "Network/Socket/Types.hsc" #-}

{-# LINE 185 "Network/Socket/Types.hsc" #-}
        (3) -> Just Raw
{-# LINE 186 "Network/Socket/Types.hsc" #-}

{-# LINE 187 "Network/Socket/Types.hsc" #-}

{-# LINE 188 "Network/Socket/Types.hsc" #-}
        (4) -> Just RDM
{-# LINE 189 "Network/Socket/Types.hsc" #-}

{-# LINE 190 "Network/Socket/Types.hsc" #-}

{-# LINE 191 "Network/Socket/Types.hsc" #-}
        (5) -> Just SeqPacket
{-# LINE 192 "Network/Socket/Types.hsc" #-}

{-# LINE 193 "Network/Socket/Types.hsc" #-}
        _ -> Nothing

-- | Try unpackSocketType on the CInt, if it fails throw an error with
-- message starting "Network.Socket." ++ the String parameter
unpackSocketType' :: String -> CInt -> IO SocketType
unpackSocketType' caller ty = maybe err return (unpackSocketType ty)
 where
  err = ioError . userError . concat $ ["Network.Socket.", caller, ": ",
    "socket type ", show ty, " unsupported on this system"]

------------------------------------------------------------------------
-- Protocol Families.

-- | Address families.
--
-- A constructor being present here does not mean it is supported by the
-- operating system: see 'isSupportedFamily'.
data Family
    = AF_UNSPEC           -- unspecified
    | AF_UNIX             -- local to host (pipes, portals
    | AF_INET             -- internetwork: UDP, TCP, etc
    | AF_INET6            -- Internet Protocol version 6
    | AF_IMPLINK          -- arpanet imp addresses
    | AF_PUP              -- pup protocols: e.g. BSP
    | AF_CHAOS            -- mit CHAOS protocols
    | AF_NS               -- XEROX NS protocols
    | AF_NBS              -- nbs protocols
    | AF_ECMA             -- european computer manufacturers
    | AF_DATAKIT          -- datakit protocols
    | AF_CCITT            -- CCITT protocols, X.25 etc
    | AF_SNA              -- IBM SNA
    | AF_DECnet           -- DECnet
    | AF_DLI              -- Direct data link interface
    | AF_LAT              -- LAT
    | AF_HYLINK           -- NSC Hyperchannel
    | AF_APPLETALK        -- Apple Talk
    | AF_ROUTE            -- Internal Routing Protocol
    | AF_NETBIOS          -- NetBios-style addresses
    | AF_NIT              -- Network Interface Tap
    | AF_802              -- IEEE 802.2, also ISO 8802
    | AF_ISO              -- ISO protocols
    | AF_OSI              -- umbrella of all families used by OSI
    | AF_NETMAN           -- DNA Network Management
    | AF_X25              -- CCITT X.25
    | AF_AX25
    | AF_OSINET           -- AFI
    | AF_GOSSIP           -- US Government OSI
    | AF_IPX              -- Novell Internet Protocol
    | Pseudo_AF_XTP       -- eXpress Transfer Protocol (no AF)
    | AF_CTF              -- Common Trace Facility
    | AF_WAN              -- Wide Area Network protocols
    | AF_SDL              -- SGI Data Link for DLPI
    | AF_NETWARE
    | AF_NDD
    | AF_INTF             -- Debugging use only
    | AF_COIP             -- connection-oriented IP, aka ST II
    | AF_CNT              -- Computer Network Technology
    | Pseudo_AF_RTIP      -- Help Identify RTIP packets
    | Pseudo_AF_PIP       -- Help Identify PIP packets
    | AF_SIP              -- Simple Internet Protocol
    | AF_ISDN             -- Integrated Services Digital Network
    | Pseudo_AF_KEY       -- Internal key-management function
    | AF_NATM             -- native ATM access
    | AF_ARP              -- (rev.) addr. res. prot. (RFC 826)
    | Pseudo_AF_HDRCMPLT  -- Used by BPF to not rewrite hdrs in iface output
    | AF_ENCAP
    | AF_LINK             -- Link layer interface
    | AF_RAW              -- Link layer interface
    | AF_RIF              -- raw interface
    | AF_NETROM           -- Amateur radio NetROM
    | AF_BRIDGE           -- multiprotocol bridge
    | AF_ATMPVC           -- ATM PVCs
    | AF_ROSE             -- Amateur Radio X.25 PLP
    | AF_NETBEUI          -- 802.2LLC
    | AF_SECURITY         -- Security callback pseudo AF
    | AF_PACKET           -- Packet family
    | AF_ASH              -- Ash
    | AF_ECONET           -- Acorn Econet
    | AF_ATMSVC           -- ATM SVCs
    | AF_IRDA             -- IRDA sockets
    | AF_PPPOX            -- PPPoX sockets
    | AF_WANPIPE          -- Wanpipe API sockets
    | AF_BLUETOOTH        -- bluetooth sockets
      deriving (Eq, Ord, Read, Show)

packFamily :: Family -> CInt
packFamily f = case packFamily' f of
    Just fam -> fam
    Nothing -> error $
               "Network.Socket.packFamily: unsupported address family: " ++
               show f

-- | Does the AF_ constant corresponding to the given family exist on this
-- system?
isSupportedFamily :: Family -> Bool
isSupportedFamily = isJust . packFamily'

packFamily' :: Family -> Maybe CInt
packFamily' f = case Just f of
    -- the Just above is to disable GHC's overlapping pattern
    -- detection: see comments for packSocketOption
    Just AF_UNSPEC -> Just 0
{-# LINE 295 "Network/Socket/Types.hsc" #-}

{-# LINE 296 "Network/Socket/Types.hsc" #-}
    Just AF_UNIX -> Just 1
{-# LINE 297 "Network/Socket/Types.hsc" #-}

{-# LINE 298 "Network/Socket/Types.hsc" #-}

{-# LINE 299 "Network/Socket/Types.hsc" #-}
    Just AF_INET -> Just 2
{-# LINE 300 "Network/Socket/Types.hsc" #-}

{-# LINE 301 "Network/Socket/Types.hsc" #-}

{-# LINE 302 "Network/Socket/Types.hsc" #-}
    Just AF_INET6 -> Just 30
{-# LINE 303 "Network/Socket/Types.hsc" #-}

{-# LINE 304 "Network/Socket/Types.hsc" #-}

{-# LINE 305 "Network/Socket/Types.hsc" #-}
    Just AF_IMPLINK -> Just 3
{-# LINE 306 "Network/Socket/Types.hsc" #-}

{-# LINE 307 "Network/Socket/Types.hsc" #-}

{-# LINE 308 "Network/Socket/Types.hsc" #-}
    Just AF_PUP -> Just 4
{-# LINE 309 "Network/Socket/Types.hsc" #-}

{-# LINE 310 "Network/Socket/Types.hsc" #-}

{-# LINE 311 "Network/Socket/Types.hsc" #-}
    Just AF_CHAOS -> Just 5
{-# LINE 312 "Network/Socket/Types.hsc" #-}

{-# LINE 313 "Network/Socket/Types.hsc" #-}

{-# LINE 314 "Network/Socket/Types.hsc" #-}
    Just AF_NS -> Just 6
{-# LINE 315 "Network/Socket/Types.hsc" #-}

{-# LINE 316 "Network/Socket/Types.hsc" #-}

{-# LINE 319 "Network/Socket/Types.hsc" #-}

{-# LINE 320 "Network/Socket/Types.hsc" #-}
    Just AF_ECMA -> Just 8
{-# LINE 321 "Network/Socket/Types.hsc" #-}

{-# LINE 322 "Network/Socket/Types.hsc" #-}

{-# LINE 323 "Network/Socket/Types.hsc" #-}
    Just AF_DATAKIT -> Just 9
{-# LINE 324 "Network/Socket/Types.hsc" #-}

{-# LINE 325 "Network/Socket/Types.hsc" #-}

{-# LINE 326 "Network/Socket/Types.hsc" #-}
    Just AF_CCITT -> Just 10
{-# LINE 327 "Network/Socket/Types.hsc" #-}

{-# LINE 328 "Network/Socket/Types.hsc" #-}

{-# LINE 329 "Network/Socket/Types.hsc" #-}
    Just AF_SNA -> Just 11
{-# LINE 330 "Network/Socket/Types.hsc" #-}

{-# LINE 331 "Network/Socket/Types.hsc" #-}

{-# LINE 332 "Network/Socket/Types.hsc" #-}
    Just AF_DECnet -> Just 12
{-# LINE 333 "Network/Socket/Types.hsc" #-}

{-# LINE 334 "Network/Socket/Types.hsc" #-}

{-# LINE 335 "Network/Socket/Types.hsc" #-}
    Just AF_DLI -> Just 13
{-# LINE 336 "Network/Socket/Types.hsc" #-}

{-# LINE 337 "Network/Socket/Types.hsc" #-}

{-# LINE 338 "Network/Socket/Types.hsc" #-}
    Just AF_LAT -> Just 14
{-# LINE 339 "Network/Socket/Types.hsc" #-}

{-# LINE 340 "Network/Socket/Types.hsc" #-}

{-# LINE 341 "Network/Socket/Types.hsc" #-}
    Just AF_HYLINK -> Just 15
{-# LINE 342 "Network/Socket/Types.hsc" #-}

{-# LINE 343 "Network/Socket/Types.hsc" #-}

{-# LINE 344 "Network/Socket/Types.hsc" #-}
    Just AF_APPLETALK -> Just 16
{-# LINE 345 "Network/Socket/Types.hsc" #-}

{-# LINE 346 "Network/Socket/Types.hsc" #-}

{-# LINE 347 "Network/Socket/Types.hsc" #-}
    Just AF_ROUTE -> Just 17
{-# LINE 348 "Network/Socket/Types.hsc" #-}

{-# LINE 349 "Network/Socket/Types.hsc" #-}

{-# LINE 350 "Network/Socket/Types.hsc" #-}
    Just AF_NETBIOS -> Just 33
{-# LINE 351 "Network/Socket/Types.hsc" #-}

{-# LINE 352 "Network/Socket/Types.hsc" #-}

{-# LINE 355 "Network/Socket/Types.hsc" #-}

{-# LINE 358 "Network/Socket/Types.hsc" #-}

{-# LINE 359 "Network/Socket/Types.hsc" #-}
    Just AF_ISO -> Just 7
{-# LINE 360 "Network/Socket/Types.hsc" #-}

{-# LINE 361 "Network/Socket/Types.hsc" #-}

{-# LINE 362 "Network/Socket/Types.hsc" #-}
    Just AF_OSI -> Just 7
{-# LINE 363 "Network/Socket/Types.hsc" #-}

{-# LINE 364 "Network/Socket/Types.hsc" #-}

{-# LINE 367 "Network/Socket/Types.hsc" #-}

{-# LINE 370 "Network/Socket/Types.hsc" #-}

{-# LINE 373 "Network/Socket/Types.hsc" #-}

{-# LINE 376 "Network/Socket/Types.hsc" #-}

{-# LINE 379 "Network/Socket/Types.hsc" #-}

{-# LINE 380 "Network/Socket/Types.hsc" #-}
    Just AF_IPX -> Just 23
{-# LINE 381 "Network/Socket/Types.hsc" #-}

{-# LINE 382 "Network/Socket/Types.hsc" #-}

{-# LINE 385 "Network/Socket/Types.hsc" #-}

{-# LINE 388 "Network/Socket/Types.hsc" #-}

{-# LINE 391 "Network/Socket/Types.hsc" #-}

{-# LINE 394 "Network/Socket/Types.hsc" #-}

{-# LINE 397 "Network/Socket/Types.hsc" #-}

{-# LINE 400 "Network/Socket/Types.hsc" #-}

{-# LINE 403 "Network/Socket/Types.hsc" #-}

{-# LINE 404 "Network/Socket/Types.hsc" #-}
    Just AF_COIP -> Just 20
{-# LINE 405 "Network/Socket/Types.hsc" #-}

{-# LINE 406 "Network/Socket/Types.hsc" #-}

{-# LINE 407 "Network/Socket/Types.hsc" #-}
    Just AF_CNT -> Just 21
{-# LINE 408 "Network/Socket/Types.hsc" #-}

{-# LINE 409 "Network/Socket/Types.hsc" #-}

{-# LINE 412 "Network/Socket/Types.hsc" #-}

{-# LINE 415 "Network/Socket/Types.hsc" #-}

{-# LINE 416 "Network/Socket/Types.hsc" #-}
    Just AF_SIP -> Just 24
{-# LINE 417 "Network/Socket/Types.hsc" #-}

{-# LINE 418 "Network/Socket/Types.hsc" #-}

{-# LINE 419 "Network/Socket/Types.hsc" #-}
    Just AF_ISDN -> Just 28
{-# LINE 420 "Network/Socket/Types.hsc" #-}

{-# LINE 421 "Network/Socket/Types.hsc" #-}

{-# LINE 424 "Network/Socket/Types.hsc" #-}

{-# LINE 425 "Network/Socket/Types.hsc" #-}
    Just AF_NATM -> Just 31
{-# LINE 426 "Network/Socket/Types.hsc" #-}

{-# LINE 427 "Network/Socket/Types.hsc" #-}

{-# LINE 430 "Network/Socket/Types.hsc" #-}

{-# LINE 433 "Network/Socket/Types.hsc" #-}

{-# LINE 436 "Network/Socket/Types.hsc" #-}

{-# LINE 437 "Network/Socket/Types.hsc" #-}
    Just AF_LINK -> Just 18
{-# LINE 438 "Network/Socket/Types.hsc" #-}

{-# LINE 439 "Network/Socket/Types.hsc" #-}

{-# LINE 442 "Network/Socket/Types.hsc" #-}

{-# LINE 445 "Network/Socket/Types.hsc" #-}

{-# LINE 448 "Network/Socket/Types.hsc" #-}

{-# LINE 451 "Network/Socket/Types.hsc" #-}

{-# LINE 454 "Network/Socket/Types.hsc" #-}

{-# LINE 457 "Network/Socket/Types.hsc" #-}

{-# LINE 460 "Network/Socket/Types.hsc" #-}

{-# LINE 463 "Network/Socket/Types.hsc" #-}

{-# LINE 466 "Network/Socket/Types.hsc" #-}

{-# LINE 469 "Network/Socket/Types.hsc" #-}

{-# LINE 472 "Network/Socket/Types.hsc" #-}

{-# LINE 475 "Network/Socket/Types.hsc" #-}

{-# LINE 478 "Network/Socket/Types.hsc" #-}

{-# LINE 481 "Network/Socket/Types.hsc" #-}

{-# LINE 484 "Network/Socket/Types.hsc" #-}

{-# LINE 487 "Network/Socket/Types.hsc" #-}
    _ -> Nothing

--------- ----------

unpackFamily :: CInt -> Family
unpackFamily f = case f of
        (0) -> AF_UNSPEC
{-# LINE 494 "Network/Socket/Types.hsc" #-}

{-# LINE 495 "Network/Socket/Types.hsc" #-}
        (1) -> AF_UNIX
{-# LINE 496 "Network/Socket/Types.hsc" #-}

{-# LINE 497 "Network/Socket/Types.hsc" #-}

{-# LINE 498 "Network/Socket/Types.hsc" #-}
        (2) -> AF_INET
{-# LINE 499 "Network/Socket/Types.hsc" #-}

{-# LINE 500 "Network/Socket/Types.hsc" #-}

{-# LINE 501 "Network/Socket/Types.hsc" #-}
        (30) -> AF_INET6
{-# LINE 502 "Network/Socket/Types.hsc" #-}

{-# LINE 503 "Network/Socket/Types.hsc" #-}

{-# LINE 504 "Network/Socket/Types.hsc" #-}
        (3) -> AF_IMPLINK
{-# LINE 505 "Network/Socket/Types.hsc" #-}

{-# LINE 506 "Network/Socket/Types.hsc" #-}

{-# LINE 507 "Network/Socket/Types.hsc" #-}
        (4) -> AF_PUP
{-# LINE 508 "Network/Socket/Types.hsc" #-}

{-# LINE 509 "Network/Socket/Types.hsc" #-}

{-# LINE 510 "Network/Socket/Types.hsc" #-}
        (5) -> AF_CHAOS
{-# LINE 511 "Network/Socket/Types.hsc" #-}

{-# LINE 512 "Network/Socket/Types.hsc" #-}

{-# LINE 513 "Network/Socket/Types.hsc" #-}
        (6) -> AF_NS
{-# LINE 514 "Network/Socket/Types.hsc" #-}

{-# LINE 515 "Network/Socket/Types.hsc" #-}

{-# LINE 518 "Network/Socket/Types.hsc" #-}

{-# LINE 519 "Network/Socket/Types.hsc" #-}
        (8) -> AF_ECMA
{-# LINE 520 "Network/Socket/Types.hsc" #-}

{-# LINE 521 "Network/Socket/Types.hsc" #-}

{-# LINE 522 "Network/Socket/Types.hsc" #-}
        (9) -> AF_DATAKIT
{-# LINE 523 "Network/Socket/Types.hsc" #-}

{-# LINE 524 "Network/Socket/Types.hsc" #-}

{-# LINE 525 "Network/Socket/Types.hsc" #-}
        (10) -> AF_CCITT
{-# LINE 526 "Network/Socket/Types.hsc" #-}

{-# LINE 527 "Network/Socket/Types.hsc" #-}

{-# LINE 528 "Network/Socket/Types.hsc" #-}
        (11) -> AF_SNA
{-# LINE 529 "Network/Socket/Types.hsc" #-}

{-# LINE 530 "Network/Socket/Types.hsc" #-}

{-# LINE 531 "Network/Socket/Types.hsc" #-}
        (12) -> AF_DECnet
{-# LINE 532 "Network/Socket/Types.hsc" #-}

{-# LINE 533 "Network/Socket/Types.hsc" #-}

{-# LINE 534 "Network/Socket/Types.hsc" #-}
        (13) -> AF_DLI
{-# LINE 535 "Network/Socket/Types.hsc" #-}

{-# LINE 536 "Network/Socket/Types.hsc" #-}

{-# LINE 537 "Network/Socket/Types.hsc" #-}
        (14) -> AF_LAT
{-# LINE 538 "Network/Socket/Types.hsc" #-}

{-# LINE 539 "Network/Socket/Types.hsc" #-}

{-# LINE 540 "Network/Socket/Types.hsc" #-}
        (15) -> AF_HYLINK
{-# LINE 541 "Network/Socket/Types.hsc" #-}

{-# LINE 542 "Network/Socket/Types.hsc" #-}

{-# LINE 543 "Network/Socket/Types.hsc" #-}
        (16) -> AF_APPLETALK
{-# LINE 544 "Network/Socket/Types.hsc" #-}

{-# LINE 545 "Network/Socket/Types.hsc" #-}

{-# LINE 546 "Network/Socket/Types.hsc" #-}
        (17) -> AF_ROUTE
{-# LINE 547 "Network/Socket/Types.hsc" #-}

{-# LINE 548 "Network/Socket/Types.hsc" #-}

{-# LINE 549 "Network/Socket/Types.hsc" #-}
        (33) -> AF_NETBIOS
{-# LINE 550 "Network/Socket/Types.hsc" #-}

{-# LINE 551 "Network/Socket/Types.hsc" #-}

{-# LINE 554 "Network/Socket/Types.hsc" #-}

{-# LINE 557 "Network/Socket/Types.hsc" #-}

{-# LINE 558 "Network/Socket/Types.hsc" #-}
        (7) -> AF_ISO
{-# LINE 559 "Network/Socket/Types.hsc" #-}

{-# LINE 560 "Network/Socket/Types.hsc" #-}

{-# LINE 561 "Network/Socket/Types.hsc" #-}

{-# LINE 564 "Network/Socket/Types.hsc" #-}

{-# LINE 565 "Network/Socket/Types.hsc" #-}

{-# LINE 568 "Network/Socket/Types.hsc" #-}

{-# LINE 571 "Network/Socket/Types.hsc" #-}

{-# LINE 574 "Network/Socket/Types.hsc" #-}

{-# LINE 577 "Network/Socket/Types.hsc" #-}

{-# LINE 580 "Network/Socket/Types.hsc" #-}

{-# LINE 581 "Network/Socket/Types.hsc" #-}
        (23) -> AF_IPX
{-# LINE 582 "Network/Socket/Types.hsc" #-}

{-# LINE 583 "Network/Socket/Types.hsc" #-}

{-# LINE 586 "Network/Socket/Types.hsc" #-}

{-# LINE 589 "Network/Socket/Types.hsc" #-}

{-# LINE 592 "Network/Socket/Types.hsc" #-}

{-# LINE 595 "Network/Socket/Types.hsc" #-}

{-# LINE 598 "Network/Socket/Types.hsc" #-}

{-# LINE 601 "Network/Socket/Types.hsc" #-}

{-# LINE 604 "Network/Socket/Types.hsc" #-}

{-# LINE 605 "Network/Socket/Types.hsc" #-}
        (20) -> AF_COIP
{-# LINE 606 "Network/Socket/Types.hsc" #-}

{-# LINE 607 "Network/Socket/Types.hsc" #-}

{-# LINE 608 "Network/Socket/Types.hsc" #-}
        (21) -> AF_CNT
{-# LINE 609 "Network/Socket/Types.hsc" #-}

{-# LINE 610 "Network/Socket/Types.hsc" #-}

{-# LINE 613 "Network/Socket/Types.hsc" #-}

{-# LINE 616 "Network/Socket/Types.hsc" #-}

{-# LINE 617 "Network/Socket/Types.hsc" #-}
        (24) -> AF_SIP
{-# LINE 618 "Network/Socket/Types.hsc" #-}

{-# LINE 619 "Network/Socket/Types.hsc" #-}

{-# LINE 620 "Network/Socket/Types.hsc" #-}
        (28) -> AF_ISDN
{-# LINE 621 "Network/Socket/Types.hsc" #-}

{-# LINE 622 "Network/Socket/Types.hsc" #-}

{-# LINE 625 "Network/Socket/Types.hsc" #-}

{-# LINE 626 "Network/Socket/Types.hsc" #-}
        (31) -> AF_NATM
{-# LINE 627 "Network/Socket/Types.hsc" #-}

{-# LINE 628 "Network/Socket/Types.hsc" #-}

{-# LINE 631 "Network/Socket/Types.hsc" #-}

{-# LINE 634 "Network/Socket/Types.hsc" #-}

{-# LINE 637 "Network/Socket/Types.hsc" #-}

{-# LINE 638 "Network/Socket/Types.hsc" #-}
        (18) -> AF_LINK
{-# LINE 639 "Network/Socket/Types.hsc" #-}

{-# LINE 640 "Network/Socket/Types.hsc" #-}

{-# LINE 643 "Network/Socket/Types.hsc" #-}

{-# LINE 646 "Network/Socket/Types.hsc" #-}

{-# LINE 649 "Network/Socket/Types.hsc" #-}

{-# LINE 652 "Network/Socket/Types.hsc" #-}

{-# LINE 655 "Network/Socket/Types.hsc" #-}

{-# LINE 658 "Network/Socket/Types.hsc" #-}

{-# LINE 661 "Network/Socket/Types.hsc" #-}

{-# LINE 664 "Network/Socket/Types.hsc" #-}

{-# LINE 667 "Network/Socket/Types.hsc" #-}

{-# LINE 670 "Network/Socket/Types.hsc" #-}

{-# LINE 673 "Network/Socket/Types.hsc" #-}

{-# LINE 676 "Network/Socket/Types.hsc" #-}

{-# LINE 679 "Network/Socket/Types.hsc" #-}

{-# LINE 682 "Network/Socket/Types.hsc" #-}

{-# LINE 685 "Network/Socket/Types.hsc" #-}

{-# LINE 688 "Network/Socket/Types.hsc" #-}
        unknown -> error ("Network.Socket.unpackFamily: unknown address " ++
                          "family " ++ show unknown)

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

newtype PortNumber = PortNum Word16 deriving (Eq, Ord, Typeable)
-- newtyped to prevent accidental use of sane-looking
-- port numbers that haven't actually been converted to
-- network-byte-order first.

instance Show PortNumber where
  showsPrec p pn = showsPrec p (portNumberToInt pn)

intToPortNumber :: Int -> PortNumber
intToPortNumber v = PortNum (htons (fromIntegral v))

portNumberToInt :: PortNumber -> Int
portNumberToInt (PortNum po) = fromIntegral (ntohs po)

foreign import CALLCONV unsafe "ntohs" ntohs :: Word16 -> Word16
foreign import CALLCONV unsafe "htons" htons :: Word16 -> Word16
--foreign import CALLCONV unsafe "ntohl" ntohl :: Word32 -> Word32

instance Enum PortNumber where
    toEnum   = intToPortNumber
    fromEnum = portNumberToInt

instance Num PortNumber where
   fromInteger i = intToPortNumber (fromInteger i)
    -- for completeness.
   (+) x y   = intToPortNumber (portNumberToInt x + portNumberToInt y)
   (-) x y   = intToPortNumber (portNumberToInt x - portNumberToInt y)
   negate x  = intToPortNumber (-portNumberToInt x)
   (*) x y   = intToPortNumber (portNumberToInt x * portNumberToInt y)
   abs n     = intToPortNumber (abs (portNumberToInt n))
   signum n  = intToPortNumber (signum (portNumberToInt n))

instance Real PortNumber where
    toRational x = toInteger x % 1

instance Integral PortNumber where
    quotRem a b = let (c,d) = quotRem (portNumberToInt a) (portNumberToInt b) in
                  (intToPortNumber c, intToPortNumber d)
    toInteger a = toInteger (portNumberToInt a)

instance Storable PortNumber where
   sizeOf    _ = sizeOf    (undefined :: Word16)
   alignment _ = alignment (undefined :: Word16)
   poke p (PortNum po) = poke (castPtr p) po
   peek p = PortNum `liftM` peek (castPtr p)

------------------------------------------------------------------------
-- Socket addresses

-- The scheme used for addressing sockets is somewhat quirky. The
-- calls in the BSD socket API that need to know the socket address
-- all operate in terms of struct sockaddr, a `virtual' type of
-- socket address.

-- The Internet family of sockets are addressed as struct sockaddr_in,
-- so when calling functions that operate on struct sockaddr, we have
-- to type cast the Internet socket address into a struct sockaddr.
-- Instances of the structure for different families might *not* be
-- the same size. Same casting is required of other families of
-- sockets such as Xerox NS. Similarly for Unix domain sockets.

-- To represent these socket addresses in Haskell-land, we do what BSD
-- didn't do, and use a union/algebraic type for the different
-- families. Currently only Unix domain sockets and the Internet
-- families are supported.


{-# LINE 761 "Network/Socket/Types.hsc" #-}
type FlowInfo = Word32
type ScopeID = Word32

{-# LINE 764 "Network/Socket/Types.hsc" #-}

data SockAddr       -- C Names
  = SockAddrInet
    PortNumber  -- sin_port  (network byte order)
    HostAddress -- sin_addr  (ditto)

{-# LINE 770 "Network/Socket/Types.hsc" #-}
  | SockAddrInet6
        PortNumber      -- sin6_port (network byte order)
        FlowInfo        -- sin6_flowinfo (ditto)
        HostAddress6    -- sin6_addr (ditto)
        ScopeID         -- sin6_scope_id (ditto)

{-# LINE 776 "Network/Socket/Types.hsc" #-}

{-# LINE 777 "Network/Socket/Types.hsc" #-}
  | SockAddrUnix
        String          -- sun_path

{-# LINE 780 "Network/Socket/Types.hsc" #-}
  deriving (Eq, Ord, Typeable)


{-# LINE 785 "Network/Socket/Types.hsc" #-}
type CSaFamily = (Word8)
{-# LINE 786 "Network/Socket/Types.hsc" #-}

{-# LINE 789 "Network/Socket/Types.hsc" #-}

-- | Computes the storage requirements (in bytes) of the given
-- 'SockAddr'.  This function differs from 'Foreign.Storable.sizeOf'
-- in that the value of the argument /is/ used.
sizeOfSockAddr :: SockAddr -> Int

{-# LINE 795 "Network/Socket/Types.hsc" #-}
sizeOfSockAddr (SockAddrUnix path) =
    case path of
        '\0':_ -> (1) + length path
{-# LINE 798 "Network/Socket/Types.hsc" #-}
        _      -> 106
{-# LINE 799 "Network/Socket/Types.hsc" #-}

{-# LINE 800 "Network/Socket/Types.hsc" #-}
sizeOfSockAddr (SockAddrInet _ _) = 16
{-# LINE 801 "Network/Socket/Types.hsc" #-}

{-# LINE 802 "Network/Socket/Types.hsc" #-}
sizeOfSockAddr (SockAddrInet6 _ _ _ _) = 28
{-# LINE 803 "Network/Socket/Types.hsc" #-}

{-# LINE 804 "Network/Socket/Types.hsc" #-}

-- | Computes the storage requirements (in bytes) required for a
-- 'SockAddr' with the given 'Family'.
sizeOfSockAddrByFamily :: Family -> Int

{-# LINE 809 "Network/Socket/Types.hsc" #-}
sizeOfSockAddrByFamily AF_UNIX  = 106
{-# LINE 810 "Network/Socket/Types.hsc" #-}

{-# LINE 811 "Network/Socket/Types.hsc" #-}

{-# LINE 812 "Network/Socket/Types.hsc" #-}
sizeOfSockAddrByFamily AF_INET6 = 28
{-# LINE 813 "Network/Socket/Types.hsc" #-}

{-# LINE 814 "Network/Socket/Types.hsc" #-}
sizeOfSockAddrByFamily AF_INET  = 16
{-# LINE 815 "Network/Socket/Types.hsc" #-}

-- | Use a 'SockAddr' with a function requiring a pointer to a
-- 'SockAddr' and the length of that 'SockAddr'.
withSockAddr :: SockAddr -> (Ptr SockAddr -> Int -> IO a) -> IO a
withSockAddr addr f = do
    let sz = sizeOfSockAddr addr
    allocaBytes sz $ \p -> pokeSockAddr p addr >> f (castPtr p) sz

-- | Create a new 'SockAddr' for use with a function requiring a
-- pointer to a 'SockAddr' and the length of that 'SockAddr'.
withNewSockAddr :: Family -> (Ptr SockAddr -> Int -> IO a) -> IO a
withNewSockAddr family f = do
    let sz = sizeOfSockAddrByFamily family
    allocaBytes sz $ \ptr -> f ptr sz

-- We can't write an instance of 'Storable' for 'SockAddr' because
-- @sockaddr@ is a sum type of variable size but
-- 'Foreign.Storable.sizeOf' is required to be constant.

-- Note that on Darwin, the sockaddr structure must be zeroed before
-- use.

-- | Write the given 'SockAddr' to the given memory location.
pokeSockAddr :: Ptr a -> SockAddr -> IO ()

{-# LINE 840 "Network/Socket/Types.hsc" #-}
pokeSockAddr p (SockAddrUnix path) = do

{-# LINE 842 "Network/Socket/Types.hsc" #-}
    zeroMemory p (106)
{-# LINE 843 "Network/Socket/Types.hsc" #-}

{-# LINE 844 "Network/Socket/Types.hsc" #-}

{-# LINE 845 "Network/Socket/Types.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p ((106) :: Word8)
{-# LINE 846 "Network/Socket/Types.hsc" #-}

{-# LINE 847 "Network/Socket/Types.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 1)) p ((1) :: CSaFamily)
{-# LINE 848 "Network/Socket/Types.hsc" #-}
    let pathC = map castCharToCChar path
        poker = case path of ('\0':_) -> pokeArray; _ -> pokeArray0 0
    poker (((\hsc_ptr -> hsc_ptr `plusPtr` 2)) p) pathC
{-# LINE 851 "Network/Socket/Types.hsc" #-}

{-# LINE 852 "Network/Socket/Types.hsc" #-}
pokeSockAddr p (SockAddrInet (PortNum port) addr) = do

{-# LINE 854 "Network/Socket/Types.hsc" #-}
    zeroMemory p (16)
{-# LINE 855 "Network/Socket/Types.hsc" #-}

{-# LINE 856 "Network/Socket/Types.hsc" #-}

{-# LINE 857 "Network/Socket/Types.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p ((16) :: Word8)
{-# LINE 858 "Network/Socket/Types.hsc" #-}

{-# LINE 859 "Network/Socket/Types.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 1)) p ((2) :: CSaFamily)
{-# LINE 860 "Network/Socket/Types.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 2)) p port
{-# LINE 861 "Network/Socket/Types.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) p addr
{-# LINE 862 "Network/Socket/Types.hsc" #-}

{-# LINE 863 "Network/Socket/Types.hsc" #-}
pokeSockAddr p (SockAddrInet6 (PortNum port) flow addr scope) = do

{-# LINE 865 "Network/Socket/Types.hsc" #-}
    zeroMemory p (28)
{-# LINE 866 "Network/Socket/Types.hsc" #-}

{-# LINE 867 "Network/Socket/Types.hsc" #-}

{-# LINE 868 "Network/Socket/Types.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p ((28) :: Word8)
{-# LINE 869 "Network/Socket/Types.hsc" #-}

{-# LINE 870 "Network/Socket/Types.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 1)) p ((30) :: CSaFamily)
{-# LINE 871 "Network/Socket/Types.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 2)) p port
{-# LINE 872 "Network/Socket/Types.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) p flow
{-# LINE 873 "Network/Socket/Types.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) p addr
{-# LINE 874 "Network/Socket/Types.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 24)) p scope
{-# LINE 875 "Network/Socket/Types.hsc" #-}

{-# LINE 876 "Network/Socket/Types.hsc" #-}

-- | Read a 'SockAddr' from the given memory location.
peekSockAddr :: Ptr SockAddr -> IO SockAddr
peekSockAddr p = do
  family <- ((\hsc_ptr -> peekByteOff hsc_ptr 1)) p
{-# LINE 881 "Network/Socket/Types.hsc" #-}
  case family :: CSaFamily of

{-# LINE 883 "Network/Socket/Types.hsc" #-}
    (1) -> do
{-# LINE 884 "Network/Socket/Types.hsc" #-}
        str <- peekCString (((\hsc_ptr -> hsc_ptr `plusPtr` 2)) p)
{-# LINE 885 "Network/Socket/Types.hsc" #-}
        return (SockAddrUnix str)

{-# LINE 887 "Network/Socket/Types.hsc" #-}
    (2) -> do
{-# LINE 888 "Network/Socket/Types.hsc" #-}
        addr <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) p
{-# LINE 889 "Network/Socket/Types.hsc" #-}
        port <- ((\hsc_ptr -> peekByteOff hsc_ptr 2)) p
{-# LINE 890 "Network/Socket/Types.hsc" #-}
        return (SockAddrInet (PortNum port) addr)

{-# LINE 892 "Network/Socket/Types.hsc" #-}
    (30) -> do
{-# LINE 893 "Network/Socket/Types.hsc" #-}
        port <- ((\hsc_ptr -> peekByteOff hsc_ptr 2)) p
{-# LINE 894 "Network/Socket/Types.hsc" #-}
        flow <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) p
{-# LINE 895 "Network/Socket/Types.hsc" #-}
        addr <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p
{-# LINE 896 "Network/Socket/Types.hsc" #-}
        scope <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) p
{-# LINE 897 "Network/Socket/Types.hsc" #-}
        return (SockAddrInet6 (PortNum port) flow addr scope)

{-# LINE 899 "Network/Socket/Types.hsc" #-}

------------------------------------------------------------------------

-- | Network byte order.
type HostAddress = Word32


{-# LINE 906 "Network/Socket/Types.hsc" #-}
-- | Host byte order.
type HostAddress6 = (Word32, Word32, Word32, Word32)

-- The peek32 and poke32 functions work around the fact that the RFCs
-- don't require 32-bit-wide address fields to be present.  We can
-- only portably rely on an 8-bit field, s6_addr.

s6_addr_offset :: Int
s6_addr_offset = ((0))
{-# LINE 915 "Network/Socket/Types.hsc" #-}

peek32 :: Ptr a -> Int -> IO Word32
peek32 p i0 = do
    let i' = i0 * 4
        peekByte n = peekByteOff p (s6_addr_offset + i' + n) :: IO Word8
        a `sl` i = fromIntegral a `shiftL` i
    a0 <- peekByte 0
    a1 <- peekByte 1
    a2 <- peekByte 2
    a3 <- peekByte 3
    return ((a0 `sl` 24) .|. (a1 `sl` 16) .|. (a2 `sl` 8) .|. (a3 `sl` 0))

poke32 :: Ptr a -> Int -> Word32 -> IO ()
poke32 p i0 a = do
    let i' = i0 * 4
        pokeByte n = pokeByteOff p (s6_addr_offset + i' + n)
        x `sr` i = fromIntegral (x `shiftR` i) :: Word8
    pokeByte 0 (a `sr` 24)
    pokeByte 1 (a `sr` 16)
    pokeByte 2 (a `sr`  8)
    pokeByte 3 (a `sr`  0)

instance Storable HostAddress6 where
    sizeOf _    = (16)
{-# LINE 939 "Network/Socket/Types.hsc" #-}
    alignment _ = alignment (undefined :: CInt)

    peek p = do
        a <- peek32 p 0
        b <- peek32 p 1
        c <- peek32 p 2
        d <- peek32 p 3
        return (a, b, c, d)

    poke p (a, b, c, d) = do
        poke32 p 0 a
        poke32 p 1 b
        poke32 p 2 c
        poke32 p 3 d

{-# LINE 954 "Network/Socket/Types.hsc" #-}

------------------------------------------------------------------------
-- Helper functions

foreign import ccall unsafe "string.h" memset :: Ptr a -> CInt -> CSize -> IO ()

-- | Zero a structure.
zeroMemory :: Ptr a -> CSize -> IO ()
zeroMemory dest nbytes = memset dest 0 (fromIntegral nbytes)