Safe Haskell | None |
---|
Network.Stun
Description
Session Traversal Utilities for NAT (STUN)
http://tools.ietf.org/html/rfc5389
For a simple way to find the mapped address see findMappedAddress
- bindRequest :: IO Message
- stunRequest :: SockAddr -> PortNumber -> [Integer] -> Message -> IO (Either StunError Message)
- stunRequest' :: SockAddr -> PortNumber -> [Integer] -> Message -> IO (Either StunError (Message, Socket))
- data Message = Message {}
- data MessageClass
- = Request
- | Success
- | Failure
- | Indication
- data TransactionID = TID !Word32 !Word32 !Word32
- data Attribute = Attribute {}
- findAttribute :: IsAttribute a => [Attribute] -> Either AttributeError [a]
- class Serialize a => IsAttribute a where
- attributeTypeValue :: a -> Word16
- toAttribute :: a -> Attribute
- fromAttribute :: Attribute -> Either AttributeError a
- findMappedAddress :: SockAddr -> PortNumber -> [Integer] -> IO (Either StunError (SockAddr, SockAddr))
- data MappedAddress
- data XorMappedAddress
- fromXorMappedAddress :: TransactionID -> XorMappedAddress -> SockAddr
- xorMappedAddress :: TransactionID -> SockAddr -> XorMappedAddress
- data Username = Username {
- unUsername :: !Text
- data Credentials
- withMessageIntegrity :: Credentials -> Message -> Message
- checkMessageIntegrity :: Credentials -> Message -> Maybe (Bool, Message)
- data StunError
- = TimeOut
- | ProtocolError
- | ErrorMsg !Message
- | WrongMessageType !Message
- data ErrorAttribute = ErrorAttribute {}
- errTryAlternate :: ErrorAttribute
- errBadRequest :: ErrorAttribute
- errUnauthorized :: ErrorAttribute
- errUnknownAttribute :: ErrorAttribute
- errStaleNonce :: ErrorAttribute
- errServerError :: ErrorAttribute
Requests
bindRequest :: IO MessageSource
Generate a new bind request
Arguments
:: SockAddr | Address of the stun server |
-> PortNumber | local port to use |
-> [Integer] | time outs in µs (10^-6 seconds), will default to [0.5s, 1s, 2s] if empty. 0 means wait indefinitly. |
-> Message | Request to send |
-> IO (Either StunError Message) |
Send a STUN request to the server denoted by address and wait for an answer. The request will be sucessively sent once for each element of timeOuts until an answer is received or all requests time out.
Arguments
:: SockAddr | Address of the stun server |
-> PortNumber | local port to use |
-> [Integer] | time outs in µs (10^-6 seconds), will default to [0.5s, 1s, 2s] if empty. 0 means wait indefinitly. |
-> Message | Request to send |
-> IO (Either StunError (Message, Socket)) |
Same as stunRequest
but returns the used socket
Messages
Constructors
Message | |
Fields
|
data TransactionID Source
Instances
Attributes
Constructors
Attribute | |
Fields |
findAttribute :: IsAttribute a => [Attribute] -> Either AttributeError [a]Source
class Serialize a => IsAttribute a whereSource
Mapped Address
Arguments
:: SockAddr | STUN server address |
-> PortNumber | local port to use (or 0 for a random port) |
-> [Integer] | timeOuts in µs (10^-6 seconds) |
-> IO (Either StunError (SockAddr, SockAddr)) |
Get the mapped address by sending a bind request to host, using localport . The request will be retransmitted for each entry of timeOuts. If the list of time outs is empty, a default of 500ms, 1s and 2s is used returns the reflexive and the local address
data MappedAddress Source
data XorMappedAddress Source
Credentials
Constructors
Username | |
Fields
|
Instances
data Credentials Source
withMessageIntegrity :: Credentials -> Message -> MessageSource
Generate a MESSAGE-INTEGRITY attribute and append it to the message attribute list
checkMessageIntegrity :: Credentials -> Message -> Maybe (Bool, Message)Source
Checks the credentials of a message
- returns Nothing when the credentials don't match
- returns Just (False, oldmsg) when no MESSAGE-INTEGRITY attribute is present
where oldmsg is the unchanged message passed to the function
- returns Just (True, prunedmsg) when the attribute is present and matches
where prunedmsg is the message with all fields after MESSAGE-INTEGRITY removed
Errors
Constructors
TimeOut | |
ProtocolError | |
ErrorMsg !Message | |
WrongMessageType !Message |
data ErrorAttribute Source
Constructors
ErrorAttribute | |