{-# INCLUDE "HsNet.h" #-}
{-# OPTIONS_GHC -optc-DWITH_WINSOCK=1 #-}
{-# LINE 1 "Network\Socket\Internal.hsc" #-}
{-# OPTIONS -fglasgow-exts -cpp #-}
{-# LINE 2 "Network\Socket\Internal.hsc" #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Network.Socket.Internal
-- Copyright   :  (c) The University of Glasgow 2001
-- License     :  BSD-style (see the file libraries/network/LICENSE)
--
-- Maintainer  :  libraries@haskell.org
-- Stability   :  provisional
-- Portability :  portable
--
-- A module containing semi-public 'Network.Socket' internals.
-- Modules which extend the 'Network.Socket' module will need to use
-- this module while ideally most users will be able to make do with
-- the public interface.
--
-----------------------------------------------------------------------------


{-# LINE 20 "Network\Socket\Internal.hsc" #-}


{-# LINE 22 "Network\Socket\Internal.hsc" #-}

{-# LINE 23 "Network\Socket\Internal.hsc" #-}

{-# LINE 24 "Network\Socket\Internal.hsc" #-}


{-# LINE 28 "Network\Socket\Internal.hsc" #-}

module Network.Socket.Internal
    (
      -- * Socket addresses
      HostAddress,

{-# LINE 38 "Network\Socket\Internal.hsc" #-}
      PortNumber(..),
      SockAddr(..),

      peekSockAddr,
      pokeSockAddr,
      sizeOfSockAddr,
      sizeOfSockAddrByFamily,
      withSockAddr,
      withNewSockAddr,

      -- * Protocol families
      Family(..),
    ) where

import Data.Bits ( (.|.), shiftL, shiftR )
import Data.Word ( Word8, Word16, Word32 )
import Foreign.C.String ( castCharToCChar, peekCString )
import Foreign.C.Types ( CInt, CSize )
import Foreign.Marshal.Alloc ( allocaBytes )
import Foreign.Marshal.Array ( pokeArray, pokeArray0 )
import Foreign.Ptr ( Ptr, castPtr, plusPtr )
import Foreign.Storable ( Storable(..) )

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

type HostAddress = Word32


{-# LINE 113 "Network\Socket\Internal.hsc" #-}

------------------------------------------------------------------------
-- Port Numbers
--
-- newtyped to prevent accidental use of sane-looking
-- port numbers that haven't actually been converted to
-- network-byte-order first.
--

newtype PortNumber = PortNum Word16 deriving ( Eq, Ord )

------------------------------------------------------------------------
-- 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 148 "Network\Socket\Internal.hsc" #-}

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

{-# LINE 160 "Network\Socket\Internal.hsc" #-}

{-# LINE 164 "Network\Socket\Internal.hsc" #-}
  deriving (Eq)


{-# LINE 167 "Network\Socket\Internal.hsc" #-}
type CSaFamily = (Word16)
{-# LINE 168 "Network\Socket\Internal.hsc" #-}

{-# LINE 173 "Network\Socket\Internal.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 184 "Network\Socket\Internal.hsc" #-}
sizeOfSockAddr (SockAddrInet _ _) = 16
{-# LINE 185 "Network\Socket\Internal.hsc" #-}

{-# LINE 188 "Network\Socket\Internal.hsc" #-}

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

{-# LINE 195 "Network\Socket\Internal.hsc" #-}

{-# LINE 198 "Network\Socket\Internal.hsc" #-}
sizeOfSockAddrByFamily AF_INET  = 16
{-# LINE 199 "Network\Socket\Internal.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 236 "Network\Socket\Internal.hsc" #-}
pokeSockAddr p (SockAddrInet (PortNum port) addr) = do

{-# LINE 240 "Network\Socket\Internal.hsc" #-}

{-# LINE 243 "Network\Socket\Internal.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p ((2) :: CSaFamily)
{-# LINE 244 "Network\Socket\Internal.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 2)) p port
{-# LINE 245 "Network\Socket\Internal.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) p addr
{-# LINE 246 "Network\Socket\Internal.hsc" #-}

{-# LINE 260 "Network\Socket\Internal.hsc" #-}

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

{-# LINE 271 "Network\Socket\Internal.hsc" #-}
    (2) -> do
{-# LINE 272 "Network\Socket\Internal.hsc" #-}
        addr <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) p
{-# LINE 273 "Network\Socket\Internal.hsc" #-}
        port <- ((\hsc_ptr -> peekByteOff hsc_ptr 2)) p
{-# LINE 274 "Network\Socket\Internal.hsc" #-}
        return (SockAddrInet (PortNum port) addr)

{-# LINE 283 "Network\Socket\Internal.hsc" #-}

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

-- | This data type might have different constructors depending on
-- what is supported by the operating system.
data Family
    = AF_UNSPEC           -- unspecified

{-# LINE 292 "Network\Socket\Internal.hsc" #-}
    | AF_UNIX             -- local to host (pipes, portals

{-# LINE 294 "Network\Socket\Internal.hsc" #-}

{-# LINE 295 "Network\Socket\Internal.hsc" #-}
    | AF_INET             -- internetwork: UDP, TCP, etc

{-# LINE 297 "Network\Socket\Internal.hsc" #-}

{-# LINE 298 "Network\Socket\Internal.hsc" #-}
    | AF_INET6            -- Internet Protocol version 6

{-# LINE 300 "Network\Socket\Internal.hsc" #-}

{-# LINE 301 "Network\Socket\Internal.hsc" #-}
    | AF_IMPLINK          -- arpanet imp addresses

{-# LINE 303 "Network\Socket\Internal.hsc" #-}

{-# LINE 304 "Network\Socket\Internal.hsc" #-}
    | AF_PUP              -- pup protocols: e.g. BSP

{-# LINE 306 "Network\Socket\Internal.hsc" #-}

{-# LINE 307 "Network\Socket\Internal.hsc" #-}
    | AF_CHAOS            -- mit CHAOS protocols

{-# LINE 309 "Network\Socket\Internal.hsc" #-}

{-# LINE 310 "Network\Socket\Internal.hsc" #-}
    | AF_NS               -- XEROX NS protocols

{-# LINE 312 "Network\Socket\Internal.hsc" #-}

{-# LINE 315 "Network\Socket\Internal.hsc" #-}

{-# LINE 316 "Network\Socket\Internal.hsc" #-}
    | AF_ECMA             -- european computer manufacturers

{-# LINE 318 "Network\Socket\Internal.hsc" #-}

{-# LINE 319 "Network\Socket\Internal.hsc" #-}
    | AF_DATAKIT          -- datakit protocols

{-# LINE 321 "Network\Socket\Internal.hsc" #-}

{-# LINE 322 "Network\Socket\Internal.hsc" #-}
    | AF_CCITT            -- CCITT protocols, X.25 etc

{-# LINE 324 "Network\Socket\Internal.hsc" #-}

{-# LINE 325 "Network\Socket\Internal.hsc" #-}
    | AF_SNA              -- IBM SNA

{-# LINE 327 "Network\Socket\Internal.hsc" #-}

{-# LINE 328 "Network\Socket\Internal.hsc" #-}
    | AF_DECnet           -- DECnet

{-# LINE 330 "Network\Socket\Internal.hsc" #-}

{-# LINE 331 "Network\Socket\Internal.hsc" #-}
    | AF_DLI              -- Direct data link interface

{-# LINE 333 "Network\Socket\Internal.hsc" #-}

{-# LINE 334 "Network\Socket\Internal.hsc" #-}
    | AF_LAT              -- LAT

{-# LINE 336 "Network\Socket\Internal.hsc" #-}

{-# LINE 337 "Network\Socket\Internal.hsc" #-}
    | AF_HYLINK           -- NSC Hyperchannel

{-# LINE 339 "Network\Socket\Internal.hsc" #-}

{-# LINE 340 "Network\Socket\Internal.hsc" #-}
    | AF_APPLETALK        -- Apple Talk

{-# LINE 342 "Network\Socket\Internal.hsc" #-}

{-# LINE 345 "Network\Socket\Internal.hsc" #-}

{-# LINE 346 "Network\Socket\Internal.hsc" #-}
    | AF_NETBIOS          -- NetBios-style addresses

{-# LINE 348 "Network\Socket\Internal.hsc" #-}

{-# LINE 351 "Network\Socket\Internal.hsc" #-}

{-# LINE 354 "Network\Socket\Internal.hsc" #-}

{-# LINE 355 "Network\Socket\Internal.hsc" #-}
    | AF_ISO              -- ISO protocols

{-# LINE 357 "Network\Socket\Internal.hsc" #-}

{-# LINE 358 "Network\Socket\Internal.hsc" #-}
    | AF_OSI              -- umbrella of all families used by OSI

{-# LINE 360 "Network\Socket\Internal.hsc" #-}

{-# LINE 363 "Network\Socket\Internal.hsc" #-}

{-# LINE 366 "Network\Socket\Internal.hsc" #-}

{-# LINE 369 "Network\Socket\Internal.hsc" #-}

{-# LINE 372 "Network\Socket\Internal.hsc" #-}

{-# LINE 375 "Network\Socket\Internal.hsc" #-}

{-# LINE 376 "Network\Socket\Internal.hsc" #-}
    | AF_IPX              -- Novell Internet Protocol

{-# LINE 378 "Network\Socket\Internal.hsc" #-}

{-# LINE 381 "Network\Socket\Internal.hsc" #-}

{-# LINE 384 "Network\Socket\Internal.hsc" #-}

{-# LINE 387 "Network\Socket\Internal.hsc" #-}

{-# LINE 390 "Network\Socket\Internal.hsc" #-}

{-# LINE 393 "Network\Socket\Internal.hsc" #-}

{-# LINE 396 "Network\Socket\Internal.hsc" #-}

{-# LINE 399 "Network\Socket\Internal.hsc" #-}

{-# LINE 402 "Network\Socket\Internal.hsc" #-}

{-# LINE 405 "Network\Socket\Internal.hsc" #-}

{-# LINE 408 "Network\Socket\Internal.hsc" #-}

{-# LINE 411 "Network\Socket\Internal.hsc" #-}

{-# LINE 414 "Network\Socket\Internal.hsc" #-}

{-# LINE 417 "Network\Socket\Internal.hsc" #-}

{-# LINE 420 "Network\Socket\Internal.hsc" #-}

{-# LINE 423 "Network\Socket\Internal.hsc" #-}

{-# LINE 426 "Network\Socket\Internal.hsc" #-}

{-# LINE 429 "Network\Socket\Internal.hsc" #-}

{-# LINE 432 "Network\Socket\Internal.hsc" #-}

{-# LINE 435 "Network\Socket\Internal.hsc" #-}

{-# LINE 438 "Network\Socket\Internal.hsc" #-}

{-# LINE 441 "Network\Socket\Internal.hsc" #-}

{-# LINE 444 "Network\Socket\Internal.hsc" #-}

{-# LINE 447 "Network\Socket\Internal.hsc" #-}

{-# LINE 450 "Network\Socket\Internal.hsc" #-}

{-# LINE 453 "Network\Socket\Internal.hsc" #-}

{-# LINE 456 "Network\Socket\Internal.hsc" #-}

{-# LINE 459 "Network\Socket\Internal.hsc" #-}

{-# LINE 462 "Network\Socket\Internal.hsc" #-}

{-# LINE 465 "Network\Socket\Internal.hsc" #-}

{-# LINE 468 "Network\Socket\Internal.hsc" #-}

{-# LINE 471 "Network\Socket\Internal.hsc" #-}

{-# LINE 474 "Network\Socket\Internal.hsc" #-}

{-# LINE 477 "Network\Socket\Internal.hsc" #-}

{-# LINE 480 "Network\Socket\Internal.hsc" #-}

{-# LINE 483 "Network\Socket\Internal.hsc" #-}
      deriving (Eq, Ord, Read, Show)

------------------------------------------------------------------------
-- 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)