socket-sctp (empty) → 0.1.0.0
raw patch · 10 files changed
+643/−0 lines, 10 filesdep +basedep +bytestringdep +socketsetup-changed
Dependencies added: base, bytestring, socket, socket-sctp
Files
- CHANGELOG.md +3/−0
- CONTRIBUTORS.txt +0/−0
- LICENSE +20/−0
- README.md +33/−0
- Setup.hs +2/−0
- socket-sctp.cabal +57/−0
- src/System/Socket/Protocol/SCTP.hsc +69/−0
- src/System/Socket/Protocol/SCTP/Internal.hsc +358/−0
- tests/SendReceiveMessage.hs +47/−0
- tests/TooSmallBuffer.hs +54/−0
+ CHANGELOG.md view
@@ -0,0 +1,3 @@+0.1.0.0 Lars Petersen <info@lars-petersen.net> 2015-06-22++ * Initial release.
+ CONTRIBUTORS.txt view
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2015 Lars Petersen++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,33 @@+socket-sctp+===========++[![Available on Hackage][badge-hackage]][hackage]+[![License MIT][badge-license]][license]+[![Build Status][badge-travis]][travis]++### Description++This is an SCTP extension package to the `socket` library.++### Dependencies++ - base+ - bytestring+ - socket++### Tests++Run the default test suites:++```bash+cabal test+```++[badge-travis]: https://img.shields.io/travis/lpeterse/haskell-socket-sctp.svg+[travis]: https://travis-ci.org/lpeterse/haskell-socket-sctp+[badge-hackage]: https://img.shields.io/hackage/v/socket-sctp.svg?dummy+[hackage]: https://hackage.haskell.org/package/socket-sctp+[badge-license]: https://img.shields.io/badge/license-MIT-green.svg?dummy+[license]: https://github.com/lpeterse/haskell-socket-sctp/blob/master/LICENSE+[issues]: https://github.com/lpeterse/haskell-socket-sctp/issues+[Github]: https://github.com/lpeterse/haskell-socket-sctp
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ socket-sctp.cabal view
@@ -0,0 +1,57 @@+name: socket-sctp+version: 0.1.0.0+synopsis: STCP socket extensions library.+description:+ This is a binding to the types and operations of `libsctp`.+ It's intended to be used in conjunction with the `socket`+ library.++license: MIT+license-file: LICENSE+author: Lars Petersen+maintainer: info@lars-petersen.net+category: System, Socket, Network+build-type: Simple+cabal-version: >=1.10+homepage: https://github.com/lpeterse/haskell-socket-sctp+bug-reports: https://github.com/lpeterse/haskell-socket-sctp/issues+tested-with: GHC==7.10.1, GHC==7.8.3+extra-source-files: README.md+ CHANGELOG.md+ CONTRIBUTORS.txt++library+ ghc-options: -Wall+ exposed-modules: System.Socket.Protocol.SCTP+ other-modules: System.Socket.Protocol.SCTP.Internal+ build-depends: base >= 4.7 && < 5+ , bytestring < 0.11+ , socket >= 0.5.1.0 && < 0.6.0.0+ hs-source-dirs: src+ build-tools: hsc2hs+ default-language: Haskell2010+ extra-libraries: sctp++source-repository head+ type: git+ location: git://github.com/lpeterse/haskell-socket-sctp.git++test-suite SendReceiveMessage+ hs-source-dirs: tests+ main-is: SendReceiveMessage.hs+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ build-depends: base >= 4.7 && < 5+ , bytestring < 0.11+ , socket+ , socket-sctp++test-suite TooSmallBuffer+ hs-source-dirs: tests+ main-is: TooSmallBuffer.hs+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ build-depends: base >= 4.7 && < 5+ , bytestring < 0.11+ , socket+ , socket-sctp
+ src/System/Socket/Protocol/SCTP.hsc view
@@ -0,0 +1,69 @@+-----------------------------------------------------------------------------+-- |+-- Module : System.Socket.Protocol.SCTP+-- Copyright : (c) Lars Petersen 2015+-- License : MIT+--+-- Maintainer : info@lars-petersen.net+-- Stability : experimental+-----------------------------------------------------------------------------+module System.Socket.Protocol.SCTP (+ -- * Examples+ -- ** Server+ -- $server++ -- ** Client+ -- $client+ --++ module System.Socket.Protocol.SCTP.Internal+ ) where++import System.Socket.Protocol.SCTP.Internal++-- $server+--+-- > {-# LANGUAGE OverloadedStrings #-}+-- > module Main where+-- > +-- > import Data.Monoid+-- > import Control.Monad+-- > +-- > import System.Socket+-- > import System.Socket.Family.Inet as Inet+-- > import System.Socket.Protocol.SCTP as SCTP+-- > +-- > main :: IO ()+-- > main = do+-- > server <- socket :: IO (Socket Inet SequentialPacket SCTP)+-- > bind server (SocketAddressInet Inet.loopback 7777)+-- > listen server 5+-- > setSocketOption server (mempty { dataIOEvent = True })+-- > forever $ do+-- > x@(msg, adr, sinfo, flags) <- SCTP.receiveMessage server 4096 mempty+-- > print x++-- $client+--+-- > {-# LANGUAGE OverloadedStrings #-}+-- > module Main where+-- > +-- > import Data.Monoid+-- > import Control.Monad+-- > +-- > import System.Socket+-- > import System.Socket.Family.Inet as Inet+-- > import System.Socket.Protocol.SCTP as SCTP+-- > +-- > main :: IO ()+-- > main = do+-- > client <- socket :: IO (Socket Inet SequentialPacket SCTP)+-- > print =<< SCTP.sendMessage+-- > client+-- > "Hello world!"+-- > ( SocketAddressInet Inet.loopback 7777 )+-- > ( 2342 :: PayloadProtocolIdentifier )+-- > ( mempty :: MessageFlags )+-- > ( 2 :: StreamNumber )+-- > ( 0 :: TimeToLive )+-- > ( 0 :: Context )
+ src/System/Socket/Protocol/SCTP/Internal.hsc view
@@ -0,0 +1,358 @@+{-# LANGUAGE TypeFamilies, GeneralizedNewtypeDeriving #-}+module System.Socket.Protocol.SCTP.Internal+ ( SCTP+ -- * Operations+ -- ** receiveMessage+ , receiveMessage+ -- ** sendMessage+ , sendMessage+ -- * SendReceiveInfo+ , SendReceiveInfo (..)+ , StreamNumber (..)+ , StreamSequenceNumber (..)+ , PayloadProtocolIdentifier (..)+ , Context (..)+ , TimeToLive (..)+ , TransportSequenceNumber (..)+ , CumulativeTransportSequenceNumber (..)+ , AssociationIdentifier (..)+ -- * SendReceiveInfoFlags+ , SendReceiveInfoFlags (..)+ -- ** unordered+ , unordered+ -- ** addressOverride+ , addressOverride+ -- ** abort+ , abort+ -- ** shutdown+ , shutdown+ -- * Socket Options+ -- ** InitMessage+ , InitMessage (..)+ -- ** Events+ , Events (..)+ ) where++import Control.Applicative+import Control.Exception++import Data.Bits+import Data.Monoid+import Data.Word+import qualified Data.ByteString as BS+import qualified Data.ByteString.Unsafe as BS++import Foreign.Storable+import Foreign.Ptr+import Foreign.Marshal+import Foreign.C.Types++import System.Posix.Types ( Fd(..) )++import System.Socket+import System.Socket.Unsafe+import System.Socket.Protocol++#include "netinet/sctp.h"+#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)++data SCTP++data SendReceiveInfo+ = SendReceiveInfo+ { sinfoStreamNumber :: StreamNumber+ , sinfoStreamSequenceNumber :: StreamSequenceNumber+ , sinfoFlags :: SendReceiveInfoFlags+ , sinfoPayloadProtocolIdentifier :: PayloadProtocolIdentifier+ , sinfoContext :: Context+ , sinfoTimeToLive :: TimeToLive+ , sinfoTransportSequenceNumber :: TransportSequenceNumber+ , sinfoCumulativeTransportSequenceNumber :: CumulativeTransportSequenceNumber+ , sinfoAssociationIdentifier :: AssociationIdentifier+ }+ deriving (Eq, Show)++newtype StreamNumber+ = StreamNumber Word16+ deriving (Eq, Ord, Show, Num, Storable)++newtype StreamSequenceNumber+ = StreamSequenceNumber Word16+ deriving (Eq, Ord, Show, Num, Storable)++newtype SendReceiveInfoFlags+ = SendReceiveInfoFlags Word16+ deriving (Eq, Ord, Show, Num, Storable, Bits)++newtype PayloadProtocolIdentifier+ = PayloadProtocolIdentifier Word32+ deriving (Eq, Ord, Show, Num, Storable)++newtype TimeToLive+ = TimeToLive Word32+ deriving (Eq, Ord, Show, Num, Storable)++newtype Context+ = Context Word32+ deriving (Eq, Ord, Show, Num, Storable)++newtype TransportSequenceNumber+ = TransportSequenceNumber Word32+ deriving (Eq, Ord, Show, Num, Storable)++newtype CumulativeTransportSequenceNumber+ = CumulativeTransportSequenceNumber Word32+ deriving (Eq, Ord, Show, Num, Storable)++newtype AssociationIdentifier+ = AssociationIdentifier Word32+ deriving (Eq, Ord, Show, Num, Storable)++instance Protocol SCTP where+ protocolNumber _ = (#const IPPROTO_SCTP)++unordered :: SendReceiveInfoFlags+unordered = SendReceiveInfoFlags (#const SCTP_UNORDERED)++addressOverride :: SendReceiveInfoFlags+addressOverride = SendReceiveInfoFlags (#const SCTP_ADDR_OVER)++abort :: SendReceiveInfoFlags+abort = SendReceiveInfoFlags (#const SCTP_ABORT)++shutdown :: SendReceiveInfoFlags+shutdown = SendReceiveInfoFlags (#const SCTP_EOF)++instance Storable SendReceiveInfo where+ sizeOf _ = (#size struct sctp_sndrcvinfo)+ alignment _ = (#alignment struct sctp_sndrcvinfo)+ peek ptr = SendReceiveInfo+ <$> peek ((#ptr struct sctp_sndrcvinfo, sinfo_stream) ptr)+ <*> peek ((#ptr struct sctp_sndrcvinfo, sinfo_ssn) ptr)+ <*> peek ((#ptr struct sctp_sndrcvinfo, sinfo_flags) ptr)+ <*> peek ((#ptr struct sctp_sndrcvinfo, sinfo_ppid) ptr)+ <*> peek ((#ptr struct sctp_sndrcvinfo, sinfo_context) ptr)+ <*> peek ((#ptr struct sctp_sndrcvinfo, sinfo_timetolive) ptr)+ <*> peek ((#ptr struct sctp_sndrcvinfo, sinfo_tsn) ptr)+ <*> peek ((#ptr struct sctp_sndrcvinfo, sinfo_cumtsn) ptr)+ <*> peek ((#ptr struct sctp_sndrcvinfo, sinfo_assoc_id) ptr)+ poke ptr a = do+ c_memset ptr 0 $ fromIntegral (sizeOf a)+ poke ((#ptr struct sctp_sndrcvinfo, sinfo_stream) ptr) (sinfoStreamNumber a)+ poke ((#ptr struct sctp_sndrcvinfo, sinfo_ssn) ptr) (sinfoStreamSequenceNumber a)+ poke ((#ptr struct sctp_sndrcvinfo, sinfo_flags) ptr) (sinfoFlags a)+ poke ((#ptr struct sctp_sndrcvinfo, sinfo_ppid) ptr) (sinfoPayloadProtocolIdentifier a)+ poke ((#ptr struct sctp_sndrcvinfo, sinfo_context) ptr) (sinfoContext a)+ poke ((#ptr struct sctp_sndrcvinfo, sinfo_timetolive) ptr) (sinfoTimeToLive a)+ poke ((#ptr struct sctp_sndrcvinfo, sinfo_tsn) ptr) (sinfoTransportSequenceNumber a)+ poke ((#ptr struct sctp_sndrcvinfo, sinfo_cumtsn) ptr) (sinfoCumulativeTransportSequenceNumber a)+ poke ((#ptr struct sctp_sndrcvinfo, sinfo_assoc_id) ptr) (sinfoAssociationIdentifier a)++-------------------------------------------------------------------------------+-- Operations+-------------------------------------------------------------------------------++-- | Receive a message on a SCTP socket.+--+-- - Everything that applies to `System.Socket.recv` is also true for this operation.+-- - The fields of the `SendReceiveInfo` structure are only filled if `dataIOEvent`+-- has been enabled trough the `Events` socket option.+-- - If the supplied buffer size is not sufficient, several consecutive reads are+-- necessary to receive the complete message. The `msgEndOfRecord` flag is set+-- when the message has been read completely.+receiveMessage :: Family f => Socket f SequentialPacket SCTP+ -> Int -- ^ buffer size in bytes+ -> MessageFlags+ -> IO (BS.ByteString, SocketAddress f, SendReceiveInfo, MessageFlags)+receiveMessage sock bufSize flags = do+ alloca $ \addrPtr-> do+ alloca $ \addrSizePtr-> do+ alloca $ \sinfoPtr-> do+ alloca $ \flagsPtr -> do+ uaddr <- return undefined+ c_memset sinfoPtr 0 (#size struct sctp_sndrcvinfo)+ poke addrSizePtr (fromIntegral $ sizeOf uaddr)+ poke flagsPtr (flags `mappend` msgNoSignal)+ bracketOnError+ ( mallocBytes bufSize )+ (\bufPtr-> free bufPtr )+ (\bufPtr-> do+ bytesReceived <- tryWaitRetryLoop+ sock+ unsafeSocketWaitRead+ (\fd-> c_sctp_recvmsg fd bufPtr (fromIntegral bufSize) addrPtr addrSizePtr sinfoPtr flagsPtr )+ addr <- peek addrPtr+ flags' <- peek flagsPtr+ sinfo <- peek sinfoPtr+ msg <- BS.unsafePackMallocCStringLen (bufPtr, fromIntegral bytesReceived)+ return (msg, addr `asTypeOf` uaddr, sinfo, flags')+ )++-- | Send a message on a SCTP socket.+--+-- - Everything that applies to `System.Socket.send` is also true for this operation.+-- - Sending a message is atomic unless the `ExplicitEndOfRecord` option has been enabled (not yet supported),+sendMessage :: Family f => Socket f SequentialPacket SCTP+ -> BS.ByteString+ -> SocketAddress f+ -> PayloadProtocolIdentifier -- ^ a user value not interpreted by SCTP+ -> MessageFlags+ -> StreamNumber+ -> TimeToLive+ -> Context+ -> IO Int+sendMessage sock msg addr ppid flags sn ttl context = do+ alloca $ \addrPtr-> do+ BS.unsafeUseAsCStringLen msg $ \(msgPtr,msgSize)-> do+ poke addrPtr addr+ i <- tryWaitRetryLoop+ sock+ unsafeSocketWaitWrite+ $ \fd-> c_sctp_sendmsg+ fd+ msgPtr+ (fromIntegral msgSize)+ addrPtr+ (fromIntegral $ sizeOf addr)+ ppid+ flags+ sn+ ttl+ context+ return (fromIntegral i)++{-- NOT YET SUPPORTED :-(++-- | @SCTP_EXPLICIT_EOR@+data ExplicitEndOfRecord+ = ExplicitEndOfRecord Bool+ deriving (Eq, Ord, Show)++instance Storable ExplicitEndOfRecord where+ sizeOf _ = sizeOf (undefined :: CInt)+ alignment _ = alignment (undefined :: CInt)+ peek ptr = do+ i <- peek ptr :: IO CInt+ return (ExplicitEndOfRecord $ i /= 0)+ poke ptr (ExplicitEndOfRecord False) = do+ poke ptr (0 :: CInt)+ poke ptr (ExplicitEndOfRecord True) = do+ poke ptr (1 :: CInt)++instance GetSocketOption ExplicitEndOfRecord where+ getSocketOption sock =+ unsafeGetSocketOption sock (#const IPPROTO_SCTP) (#const SCTP_EXPLICIT_EOR)++instance SetSocketOption ExplicitEndOfRecord where+ setSocketOption sock value =+ unsafeSetSocketOption sock (#const IPPROTO_SCTP) (#const SCTP_EXPLICIT_EOR) value+--}++-- | @SCTP_INITMSG@+data InitMessage+ = InitMessage+ { outboundStreams :: Word16 -- ^ number of outbound streams+ , maxInboundStreams :: Word16 -- ^ max number of inbound streams+ , maxAttempts :: Word16 -- ^ max number re-transmissions while establishing an association+ , maxInitTimeout :: Word16 -- ^ time-out in milliseconds for establishing an association+ } deriving (Eq, Ord, Show)++instance Storable InitMessage where+ sizeOf _ = (#size struct sctp_initmsg)+ alignment _ = (#alignment struct sctp_initmsg)+ peek ptr = InitMessage+ <$> peek ( (#ptr struct sctp_initmsg, sinit_num_ostreams) ptr)+ <*> peek ( (#ptr struct sctp_initmsg, sinit_max_instreams) ptr)+ <*> peek ( (#ptr struct sctp_initmsg, sinit_max_attempts) ptr)+ <*> peek ( (#ptr struct sctp_initmsg, sinit_max_init_timeo) ptr)+ poke ptr a = do+ c_memset ptr 0 $ fromIntegral (sizeOf a)+ poke ((#ptr struct sctp_initmsg, sinit_num_ostreams) ptr) (outboundStreams a)+ poke ((#ptr struct sctp_initmsg, sinit_max_instreams) ptr) (maxInboundStreams a)+ poke ((#ptr struct sctp_initmsg, sinit_max_attempts) ptr) (maxAttempts a)+ poke ((#ptr struct sctp_initmsg, sinit_max_init_timeo) ptr) (maxInitTimeout a)++instance GetSocketOption InitMessage where+ getSocketOption sock =+ unsafeGetSocketOption sock (#const IPPROTO_SCTP) (#const SCTP_INITMSG)++instance SetSocketOption InitMessage where+ setSocketOption sock value =+ unsafeSetSocketOption sock (#const IPPROTO_SCTP) (#const SCTP_INITMSG) value++-- | @SCTP_EVENTS@+data Events+ = Events+ { dataIOEvent :: Bool+ , associationEvent :: Bool+ , addressEvent :: Bool+ , sendFailureEvent :: Bool+ , peerErrorEvent :: Bool+ , shutdownEvent :: Bool+ , partialDeliveryEvent :: Bool+ , adaptationLayerEvent :: Bool+ , authenticationEvent :: Bool+ }+ deriving (Eq, Ord, Show)++instance Monoid Events where+ mempty = let x = False in Events x x x x x x x x x -- x+ mappend a b = Events+ (max (dataIOEvent a) (dataIOEvent b))+ (max (associationEvent a) (associationEvent b))+ (max (addressEvent a) (addressEvent b))+ (max (sendFailureEvent a) (sendFailureEvent b))+ (max (peerErrorEvent a) (peerErrorEvent b))+ (max (shutdownEvent a) (shutdownEvent b))+ (max (partialDeliveryEvent a) (partialDeliveryEvent b))+ (max (adaptationLayerEvent a) (adaptationLayerEvent b))+ (max (authenticationEvent a) (authenticationEvent b))++instance Storable Events where+ sizeOf _ = (#size struct sctp_event_subscribe)+ alignment _ = (#alignment struct sctp_event_subscribe)+ peek ptr = Events+ <$> ((/=0) <$> (peek ((#ptr struct sctp_event_subscribe, sctp_data_io_event) ptr :: Ptr CUChar)))+ <*> ((/=0) <$> (peek ((#ptr struct sctp_event_subscribe, sctp_association_event) ptr :: Ptr CUChar)))+ <*> ((/=0) <$> (peek ((#ptr struct sctp_event_subscribe, sctp_address_event) ptr :: Ptr CUChar)))+ <*> ((/=0) <$> (peek ((#ptr struct sctp_event_subscribe, sctp_send_failure_event) ptr :: Ptr CUChar)))+ <*> ((/=0) <$> (peek ((#ptr struct sctp_event_subscribe, sctp_peer_error_event) ptr :: Ptr CUChar)))+ <*> ((/=0) <$> (peek ((#ptr struct sctp_event_subscribe, sctp_shutdown_event) ptr :: Ptr CUChar)))+ <*> ((/=0) <$> (peek ((#ptr struct sctp_event_subscribe, sctp_partial_delivery_event) ptr :: Ptr CUChar)))+ <*> ((/=0) <$> (peek ((#ptr struct sctp_event_subscribe, sctp_adaptation_layer_event) ptr :: Ptr CUChar)))+ <*> ((/=0) <$> (peek ((#ptr struct sctp_event_subscribe, sctp_authentication_event) ptr :: Ptr CUChar)))+ poke ptr a = do+ c_memset ptr 0 $ fromIntegral (sizeOf a)+ poke ((#ptr struct sctp_event_subscribe, sctp_data_io_event) ptr :: Ptr CUChar) (f $ dataIOEvent a)+ poke ((#ptr struct sctp_event_subscribe, sctp_association_event) ptr :: Ptr CUChar) (f $ associationEvent a)+ poke ((#ptr struct sctp_event_subscribe, sctp_address_event) ptr :: Ptr CUChar) (f $ addressEvent a)+ poke ((#ptr struct sctp_event_subscribe, sctp_send_failure_event) ptr :: Ptr CUChar) (f $ sendFailureEvent a)+ poke ((#ptr struct sctp_event_subscribe, sctp_peer_error_event) ptr :: Ptr CUChar) (f $ peerErrorEvent a)+ poke ((#ptr struct sctp_event_subscribe, sctp_shutdown_event) ptr :: Ptr CUChar) (f $ shutdownEvent a)+ poke ((#ptr struct sctp_event_subscribe, sctp_partial_delivery_event) ptr :: Ptr CUChar) (f $ partialDeliveryEvent a)+ poke ((#ptr struct sctp_event_subscribe, sctp_adaptation_layer_event) ptr :: Ptr CUChar) (f $ adaptationLayerEvent a)+ poke ((#ptr struct sctp_event_subscribe, sctp_authentication_event) ptr :: Ptr CUChar) (f $ authenticationEvent a)+ where+ f True = 1+ f False = 0++instance GetSocketOption Events where+ getSocketOption sock =+ unsafeGetSocketOption sock (#const IPPROTO_SCTP) (#const SCTP_EVENTS)++instance SetSocketOption Events where+ setSocketOption sock value =+ unsafeSetSocketOption sock (#const IPPROTO_SCTP) (#const SCTP_EVENTS) value++------------------------------------------------------------------------+-- FFI+------------------------------------------------------------------------++foreign import ccall unsafe "memset"+ c_memset :: Ptr a -> CInt -> CSize -> IO ()++foreign import ccall unsafe "sctp_recvmsg"+ c_sctp_recvmsg :: Fd -> Ptr a -> CSize -> Ptr b -> Ptr CInt -> Ptr SendReceiveInfo -> Ptr MessageFlags -> IO CInt++foreign import ccall unsafe "sctp_sendmsg"+ c_sctp_sendmsg :: Fd -> Ptr a -> CSize -> Ptr b -> CInt -> PayloadProtocolIdentifier -> MessageFlags -> StreamNumber -> TimeToLive -> Context -> IO CInt
+ tests/SendReceiveMessage.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Data.Monoid+import Control.Monad+import Control.Exception+import Control.Concurrent++import System.Socket+import System.Socket.Family.Inet as Inet+import System.Socket.Protocol.SCTP as SCTP++main :: IO ()+main = do+ server <- socket `onException` p 0 :: IO (Socket Inet SequentialPacket SCTP)+ client <- socket `onException` p 1 :: IO (Socket Inet SequentialPacket SCTP)+ bind server addr `onException` p 3+ listen server 5 `onException` p 4+ connect client addr `onException` p 5+ setSocketOption+ server + (mempty { dataIOEvent = True }) `onException` p 6+ SCTP.sendMessage+ client+ "hallo"+ addr+ ( 2342 :: PayloadProtocolIdentifier )+ ( mempty :: MessageFlags )+ ( 2 :: StreamNumber )+ ( 3 :: TimeToLive )+ ( 4 :: Context ) `onException` p 7+ (msg, adr, sinfo, flags) <- SCTP.receiveMessage server 4096 mempty+ `onException` p 8++ when (sinfoPayloadProtocolIdentifier sinfo /= 2342) (e 9)+ when (sinfoStreamNumber sinfo /= 2) (e 10)+ when (msg /= "hallo") (e 11)+ when (flags /= msgEndOfRecord) (e 12)++addr :: SocketAddressInet+addr = SocketAddressInet Inet.loopback 7777++p :: Int -> IO ()+p i = print i++e :: Int -> IO ()+e i = error (show i)
+ tests/TooSmallBuffer.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Data.Monoid+import Control.Monad+import Control.Exception+import Control.Concurrent++import System.Socket+import System.Socket.Family.Inet as Inet+import System.Socket.Protocol.SCTP as SCTP++main :: IO ()+main = do+ server <- socket `onException` p 0 :: IO (Socket Inet SequentialPacket SCTP)+ client <- socket `onException` p 1 :: IO (Socket Inet SequentialPacket SCTP)+ bind server addr `onException` p 3+ listen server 5 `onException` p 4+ connect client addr `onException` p 5+ setSocketOption+ server + (mempty { dataIOEvent = True }) `onException` p 6+ SCTP.sendMessage+ client+ "hallowelt"+ addr+ ( 2342 :: PayloadProtocolIdentifier )+ ( mempty :: MessageFlags )+ ( 2 :: StreamNumber )+ ( 3 :: TimeToLive )+ ( 4 :: Context ) `onException` p 7+ x@(msg, adr, sinfo, flags) <- SCTP.receiveMessage server 5 mempty+ `onException` p 8+ y@(msg',adr',sinfo', flags') <- SCTP.receiveMessage server 4 mempty+ `onException` p 9++ when (sinfoPayloadProtocolIdentifier sinfo /= 2342) (e 10)+ when (sinfoStreamNumber sinfo /= 2) (e 11)+ when (msg /= "hallo") (e 12)+ when (flags /= mempty) (e 13)++ when (sinfoPayloadProtocolIdentifier sinfo' /= 2342) (e 14)+ when (sinfoStreamNumber sinfo' /= 2) (e 15)+ when (msg' /= "welt") (e 16)+ when (flags' /= msgEndOfRecord) (e 17)++addr :: SocketAddressInet+addr = SocketAddressInet Inet.loopback 7777++p :: Int -> IO ()+p i = print i++e :: Int -> IO ()+e i = error (show i)