Merge f980c8c into f90a9f9

hstox.cabal

@@ -92,6 +92,11 @@ library
       Network.Tox.Protocol
       Network.Tox.Protocol.Packet
       Network.Tox.Protocol.PacketKind
+      Network.Tox.SaveData
+      Network.Tox.SaveData.Conferences
+      Network.Tox.SaveData.DHT
+      Network.Tox.SaveData.Friend
+      Network.Tox.SaveData.Nodes
       Network.Tox.Testing
       Network.Tox.Time
       Network.Tox.Timed

src/tox/Network/Tox/SaveData.hs

@@ -0,0 +1,116 @@
+module Network.Tox.SaveData where
+
+import           Control.Monad                    (when)
+import           Data.Binary                      (Binary (..))
+import           Data.Binary.Get                  (Get)
+import qualified Data.Binary.Get                  as Get
+import qualified Data.ByteString                  as BS
+import qualified Data.ByteString.Lazy             as LBS
+import           Data.Word                        (Word16, Word32, Word8)
+import           Network.Tox.SaveData.Conferences (Conferences)
+import           Network.Tox.SaveData.DHT         (DHT)
+import           Network.Tox.SaveData.Friend      (Friend)
+import           Network.Tox.SaveData.Nodes       (Nodes)
+
+saveDataMagic :: Word32
+saveDataMagic = 0x15ED1B1F
+
+data SaveData = SaveData [Section]
+    deriving (Eq, Show)
+
+instance Binary SaveData where
+    get = do
+        zeroes <- Get.getWord32le
+        when (zeroes /= 0) $
+            fail $ "savedata should start with 32 zero-bits, but got "
+                <> show zeroes
+
+        magic <- Get.getWord32le
+        when (magic /= saveDataMagic) $
+            fail $ "wrong magic number for savedata: "
+                <> show magic <> " != " <> show saveDataMagic
+
+        SaveData <$> loadSections 0x01CE
+
+    put _ = fail "SaveData"
+
+data Section
+    = SectionNospamKeys NospamKeys
+    | SectionDHT DHT
+    | SectionFriends Friends
+    | SectionName Bytes
+    | SectionStatusMessage Bytes
+    | SectionStatus Byte
+    | SectionTcpRelays Nodes
+    | SectionPathNodes Nodes
+    | SectionConferences Conferences
+    | SectionEOF
+    deriving (Eq, Show)
+
+loadSections :: Word16 -> Get [Section]
+loadSections sectionMagic = go
+  where
+    go = do
+        len <- Get.getWord32le
+        ty <- Get.getWord16le
+        magic <- Get.getWord16le
+        when (magic /= sectionMagic) $
+            fail $ "wrong magic number for section: "
+                <> show magic <> " != " <> show sectionMagic
+
+        case ty of
+            0x01 -> (:) <$> load len SectionNospamKeys <*> go
+            0x02 -> (:) <$> load len SectionDHT <*> go
+            0x03 -> (:) <$> load len SectionFriends <*> go
+            0x04 -> (:) <$> load len SectionName <*> go
+            0x05 -> (:) <$> load len SectionStatusMessage <*> go
+            0x06 -> (:) <$> load len SectionStatus <*> go
+            0x0A -> (:) <$> load len SectionTcpRelays <*> go
+            0x0B -> (:) <$> load len SectionPathNodes <*> go
+            0xFF -> return [SectionEOF]
+            _    -> fail $ show ty
+
+    load len f = f <$> Get.isolate (fromIntegral len) get
+
+data NospamKeys = NospamKeys
+    { nospam    :: Word32
+    , publicKey :: BS.ByteString
+    , secretKey :: BS.ByteString
+    }
+    deriving (Eq, Show)
+
+instance Binary NospamKeys where
+    get = NospamKeys
+        <$> Get.getWord32le
+        <*> Get.getByteString 32
+        <*> Get.getByteString 32
+
+    put _ = fail "NospamKeys"
+
+data Friends = Friends [Friend]
+    deriving (Eq, Show)
+
+instance Binary Friends where
+    get = Friends <$> go [] False
+      where
+        go friends True = return $ reverse friends
+        go friends False = do
+            friend <- get
+            isEmpty <- Get.isEmpty
+            go (friend : friends) isEmpty
+
+    put _ = fail "Friends"
+
+data Bytes = Bytes LBS.ByteString
+    deriving (Eq, Show)
+
+instance Binary Bytes where
+    get = Bytes <$> Get.getRemainingLazyByteString
+    put _ = fail "Bytes"
+
+data Byte = Byte Word8
+    deriving (Eq, Show)
+
+instance Binary Byte where
+    get = Byte <$> Get.getWord8
+    put _ = fail "Byte"

src/tox/Network/Tox/SaveData/Conferences.hs

