{-# LINE 1 "Network/Socket/Types.hsc" #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
#include "HsNetDef.h"
module Network.Socket.Types (
Socket
, fdSocket
, mkSocket
, invalidateSocket
, close
, close'
, c_close
, SocketType(..)
, isSupportedSocketType
, packSocketType
, packSocketType'
, packSocketTypeOrThrow
, unpackSocketType
, unpackSocketType'
, Family(..)
, isSupportedFamily
, packFamily
, unpackFamily
, SocketAddress(..)
, withSocketAddress
, withNewSocketAddress
, SockAddr(..)
, isSupportedSockAddr
, HostAddress
, hostAddressToTuple
, tupleToHostAddress
, HostAddress6
, hostAddress6ToTuple
, tupleToHostAddress6
, FlowInfo
, ScopeID
, peekSockAddr
, pokeSockAddr
, withSockAddr
, ProtocolNumber
, defaultProtocol
, PortNumber
, defaultPort
, zeroMemory
, htonl
, ntohl
) where
import Control.Monad (when)
import Data.IORef (IORef, newIORef, readIORef, atomicModifyIORef', mkWeakIORef)
import Foreign.C.Error (throwErrno)
import Foreign.Marshal.Alloc
import GHC.Conc (closeFdWith)
import System.Posix.Types (Fd)
import Control.DeepSeq (NFData (..))
{-# LINE 75 "Network/Socket/Types.hsc" #-}
import Foreign.Marshal.Array
{-# LINE 77 "Network/Socket/Types.hsc" #-}
import Network.Socket.Imports
data Socket = Socket !(IORef CInt) !CInt
instance Show Socket where
show (Socket _ ofd) = "<socket: " ++ show ofd ++ ">"
instance Eq Socket where
Socket ref1 _ == Socket ref2 _ = ref1 == ref2
fdSocket :: Socket -> IO CInt
fdSocket (Socket ref _) = readIORef ref
mkSocket :: CInt -> IO Socket
mkSocket fd = do
ref <- newIORef fd
let s = Socket ref fd
void $ mkWeakIORef ref $ close s
return s
invalidSocket :: CInt
{-# LINE 122 "Network/Socket/Types.hsc" #-}
invalidSocket = -1
{-# LINE 124 "Network/Socket/Types.hsc" #-}
invalidateSocket ::
Socket
-> (CInt -> IO a)
-> (CInt -> IO a)
-> IO a
invalidateSocket (Socket ref _) errorAction normalAction = do
oldfd <- atomicModifyIORef' ref $ \cur -> (invalidSocket, cur)
if oldfd == invalidSocket then errorAction oldfd else normalAction oldfd
close :: Socket -> IO ()
close s = invalidateSocket s (\_ -> return ()) $ \oldfd -> do
closeFdWith closeFd (toFd oldfd)
where
toFd :: CInt -> Fd
toFd = fromIntegral
closeFd :: Fd -> IO ()
closeFd = void . c_close . fromIntegral
close' :: Socket -> IO ()
close' s = invalidateSocket s (\_ -> return ()) $ \oldfd -> do
closeFdWith closeFd (toFd oldfd)
where
toFd :: CInt -> Fd
toFd = fromIntegral
closeFd :: Fd -> IO ()
closeFd fd = do
ret <- c_close $ fromIntegral fd
when (ret == -1) $ throwErrno "Network.Socket.close'"
{-# LINE 178 "Network/Socket/Types.hsc" #-}
foreign import ccall unsafe "close"
c_close :: CInt -> IO CInt
{-# LINE 181 "Network/Socket/Types.hsc" #-}
type ProtocolNumber = CInt
defaultProtocol :: ProtocolNumber
defaultProtocol = 0
data SocketType
= NoSocketType
| Stream
| Datagram
| Raw
| RDM
| SeqPacket
deriving (Eq, Ord, Read, Show, Typeable)
isSupportedSocketType :: SocketType -> Bool
isSupportedSocketType = isJust . packSocketType'
packSocketType' :: SocketType -> Maybe CInt
packSocketType' stype = case Just stype of
Just NoSocketType -> Just 0
{-# LINE 236 "Network/Socket/Types.hsc" #-}
Just Stream -> Just 1
{-# LINE 237 "Network/Socket/Types.hsc" #-}
{-# LINE 238 "Network/Socket/Types.hsc" #-}
{-# LINE 239 "Network/Socket/Types.hsc" #-}
Just Datagram -> Just 2
{-# LINE 240 "Network/Socket/Types.hsc" #-}
{-# LINE 241 "Network/Socket/Types.hsc" #-}
{-# LINE 242 "Network/Socket/Types.hsc" #-}
Just Raw -> Just 3
{-# LINE 243 "Network/Socket/Types.hsc" #-}
{-# LINE 244 "Network/Socket/Types.hsc" #-}
{-# LINE 245 "Network/Socket/Types.hsc" #-}
Just RDM -> Just 4
{-# LINE 246 "Network/Socket/Types.hsc" #-}
{-# LINE 247 "Network/Socket/Types.hsc" #-}
{-# LINE 248 "Network/Socket/Types.hsc" #-}
Just SeqPacket -> Just 5
{-# LINE 249 "Network/Socket/Types.hsc" #-}
{-# LINE 250 "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"]
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 271 "Network/Socket/Types.hsc" #-}
(1) -> Just Stream
{-# LINE 272 "Network/Socket/Types.hsc" #-}
{-# LINE 273 "Network/Socket/Types.hsc" #-}
{-# LINE 274 "Network/Socket/Types.hsc" #-}
(2) -> Just Datagram
{-# LINE 275 "Network/Socket/Types.hsc" #-}
{-# LINE 276 "Network/Socket/Types.hsc" #-}
{-# LINE 277 "Network/Socket/Types.hsc" #-}
(3) -> Just Raw
{-# LINE 278 "Network/Socket/Types.hsc" #-}
{-# LINE 279 "Network/Socket/Types.hsc" #-}
{-# LINE 280 "Network/Socket/Types.hsc" #-}
(4) -> Just RDM
{-# LINE 281 "Network/Socket/Types.hsc" #-}
{-# LINE 282 "Network/Socket/Types.hsc" #-}
{-# LINE 283 "Network/Socket/Types.hsc" #-}
(5) -> Just SeqPacket
{-# LINE 284 "Network/Socket/Types.hsc" #-}
{-# LINE 285 "Network/Socket/Types.hsc" #-}
_ -> Nothing
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"]
data Family
= AF_UNSPEC
| AF_UNIX
| AF_INET
| AF_INET6
| AF_IMPLINK
| AF_PUP
| AF_CHAOS
| AF_NS
| AF_NBS
| AF_ECMA
| AF_DATAKIT
| AF_CCITT
| AF_SNA
| AF_DECnet
| AF_DLI
| AF_LAT
| AF_HYLINK
| AF_APPLETALK
| AF_ROUTE
| AF_NETBIOS
| AF_NIT
| AF_802
| AF_ISO
| AF_OSI
| AF_NETMAN
| AF_X25
| AF_AX25
| AF_OSINET
| AF_GOSSIP
| AF_IPX
| Pseudo_AF_XTP
| AF_CTF
| AF_WAN
| AF_SDL
| AF_NETWARE
| AF_NDD
| AF_INTF
| AF_COIP
| AF_CNT
| Pseudo_AF_RTIP
| Pseudo_AF_PIP
| AF_SIP
| AF_ISDN
| Pseudo_AF_KEY
| AF_NATM
| AF_ARP
| Pseudo_AF_HDRCMPLT
| AF_ENCAP
| AF_LINK
| AF_RAW
| AF_RIF
| AF_NETROM
| AF_BRIDGE
| AF_ATMPVC
| AF_ROSE
| AF_NETBEUI
| AF_SECURITY
| AF_PACKET
| AF_ASH
| AF_ECONET
| AF_ATMSVC
| AF_IRDA
| AF_PPPOX
| AF_WANPIPE
| AF_BLUETOOTH
| AF_CAN
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
isSupportedFamily :: Family -> Bool
isSupportedFamily = isJust . packFamily'
packFamily' :: Family -> Maybe CInt
packFamily' f = case Just f of
Just AF_UNSPEC -> Just 0
{-# LINE 389 "Network/Socket/Types.hsc" #-}
{-# LINE 390 "Network/Socket/Types.hsc" #-}
Just AF_UNIX -> Just 1
{-# LINE 391 "Network/Socket/Types.hsc" #-}
{-# LINE 392 "Network/Socket/Types.hsc" #-}
{-# LINE 393 "Network/Socket/Types.hsc" #-}
Just AF_INET -> Just 2
{-# LINE 394 "Network/Socket/Types.hsc" #-}
{-# LINE 395 "Network/Socket/Types.hsc" #-}
{-# LINE 396 "Network/Socket/Types.hsc" #-}
Just AF_INET6 -> Just 10
{-# LINE 397 "Network/Socket/Types.hsc" #-}
{-# LINE 398 "Network/Socket/Types.hsc" #-}
{-# LINE 401 "Network/Socket/Types.hsc" #-}
{-# LINE 404 "Network/Socket/Types.hsc" #-}
{-# LINE 407 "Network/Socket/Types.hsc" #-}
{-# LINE 410 "Network/Socket/Types.hsc" #-}
{-# LINE 413 "Network/Socket/Types.hsc" #-}
{-# LINE 416 "Network/Socket/Types.hsc" #-}
{-# LINE 419 "Network/Socket/Types.hsc" #-}
{-# LINE 422 "Network/Socket/Types.hsc" #-}
{-# LINE 423 "Network/Socket/Types.hsc" #-}
Just AF_SNA -> Just 22
{-# LINE 424 "Network/Socket/Types.hsc" #-}
{-# LINE 425 "Network/Socket/Types.hsc" #-}
{-# LINE 426 "Network/Socket/Types.hsc" #-}
Just AF_DECnet -> Just 12
{-# LINE 427 "Network/Socket/Types.hsc" #-}
{-# LINE 428 "Network/Socket/Types.hsc" #-}
{-# LINE 431 "Network/Socket/Types.hsc" #-}
{-# LINE 434 "Network/Socket/Types.hsc" #-}
{-# LINE 437 "Network/Socket/Types.hsc" #-}
{-# LINE 438 "Network/Socket/Types.hsc" #-}
Just AF_APPLETALK -> Just 5
{-# LINE 439 "Network/Socket/Types.hsc" #-}
{-# LINE 440 "Network/Socket/Types.hsc" #-}
{-# LINE 441 "Network/Socket/Types.hsc" #-}
Just AF_ROUTE -> Just 16
{-# LINE 442 "Network/Socket/Types.hsc" #-}
{-# LINE 443 "Network/Socket/Types.hsc" #-}
{-# LINE 446 "Network/Socket/Types.hsc" #-}
{-# LINE 449 "Network/Socket/Types.hsc" #-}
{-# LINE 452 "Network/Socket/Types.hsc" #-}
{-# LINE 455 "Network/Socket/Types.hsc" #-}
{-# LINE 458 "Network/Socket/Types.hsc" #-}
{-# LINE 461 "Network/Socket/Types.hsc" #-}
{-# LINE 462 "Network/Socket/Types.hsc" #-}
Just AF_X25 -> Just 9
{-# LINE 463 "Network/Socket/Types.hsc" #-}
{-# LINE 464 "Network/Socket/Types.hsc" #-}
{-# LINE 465 "Network/Socket/Types.hsc" #-}
Just AF_AX25 -> Just 3
{-# LINE 466 "Network/Socket/Types.hsc" #-}
{-# LINE 467 "Network/Socket/Types.hsc" #-}
{-# LINE 470 "Network/Socket/Types.hsc" #-}
{-# LINE 473 "Network/Socket/Types.hsc" #-}
{-# LINE 474 "Network/Socket/Types.hsc" #-}
Just AF_IPX -> Just 4
{-# LINE 475 "Network/Socket/Types.hsc" #-}
{-# LINE 476 "Network/Socket/Types.hsc" #-}
{-# LINE 479 "Network/Socket/Types.hsc" #-}
{-# LINE 482 "Network/Socket/Types.hsc" #-}
{-# LINE 485 "Network/Socket/Types.hsc" #-}
{-# LINE 488 "Network/Socket/Types.hsc" #-}
{-# LINE 491 "Network/Socket/Types.hsc" #-}
{-# LINE 494 "Network/Socket/Types.hsc" #-}
{-# LINE 497 "Network/Socket/Types.hsc" #-}
{-# LINE 500 "Network/Socket/Types.hsc" #-}
{-# LINE 503 "Network/Socket/Types.hsc" #-}
{-# LINE 506 "Network/Socket/Types.hsc" #-}
{-# LINE 509 "Network/Socket/Types.hsc" #-}
{-# LINE 512 "Network/Socket/Types.hsc" #-}
{-# LINE 513 "Network/Socket/Types.hsc" #-}
Just AF_ISDN -> Just 34
{-# LINE 514 "Network/Socket/Types.hsc" #-}
{-# LINE 515 "Network/Socket/Types.hsc" #-}
{-# LINE 518 "Network/Socket/Types.hsc" #-}
{-# LINE 521 "Network/Socket/Types.hsc" #-}
{-# LINE 524 "Network/Socket/Types.hsc" #-}
{-# LINE 527 "Network/Socket/Types.hsc" #-}
{-# LINE 530 "Network/Socket/Types.hsc" #-}
{-# LINE 533 "Network/Socket/Types.hsc" #-}
{-# LINE 536 "Network/Socket/Types.hsc" #-}
{-# LINE 539 "Network/Socket/Types.hsc" #-}
{-# LINE 540 "Network/Socket/Types.hsc" #-}
Just AF_NETROM -> Just 6
{-# LINE 541 "Network/Socket/Types.hsc" #-}
{-# LINE 542 "Network/Socket/Types.hsc" #-}
{-# LINE 543 "Network/Socket/Types.hsc" #-}
Just AF_BRIDGE -> Just 7
{-# LINE 544 "Network/Socket/Types.hsc" #-}
{-# LINE 545 "Network/Socket/Types.hsc" #-}
{-# LINE 546 "Network/Socket/Types.hsc" #-}
Just AF_ATMPVC -> Just 8
{-# LINE 547 "Network/Socket/Types.hsc" #-}
{-# LINE 548 "Network/Socket/Types.hsc" #-}
{-# LINE 549 "Network/Socket/Types.hsc" #-}
Just AF_ROSE -> Just 11
{-# LINE 550 "Network/Socket/Types.hsc" #-}
{-# LINE 551 "Network/Socket/Types.hsc" #-}
{-# LINE 552 "Network/Socket/Types.hsc" #-}
Just AF_NETBEUI -> Just 13
{-# LINE 553 "Network/Socket/Types.hsc" #-}
{-# LINE 554 "Network/Socket/Types.hsc" #-}
{-# LINE 555 "Network/Socket/Types.hsc" #-}
Just AF_SECURITY -> Just 14
{-# LINE 556 "Network/Socket/Types.hsc" #-}
{-# LINE 557 "Network/Socket/Types.hsc" #-}
{-# LINE 558 "Network/Socket/Types.hsc" #-}
Just AF_PACKET -> Just 17
{-# LINE 559 "Network/Socket/Types.hsc" #-}
{-# LINE 560 "Network/Socket/Types.hsc" #-}
{-# LINE 561 "Network/Socket/Types.hsc" #-}
Just AF_ASH -> Just 18
{-# LINE 562 "Network/Socket/Types.hsc" #-}
{-# LINE 563 "Network/Socket/Types.hsc" #-}
{-# LINE 564 "Network/Socket/Types.hsc" #-}
Just AF_ECONET -> Just 19
{-# LINE 565 "Network/Socket/Types.hsc" #-}
{-# LINE 566 "Network/Socket/Types.hsc" #-}
{-# LINE 567 "Network/Socket/Types.hsc" #-}
Just AF_ATMSVC -> Just 20
{-# LINE 568 "Network/Socket/Types.hsc" #-}
{-# LINE 569 "Network/Socket/Types.hsc" #-}
{-# LINE 570 "Network/Socket/Types.hsc" #-}
Just AF_IRDA -> Just 23
{-# LINE 571 "Network/Socket/Types.hsc" #-}
{-# LINE 572 "Network/Socket/Types.hsc" #-}
{-# LINE 573 "Network/Socket/Types.hsc" #-}
Just AF_PPPOX -> Just 24
{-# LINE 574 "Network/Socket/Types.hsc" #-}
{-# LINE 575 "Network/Socket/Types.hsc" #-}
{-# LINE 576 "Network/Socket/Types.hsc" #-}
Just AF_WANPIPE -> Just 25
{-# LINE 577 "Network/Socket/Types.hsc" #-}
{-# LINE 578 "Network/Socket/Types.hsc" #-}
{-# LINE 579 "Network/Socket/Types.hsc" #-}
Just AF_BLUETOOTH -> Just 31
{-# LINE 580 "Network/Socket/Types.hsc" #-}
{-# LINE 581 "Network/Socket/Types.hsc" #-}
{-# LINE 582 "Network/Socket/Types.hsc" #-}
Just AF_CAN -> Just 29
{-# LINE 583 "Network/Socket/Types.hsc" #-}
{-# LINE 584 "Network/Socket/Types.hsc" #-}
_ -> Nothing
unpackFamily :: CInt -> Family
unpackFamily f = case f of
(0) -> AF_UNSPEC
{-# LINE 592 "Network/Socket/Types.hsc" #-}
{-# LINE 593 "Network/Socket/Types.hsc" #-}
(1) -> AF_UNIX
{-# LINE 594 "Network/Socket/Types.hsc" #-}
{-# LINE 595 "Network/Socket/Types.hsc" #-}
{-# LINE 596 "Network/Socket/Types.hsc" #-}
(2) -> AF_INET
{-# LINE 597 "Network/Socket/Types.hsc" #-}
{-# LINE 598 "Network/Socket/Types.hsc" #-}
{-# LINE 599 "Network/Socket/Types.hsc" #-}
(10) -> AF_INET6
{-# LINE 600 "Network/Socket/Types.hsc" #-}
{-# LINE 601 "Network/Socket/Types.hsc" #-}
{-# LINE 604 "Network/Socket/Types.hsc" #-}
{-# LINE 607 "Network/Socket/Types.hsc" #-}
{-# LINE 610 "Network/Socket/Types.hsc" #-}
{-# LINE 613 "Network/Socket/Types.hsc" #-}
{-# LINE 616 "Network/Socket/Types.hsc" #-}
{-# LINE 619 "Network/Socket/Types.hsc" #-}
{-# LINE 622 "Network/Socket/Types.hsc" #-}
{-# LINE 625 "Network/Socket/Types.hsc" #-}
{-# LINE 626 "Network/Socket/Types.hsc" #-}
(22) -> AF_SNA
{-# LINE 627 "Network/Socket/Types.hsc" #-}
{-# LINE 628 "Network/Socket/Types.hsc" #-}
{-# LINE 629 "Network/Socket/Types.hsc" #-}
(12) -> AF_DECnet
{-# LINE 630 "Network/Socket/Types.hsc" #-}
{-# LINE 631 "Network/Socket/Types.hsc" #-}
{-# LINE 634 "Network/Socket/Types.hsc" #-}
{-# LINE 637 "Network/Socket/Types.hsc" #-}
{-# LINE 640 "Network/Socket/Types.hsc" #-}
{-# LINE 641 "Network/Socket/Types.hsc" #-}
(5) -> AF_APPLETALK
{-# LINE 642 "Network/Socket/Types.hsc" #-}
{-# LINE 643 "Network/Socket/Types.hsc" #-}
{-# LINE 644 "Network/Socket/Types.hsc" #-}
(16) -> AF_ROUTE
{-# LINE 645 "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 663 "Network/Socket/Types.hsc" #-}
{-# LINE 666 "Network/Socket/Types.hsc" #-}
{-# LINE 667 "Network/Socket/Types.hsc" #-}
(9) -> AF_X25
{-# LINE 668 "Network/Socket/Types.hsc" #-}
{-# LINE 669 "Network/Socket/Types.hsc" #-}
{-# LINE 670 "Network/Socket/Types.hsc" #-}
(3) -> AF_AX25
{-# LINE 671 "Network/Socket/Types.hsc" #-}
{-# LINE 672 "Network/Socket/Types.hsc" #-}
{-# LINE 675 "Network/Socket/Types.hsc" #-}
{-# LINE 678 "Network/Socket/Types.hsc" #-}
{-# LINE 679 "Network/Socket/Types.hsc" #-}
(4) -> AF_IPX
{-# LINE 680 "Network/Socket/Types.hsc" #-}
{-# LINE 681 "Network/Socket/Types.hsc" #-}
{-# LINE 684 "Network/Socket/Types.hsc" #-}
{-# LINE 687 "Network/Socket/Types.hsc" #-}
{-# LINE 690 "Network/Socket/Types.hsc" #-}
{-# LINE 693 "Network/Socket/Types.hsc" #-}
{-# LINE 696 "Network/Socket/Types.hsc" #-}
{-# LINE 699 "Network/Socket/Types.hsc" #-}
{-# LINE 702 "Network/Socket/Types.hsc" #-}
{-# LINE 705 "Network/Socket/Types.hsc" #-}
{-# LINE 708 "Network/Socket/Types.hsc" #-}
{-# LINE 711 "Network/Socket/Types.hsc" #-}
{-# LINE 714 "Network/Socket/Types.hsc" #-}
{-# LINE 717 "Network/Socket/Types.hsc" #-}
{-# LINE 718 "Network/Socket/Types.hsc" #-}
(34) -> AF_ISDN
{-# LINE 719 "Network/Socket/Types.hsc" #-}
{-# LINE 720 "Network/Socket/Types.hsc" #-}
{-# LINE 723 "Network/Socket/Types.hsc" #-}
{-# LINE 726 "Network/Socket/Types.hsc" #-}
{-# LINE 729 "Network/Socket/Types.hsc" #-}
{-# LINE 732 "Network/Socket/Types.hsc" #-}
{-# LINE 735 "Network/Socket/Types.hsc" #-}
{-# LINE 738 "Network/Socket/Types.hsc" #-}
{-# LINE 741 "Network/Socket/Types.hsc" #-}
{-# LINE 744 "Network/Socket/Types.hsc" #-}
{-# LINE 745 "Network/Socket/Types.hsc" #-}
(6) -> AF_NETROM
{-# LINE 746 "Network/Socket/Types.hsc" #-}
{-# LINE 747 "Network/Socket/Types.hsc" #-}
{-# LINE 748 "Network/Socket/Types.hsc" #-}
(7) -> AF_BRIDGE
{-# LINE 749 "Network/Socket/Types.hsc" #-}
{-# LINE 750 "Network/Socket/Types.hsc" #-}
{-# LINE 751 "Network/Socket/Types.hsc" #-}
(8) -> AF_ATMPVC
{-# LINE 752 "Network/Socket/Types.hsc" #-}
{-# LINE 753 "Network/Socket/Types.hsc" #-}
{-# LINE 754 "Network/Socket/Types.hsc" #-}
(11) -> AF_ROSE
{-# LINE 755 "Network/Socket/Types.hsc" #-}
{-# LINE 756 "Network/Socket/Types.hsc" #-}
{-# LINE 757 "Network/Socket/Types.hsc" #-}
(13) -> AF_NETBEUI
{-# LINE 758 "Network/Socket/Types.hsc" #-}
{-# LINE 759 "Network/Socket/Types.hsc" #-}
{-# LINE 760 "Network/Socket/Types.hsc" #-}
(14) -> AF_SECURITY
{-# LINE 761 "Network/Socket/Types.hsc" #-}
{-# LINE 762 "Network/Socket/Types.hsc" #-}
{-# LINE 763 "Network/Socket/Types.hsc" #-}
(17) -> AF_PACKET
{-# LINE 764 "Network/Socket/Types.hsc" #-}
{-# LINE 765 "Network/Socket/Types.hsc" #-}
{-# LINE 766 "Network/Socket/Types.hsc" #-}
(18) -> AF_ASH
{-# LINE 767 "Network/Socket/Types.hsc" #-}
{-# LINE 768 "Network/Socket/Types.hsc" #-}
{-# LINE 769 "Network/Socket/Types.hsc" #-}
(19) -> AF_ECONET
{-# LINE 770 "Network/Socket/Types.hsc" #-}
{-# LINE 771 "Network/Socket/Types.hsc" #-}
{-# LINE 772 "Network/Socket/Types.hsc" #-}
(20) -> AF_ATMSVC
{-# LINE 773 "Network/Socket/Types.hsc" #-}
{-# LINE 774 "Network/Socket/Types.hsc" #-}
{-# LINE 775 "Network/Socket/Types.hsc" #-}
(23) -> AF_IRDA
{-# LINE 776 "Network/Socket/Types.hsc" #-}
{-# LINE 777 "Network/Socket/Types.hsc" #-}
{-# LINE 778 "Network/Socket/Types.hsc" #-}
(24) -> AF_PPPOX
{-# LINE 779 "Network/Socket/Types.hsc" #-}
{-# LINE 780 "Network/Socket/Types.hsc" #-}
{-# LINE 781 "Network/Socket/Types.hsc" #-}
(25) -> AF_WANPIPE
{-# LINE 782 "Network/Socket/Types.hsc" #-}
{-# LINE 783 "Network/Socket/Types.hsc" #-}
{-# LINE 784 "Network/Socket/Types.hsc" #-}
(31) -> AF_BLUETOOTH
{-# LINE 785 "Network/Socket/Types.hsc" #-}
{-# LINE 786 "Network/Socket/Types.hsc" #-}
{-# LINE 787 "Network/Socket/Types.hsc" #-}
(29) -> AF_CAN
{-# LINE 788 "Network/Socket/Types.hsc" #-}
{-# LINE 789 "Network/Socket/Types.hsc" #-}
unknown -> error $
"Network.Socket.Types.unpackFamily: unknown address family: " ++
show unknown
newtype PortNumber = PortNum Word16 deriving (Eq, Ord, Typeable, Num, Enum, Real, Integral)
instance Show PortNumber where
showsPrec p (PortNum pn) = showsPrec p (fromIntegral pn :: Int)
instance Read PortNumber where
readsPrec n = map (\(x,y) -> (fromIntegral (x :: Int), y)) . readsPrec n
foreign import CALLCONV unsafe "ntohs" ntohs :: Word16 -> Word16
foreign import CALLCONV unsafe "htons" htons :: Word16 -> Word16
foreign import CALLCONV unsafe "htonl" htonl :: Word32 -> Word32
foreign import CALLCONV unsafe "ntohl" ntohl :: Word32 -> Word32
{-# DEPRECATED htonl "Use getAddrInfo instead" #-}
{-# DEPRECATED ntohl "Use getAddrInfo instead" #-}
instance Storable PortNumber where
sizeOf _ = sizeOf (undefined :: Word16)
alignment _ = alignment (undefined :: Word16)
poke p (PortNum po) = poke (castPtr p) (htons po)
peek p = PortNum . ntohs <$> peek (castPtr p)
defaultPort :: PortNumber
defaultPort = 0
class SocketAddress sa where
sizeOfSocketAddress :: sa -> Int
peekSocketAddress :: Ptr sa -> IO sa
pokeSocketAddress :: Ptr a -> sa -> IO ()
sockaddrStorageLen :: Int
sockaddrStorageLen = 128
withSocketAddress :: SocketAddress sa => sa -> (Ptr sa -> Int -> IO a) -> IO a
withSocketAddress addr f = do
let sz = sizeOfSocketAddress addr
allocaBytes sz $ \p -> pokeSocketAddress p addr >> f (castPtr p) sz
withNewSocketAddress :: SocketAddress sa => (Ptr sa -> Int -> IO a) -> IO a
withNewSocketAddress f = allocaBytes sockaddrStorageLen $ \ptr -> do
zeroMemory ptr $ fromIntegral sockaddrStorageLen
f ptr sockaddrStorageLen
type FlowInfo = Word32
type ScopeID = Word32
data SockAddr
= SockAddrInet
!PortNumber
!HostAddress
| SockAddrInet6
!PortNumber
!FlowInfo
!HostAddress6
!ScopeID
| SockAddrUnix
String
deriving (Eq, Ord, Typeable)
instance NFData SockAddr where
rnf (SockAddrInet _ _) = ()
rnf (SockAddrInet6 _ _ _ _) = ()
rnf (SockAddrUnix str) = rnf str
isSupportedSockAddr :: SockAddr -> Bool
isSupportedSockAddr addr = case addr of
SockAddrInet{} -> True
SockAddrInet6{} -> True
{-# LINE 921 "Network/Socket/Types.hsc" #-}
SockAddrUnix{} -> True
{-# LINE 925 "Network/Socket/Types.hsc" #-}
instance SocketAddress SockAddr where
sizeOfSocketAddress = sizeOfSockAddr
peekSocketAddress = peekSockAddr
pokeSocketAddress = pokeSockAddr
{-# LINE 936 "Network/Socket/Types.hsc" #-}
type CSaFamily = (Word16)
{-# LINE 937 "Network/Socket/Types.hsc" #-}
{-# LINE 938 "Network/Socket/Types.hsc" #-}
sizeOfSockAddr :: SockAddr -> Int
{-# LINE 944 "Network/Socket/Types.hsc" #-}
sizeOfSockAddr SockAddrUnix{} = 110
{-# LINE 945 "Network/Socket/Types.hsc" #-}
{-# LINE 948 "Network/Socket/Types.hsc" #-}
sizeOfSockAddr SockAddrInet{} = 16
{-# LINE 949 "Network/Socket/Types.hsc" #-}
sizeOfSockAddr SockAddrInet6{} = 28
{-# LINE 950 "Network/Socket/Types.hsc" #-}
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
{-# LINE 963 "Network/Socket/Types.hsc" #-}
unixPathMax :: Int
unixPathMax = 108
{-# LINE 965 "Network/Socket/Types.hsc" #-}
{-# LINE 966 "Network/Socket/Types.hsc" #-}
pokeSockAddr :: Ptr a -> SockAddr -> IO ()
{-# LINE 977 "Network/Socket/Types.hsc" #-}
pokeSockAddr p sa@(SockAddrUnix path) = do
when (length path > unixPathMax) $ error "pokeSockAddr: path is too long"
zeroMemory p $ fromIntegral $ sizeOfSockAddr sa
{-# LINE 983 "Network/Socket/Types.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p ((1) :: CSaFamily)
{-# LINE 984 "Network/Socket/Types.hsc" #-}
let pathC = map castCharToCChar path
pokeArray (((\hsc_ptr -> hsc_ptr `plusPtr` 2)) p) pathC
{-# LINE 987 "Network/Socket/Types.hsc" #-}
{-# LINE 990 "Network/Socket/Types.hsc" #-}
pokeSockAddr p (SockAddrInet port addr) = do
zeroMemory p (16)
{-# LINE 992 "Network/Socket/Types.hsc" #-}
{-# LINE 995 "Network/Socket/Types.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p ((2) :: CSaFamily)
{-# LINE 996 "Network/Socket/Types.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 2)) p port
{-# LINE 997 "Network/Socket/Types.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 4)) p addr
{-# LINE 998 "Network/Socket/Types.hsc" #-}
pokeSockAddr p (SockAddrInet6 port flow addr scope) = do
zeroMemory p (28)
{-# LINE 1000 "Network/Socket/Types.hsc" #-}
{-# LINE 1003 "Network/Socket/Types.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p ((10) :: CSaFamily)
{-# LINE 1004 "Network/Socket/Types.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 2)) p port
{-# LINE 1005 "Network/Socket/Types.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 4)) p flow
{-# LINE 1006 "Network/Socket/Types.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) p (In6Addr addr)
{-# LINE 1007 "Network/Socket/Types.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 24)) p scope
{-# LINE 1008 "Network/Socket/Types.hsc" #-}
peekSockAddr :: Ptr SockAddr -> IO SockAddr
peekSockAddr p = do
family <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p
{-# LINE 1013 "Network/Socket/Types.hsc" #-}
case family :: CSaFamily of
{-# LINE 1015 "Network/Socket/Types.hsc" #-}
(1) -> do
{-# LINE 1016 "Network/Socket/Types.hsc" #-}
str <- peekCAString (((\hsc_ptr -> hsc_ptr `plusPtr` 2)) p)
{-# LINE 1017 "Network/Socket/Types.hsc" #-}
return (SockAddrUnix str)
{-# LINE 1019 "Network/Socket/Types.hsc" #-}
(2) -> do
{-# LINE 1020 "Network/Socket/Types.hsc" #-}
addr <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) p
{-# LINE 1021 "Network/Socket/Types.hsc" #-}
port <- ((\hsc_ptr -> peekByteOff hsc_ptr 2)) p
{-# LINE 1022 "Network/Socket/Types.hsc" #-}
return (SockAddrInet port addr)
(10) -> do
{-# LINE 1024 "Network/Socket/Types.hsc" #-}
port <- ((\hsc_ptr -> peekByteOff hsc_ptr 2)) p
{-# LINE 1025 "Network/Socket/Types.hsc" #-}
flow <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) p
{-# LINE 1026 "Network/Socket/Types.hsc" #-}
In6Addr addr <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p
{-# LINE 1027 "Network/Socket/Types.hsc" #-}
scope <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) p
{-# LINE 1028 "Network/Socket/Types.hsc" #-}
return (SockAddrInet6 port flow addr scope)
_ -> ioError $ userError $
"Network.Socket.Types.peekSockAddr: address family '" ++
show family ++ "' not supported."
type HostAddress = Word32
hostAddressToTuple :: HostAddress -> (Word8, Word8, Word8, Word8)
hostAddressToTuple ha' =
let ha = htonl ha'
byte i = fromIntegral (ha `shiftR` i) :: Word8
in (byte 24, byte 16, byte 8, byte 0)
tupleToHostAddress :: (Word8, Word8, Word8, Word8) -> HostAddress
tupleToHostAddress (b3, b2, b1, b0) =
let x `sl` i = fromIntegral x `shiftL` i :: Word32
in ntohl $ (b3 `sl` 24) .|. (b2 `sl` 16) .|. (b1 `sl` 8) .|. (b0 `sl` 0)
type HostAddress6 = (Word32, Word32, Word32, Word32)
hostAddress6ToTuple :: HostAddress6 -> (Word16, Word16, Word16, Word16,
Word16, Word16, Word16, Word16)
hostAddress6ToTuple (w3, w2, w1, w0) =
let high, low :: Word32 -> Word16
high w = fromIntegral (w `shiftR` 16)
low w = fromIntegral w
in (high w3, low w3, high w2, low w2, high w1, low w1, high w0, low w0)
tupleToHostAddress6 :: (Word16, Word16, Word16, Word16,
Word16, Word16, Word16, Word16) -> HostAddress6
tupleToHostAddress6 (w7, w6, w5, w4, w3, w2, w1, w0) =
let add :: Word16 -> Word16 -> Word32
high `add` low = (fromIntegral high `shiftL` 16) .|. (fromIntegral low)
in (w7 `add` w6, w5 `add` w4, w3 `add` w2, w1 `add` w0)
s6_addr_offset :: Int
s6_addr_offset = ((0))
{-# LINE 1092 "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)
newtype In6Addr = In6Addr HostAddress6
{-# LINE 1120 "Network/Socket/Types.hsc" #-}
instance Storable In6Addr where
sizeOf _ = 16
{-# LINE 1123 "Network/Socket/Types.hsc" #-}
alignment _ = 4
{-# LINE 1124 "Network/Socket/Types.hsc" #-}
peek p = do
a <- peek32 p 0
b <- peek32 p 1
c <- peek32 p 2
d <- peek32 p 3
return $ In6Addr (a, b, c, d)
poke p (In6Addr (a, b, c, d)) = do
poke32 p 0 a
poke32 p 1 b
poke32 p 2 c
poke32 p 3 d
foreign import ccall unsafe "string.h" memset :: Ptr a -> CInt -> CSize -> IO ()
zeroMemory :: Ptr a -> CSize -> IO ()
zeroMemory dest nbytes = memset dest 0 (fromIntegral nbytes)