adhoc-network-1.0.2: Ad-hoc P2P network protocolSource codeContentsIndex
Network.AdHoc.Message
MaintainerHenning Guenther
Description
This module contains types representing the different kinds of messages defined by the protocol.
Synopsis
data CipherType
= CipherDES_CBC
| CipherNone
| CipherUnknown String
type TTL = Word16
type Delay = Word
data Attachment = Attachment {
attachmentFilename :: String
attachmentAppType :: String
attachmentContent :: ByteString
}
data EncryptedAttachment = EncryptedAttachment {
encryptedAttachmentFilename :: Encrypted String
encryptedAttachmentAppType :: Encrypted String
encryptedAttachmentContent :: Encrypted ByteString
}
encryptAttachment :: Word64 -> Word64 -> Attachment -> EncryptedAttachment
decryptAttachment :: Word64 -> EncryptedAttachment -> Maybe Attachment
data Routed a sign = Routed {
routedTTL :: TTL
routedUserID :: UserID
routedMsgID :: MessageID
routedContent :: a
routedSignature :: sign
}
type UnsignedMessage = ProtocolMessage NoSignature
type InternalMessage = ProtocolMessage InternalSignature
type ExternalMessage = ProtocolMessage ExternalSignature
data ProtocolMessage sign
= Hello {
helloSenders :: [UserID]
helloVersion :: Int
helloGreeting :: Maybe String
}
| Ack {
ackSender :: UserID
ackMsgId :: MessageID
}
| Routing {
routingRoutes :: [(UserID, Int)]
}
| Target (Routed TargetContent sign)
| Flood (Routed FloodContent sign)
| Obscure (Routed (RSAEncrypted String) ())
data TargetContent
= Nack (Routed TargetContent ExternalSignature)
| GetCertificate {
getCertificateFor :: UserID
}
| Certificate {
certificateReceivers :: [UserID]
certificateFor :: UserID
certificateData :: ByteString
}
| Message {
messageReceivers :: [UserID]
messageChannelName :: ChannelName
messageChannelID :: ChannelID
messageContent :: MessageContent
messageTime :: UTCTime
messageDelay :: Delay
}
| GetKey {
getKeyReceiver :: UserID
getKeyChannelName :: ChannelName
getKeyChannelID :: ChannelID
}
| Key {
keyReceiver :: UserID
keyChannelName :: ChannelName
keyChannelID :: ChannelID
keyCipherType :: CipherType
keyKey :: RSAEncrypted Word64
}
data FloodContent
= Channel {
channelChannelName :: ChannelName
channelChannelID :: ChannelID
channelChannelTitle :: String
channelUsers :: [UserID]
channelPrivate :: Bool
}
| Join {
joinChannelName :: ChannelName
joinChannelID :: ChannelID
}
| Leave {
leaveChannelName :: ChannelName
leaveChannelID :: ChannelID
}
| Anonymous {
anonymousText :: String
anonymousAttachments :: [Attachment]
anonymousTime :: UTCTime
anonymousDelay :: Delay
}
data MessageContent
= EncryptedMessage (Encrypted String) [EncryptedAttachment]
| UnencryptedMessage String [Attachment]
decrementTTL :: Routed a sign -> Maybe (Routed a sign)
routeTo :: Routed TargetContent sign -> [UserID]
Documentation
data CipherType Source
Specifies the encryption algorithm used to encrypt a message
Constructors
CipherDES_CBC
CipherNone
CipherUnknown StringAn unknown cipher was used
show/hide Instances
type TTL = Word16Source
TimeToLive has a maximum of 360, so 16 bit unsigned is enough to hold it
type Delay = WordSource
The message-delay can be represented by this type.
data Attachment Source
An attachmet as defined in the protocoll.
Constructors
Attachment
attachmentFilename :: StringName of the attached file
attachmentAppType :: StringMime-type of the very same
attachmentContent :: ByteStringThe actual content of the file
show/hide Instances
data EncryptedAttachment Source
An attachment that has been encrypted.
Constructors
EncryptedAttachment
encryptedAttachmentFilename :: Encrypted StringEncrypted filename
encryptedAttachmentAppType :: Encrypted StringEncrypted mime-type
encryptedAttachmentContent :: Encrypted ByteStringEncrypted content
show/hide Instances
encryptAttachmentSource
:: Word64Key
-> Word64IV
-> AttachmentAttachment to be encrypted
-> EncryptedAttachment
Uses DES to encrypt an Attachment.
decryptAttachmentSource
:: Word64Key
-> EncryptedAttachmentEncrypted attachment
-> Maybe AttachmentNothing at failure, Just when successful
Uses DES to decrypt an EncryptedAttachment.
data Routed a sign Source
A class of messages that can be routed.
Constructors
Routed
routedTTL :: TTLThe time-to-live of the message
routedUserID :: UserIDReceiver of the routed message
routedMsgID :: MessageIDID of the routed message
routedContent :: aThe actual content of the message
routedSignature :: signSignature of the message
show/hide Instances
Functor (Routed a)
(Eq a, Eq sign) => Eq (Routed a sign)
(Show a, Show sign) => Show (Routed a sign)
Addressed (Routed (RSAEncrypted String) sign)
Addressed (Routed TargetContent sign)
type UnsignedMessage = ProtocolMessage NoSignatureSource
An unsigned message.
type InternalMessage = ProtocolMessage InternalSignatureSource
An internal message that is subject to internal signature guidelines.
type ExternalMessage = ProtocolMessage ExternalSignatureSource
An external message.
data ProtocolMessage sign Source
Basic protocol message representation.
Constructors
HelloInforms about a user on the sending node, giving the user-id, the protocol version and a friendly greeting
helloSenders :: [UserID]
helloVersion :: Int
helloGreeting :: Maybe String
AckSender of the original message and the sended message-id
ackSender :: UserID
ackMsgId :: MessageID
RoutingRouting informations, a list of users and how much hops it takes to reach them
routingRoutes :: [(UserID, Int)]
Target (Routed TargetContent sign)Messages with one specified receiver
Flood (Routed FloodContent sign)Messages flooded through the network
Obscure (Routed (RSAEncrypted String) ())Obscure messages
show/hide Instances
data TargetContent Source
Messages directed to a specified receiver.
Constructors
Nack (Routed TargetContent ExternalSignature)Negative ACK
GetCertificateRequesting a certificate
getCertificateFor :: UserID
CertificateTransmitting a certificate
certificateReceivers :: [UserID]
certificateFor :: UserID
certificateData :: ByteString
MessageA chat message
messageReceivers :: [UserID]
messageChannelName :: ChannelName
messageChannelID :: ChannelID
messageContent :: MessageContent
messageTime :: UTCTime
messageDelay :: Delay
GetKeyKey request for a private channel
getKeyReceiver :: UserID
getKeyChannelName :: ChannelName
getKeyChannelID :: ChannelID
KeyKey message for a private channel
keyReceiver :: UserID
keyChannelName :: ChannelName
keyChannelID :: ChannelID
keyCipherType :: CipherType
keyKey :: RSAEncrypted Word64
show/hide Instances
data FloodContent Source
Messages flooded throughout the entire network.
Constructors
ChannelChannel announcements
channelChannelName :: ChannelName
channelChannelID :: ChannelID
channelChannelTitle :: String
channelUsers :: [UserID]
channelPrivate :: Bool
JoinJoin message for a channel
joinChannelName :: ChannelName
joinChannelID :: ChannelID
LeaveThe users leaves a channel
leaveChannelName :: ChannelName
leaveChannelID :: ChannelID
AnonymousAn anonymous message that has been unpacked and will be flooded
anonymousText :: String
anonymousAttachments :: [Attachment]
anonymousTime :: UTCTime
anonymousDelay :: Delay
show/hide Instances
data MessageContent Source
A messages content can either be encrypted or not.
Constructors
EncryptedMessage (Encrypted String) [EncryptedAttachment]
UnencryptedMessage String [Attachment]
show/hide Instances
decrementTTL :: Routed a sign -> Maybe (Routed a sign)Source
Decrements the time-to-live of a message. If it sinks under zero, Nothing is returned. Just msg otherwise, where msg has a decremented ttl.
routeTo :: Routed TargetContent sign -> [UserID]Source
Extracts the information from a message, that indicates, where to route it.
Produced by Haddock version 2.4.2