module Network.AdHoc.Message where
import Data.ByteString as BS
import Data.Word
import Data.Time.Clock
import Data.Maybe
import Data.Time.LocalTime ()
import Network.AdHoc.Channel
import Network.AdHoc.Encryption
import Network.AdHoc.MessageID
import Network.AdHoc.UserID
import Network.AdHoc.Signature
data CipherType
= CipherDES_CBC
| CipherNone
| CipherUnknown String
deriving (Show,Eq)
type TTL = Word16
type Delay = Word
data Attachment = Attachment
{attachmentFilename :: String
,attachmentAppType :: String
,attachmentContent :: BS.ByteString
} deriving (Show,Eq)
data EncryptedAttachment = EncryptedAttachment
{encryptedAttachmentFilename :: Encrypted String
,encryptedAttachmentAppType :: Encrypted String
,encryptedAttachmentContent :: Encrypted BS.ByteString
} deriving (Show,Eq)
encryptAttachment :: Word64
-> Word64
-> Attachment
-> EncryptedAttachment
encryptAttachment key iv (Attachment name tp cont) = EncryptedAttachment
(encrypt key iv name)
(encrypt key iv tp)
(encrypt key iv cont)
decryptAttachment :: Word64
-> EncryptedAttachment
-> Maybe Attachment
decryptAttachment key (EncryptedAttachment name tp cont) = do
rname <- decrypt key name
rtp <- decrypt key tp
rcont <- decrypt key cont
return $ Attachment rname rtp rcont
data Routed a sign = Routed
{routedTTL :: TTL
,routedUserID :: UserID
,routedMsgID :: MessageID
,routedContent :: a
,routedSignature :: sign
} deriving (Show,Eq)
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) ())
deriving (Show,Eq)
data TargetContent
= Nack (Routed TargetContent ExternalSignature)
| GetCertificate
{getCertificateFor :: UserID
}
| Certificate
{certificateReceivers :: [UserID]
,certificateFor :: UserID
,certificateData :: BS.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
}
deriving (Show,Eq)
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
}
deriving (Show,Eq)
data MessageContent
= EncryptedMessage (Encrypted String) [EncryptedAttachment]
| UnencryptedMessage String [Attachment]
deriving (Show,Eq)
decrementTTL :: Routed a sign -> Maybe (Routed a sign)
decrementTTL (Routed ttl user mid cont sig)
| ttl == 0 = Nothing
| otherwise = Just (Routed (ttl1) user mid cont sig)
routeTo :: Routed TargetContent sign -> [UserID]
routeTo (Routed _ _ _ (Nack (Routed _ from _ _ _)) _) = [from]
routeTo (Routed _ _ _ (GetCertificate for) _) = [for]
routeTo (Routed _ _ _ (Certificate receivers _ _) _) = receivers
routeTo (Routed _ _ _ (Message receivers _ _ _ _ _) _) = receivers
routeTo (Routed _ _ _ (GetKey receiver _ _) _) = [receiver]
routeTo (Routed _ _ _ (Key receiver _ _ _ _) _) = [receiver]
instance Functor (Routed a) where
fmap f (Routed ttl user msgid cont sig) = Routed ttl user msgid cont (f sig)
instance Functor ProtocolMessage where
fmap _ (Hello recv vers greet) = Hello recv vers greet
fmap _ (Ack send msgid) = Ack send msgid
fmap _ (Routing rt) = Routing rt
fmap f (Target rt) = Target (fmap f rt)
fmap f (Flood x) = Flood (fmap f x)
fmap _ (Obscure rt) = Obscure rt