@@ -0,0 +1,70 @@
+{-# LANGUAGE RecordWildCards #-}
+module Network.Tox.SaveData.Conferences where
+
+import           Data.Binary     (Binary (..))
+import qualified Data.Binary.Get as Get
+import qualified Data.ByteString as BS
+import           Data.Word       (Word16, Word32, Word64, Word8)
+
+data Conferences = Conferences [Conference]
+    deriving (Eq, Show)
+
+instance Binary Conferences where
+    get = Conferences <$> go [] False
+      where
+        go nodes True = return $ reverse nodes
+        go nodes False = do
+            node <- get
+            isEmpty <- Get.isEmpty
+            go (node : nodes) isEmpty
+
+    put _ = fail "Conferences"
+
+
+data Conference = Conference
+    { conferenceType     :: Word8
+    , conferenceId       :: BS.ByteString
+    , messageNumber      :: Word32
+    , lossyMessageNumber :: Word16
+    , selfPeerNumber     :: Word16
+    , title              :: BS.ByteString
+    , peers              :: [Peer]
+    }
+    deriving (Eq, Show)
+
+instance Binary Conference where
+    get = do
+        conferenceType <- Get.getWord8
+        conferenceId <- Get.getByteString 32
+        messageNumber <- Get.getWord32le
+        lossyMessageNumber <- Get.getWord16le
+        selfPeerNumber <- Get.getWord16le
+        peerCount <- Get.getWord32le
+        titleLength <- Get.getWord8
+        title <- Get.getByteString (fromIntegral titleLength)
+        peers <- mapM (const get) [1..peerCount]
+        return Conference{..}
+
+    put _ = fail "Conference"
+
+
+data Peer = Peer
+    { publicKey      :: BS.ByteString
+    , dhtPublicKey   :: BS.ByteString
+    , peerNumber     :: Word16
+    , lastActiveTime :: Word64
+    , name           :: BS.ByteString
+    }
+    deriving (Eq, Show)
+
+instance Binary Peer where
+    get = do
+        publicKey <- Get.getByteString 32
+        dhtPublicKey <- Get.getByteString 32
+        peerNumber <- Get.getWord16le
+        lastActiveTime <- Get.getWord64le
+        nameLength <- Get.getWord8
+        name <- Get.getByteString (fromIntegral nameLength)
+        return Peer{..}
+
+    put _ = fail "Peer"

src/tox/Network/Tox/SaveData/DHT.hs

@@ -0,0 +1,47 @@
+module Network.Tox.SaveData.DHT where
+
+import           Control.Monad              (when)
+import           Data.Binary                (Binary (..))
+import qualified Data.Binary.Get            as Binary
+import           Data.Word                  (Word16, Word32)
+import           Network.Tox.SaveData.Nodes (Nodes)
+
+dhtMagic :: Word32
+dhtMagic = 0x0159000D
+
+data DHT = DHT [DhtSection]
+    deriving (Eq, Show)
+
+instance Binary DHT where
+    get = do
+        magic <- Binary.getWord32le
+        when (magic /= dhtMagic) $
+            fail $ "wrong magic number for DHT savedata: "
+                <> show magic <> " != " <> show dhtMagic
+
+        DHT <$> loadSections 0x11CE
+
+    put _ = fail "DHT"
+
+data DhtSection
+    = DhtSectionNodes Nodes
+    deriving (Eq, Show)
+
+loadSections :: Word16 -> Binary.Get [DhtSection]
+loadSections sectionMagic = go [] False
+  where
+    go sections True = return $ reverse sections
+    go sections False = do
+        len <- fromIntegral <$> Binary.getWord32le
+        sectionType <- Binary.getWord16le
+        magic <- Binary.getWord16le
+        when (magic /= sectionMagic) $
+            fail $ "wrong magic number for section: "
+                <> show magic <> " != " <> show sectionMagic
+
+        section <- Binary.isolate len $ case sectionType of
+            0x04 -> DhtSectionNodes <$> get
+            ty   -> fail $ show ty
+
+        isEmpty <- Binary.isEmpty
+        go (section : sections) isEmpty

src/tox/Network/Tox/SaveData/Friend.hs

@@ -0,0 +1,42 @@
+{-# LANGUAGE RecordWildCards #-}
+module Network.Tox.SaveData.Friend where
+
+import           Data.Binary     (Binary (..))
+import qualified Data.Binary.Get as Get
+import qualified Data.ByteString as BS
+import           Data.Word       (Word32, Word64, Word8)
+
+
+data Friend = Friend
+    { status        :: Word8
+    , publicKey     :: BS.ByteString
+    , friendRequest :: BS.ByteString
+    , name          :: BS.ByteString
+    , statusMessage :: BS.ByteString
+    , userStatus    :: Word8
+    , nospam        :: Word32
+    , lastSeenTime  :: Word64
+    }
+    deriving (Eq, Show)
+
+instance Binary Friend where
+    get = do
+        status           <- Get.getWord8
+        publicKey        <- Get.getByteString 32
+        friendRequest'   <- Get.getByteString 1024
+        _                <- Get.getWord8
+        friendRequestLen <- Get.getWord16be
+        name'            <- Get.getByteString 128
+        nameLen          <- Get.getWord16be
+        statusMessage'   <- Get.getByteString 1007
+        _                <- Get.getWord8
+        statusMessageLen <- Get.getWord16be
+        userStatus       <- Get.getWord8
+        _                <- Get.getByteString 3
+        nospam           <- Get.getWord32be
+        lastSeenTime     <- Get.getWord64be
+        let friendRequest = BS.take (fromIntegral friendRequestLen) friendRequest'
+        let name = BS.take (fromIntegral nameLen) name'
+        let statusMessage = BS.take (fromIntegral statusMessageLen) statusMessage'
+        return Friend{..}
+    put _ = fail "Friend"

src/tox/Network/Tox/SaveData/Nodes.hs

@@ -0,0 +1,19 @@
+module Network.Tox.SaveData.Nodes where
+
+import           Data.Binary                   (Binary (..))
+import qualified Data.Binary.Get               as Binary
+import           Network.Tox.NodeInfo.NodeInfo (NodeInfo)
+
+data Nodes = Nodes [NodeInfo]
+    deriving (Eq, Show)
+
+instance Binary Nodes where
+    get = Nodes <$> go [] False
+      where
+        go nodes True = return $ reverse nodes
+        go nodes False = do
+            node <- get
+            isEmpty <- Binary.isEmpty
+            go (node : nodes) isEmpty
+
+    put _ = fail "Nodes"