summaryrefslogtreecommitdiff
path: root/src/Network/Kademlia/Persistence.hs
blob: d7431671cd3b2e5208dc0561254497e6b59759a4 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
{-# LANGUAGE NamedFieldPuns            #-}
module Network.Kademlia.Persistence where

import Network.Kademlia.CommonAPI
import Network.Kademlia.Routing as R

import Control.Concurrent.STM
import qualified Data.Aeson           as J
         ;import Data.Aeson           as J (FromJSON)
import qualified Data.ByteString.Lazy as L
import qualified Data.HashMap.Strict  as HashMap
import Data.List
import qualified Data.Vector          as V
import System.IO.Error

saveNodes :: String -> DHT -> IO ()
saveNodes netname DHT{dhtBuckets} = do
    bkts <- atomically $ readTVar dhtBuckets
    let ns = map fst $ concat $ R.toList bkts
        bs = J.encode ns
        fname = nodesFileName netname
    L.writeFile fname bs

loadNodes :: FromJSON ni => String -> IO [ni]
loadNodes netname = do
    let fname = nodesFileName netname
    attempt <- tryIOError $ do
        J.decode <$> L.readFile fname
         >>= maybe (ioError $ userError "Nothing") return
    either (const $ fallbackLoad fname) return attempt

nodesFileName :: String -> String
nodesFileName netname = netname ++ "-nodes.json"

fallbackLoad :: FromJSON t => FilePath -> IO [t]
fallbackLoad fname = do
    attempt <- tryIOError $ do
        J.decode <$> L.readFile fname
         >>= maybe (ioError $ userError "Nothing") return
    let go r = do
            let m = HashMap.lookup "nodes" (r :: J.Object)
                ns0 = case m of Just (J.Array v) -> V.toList v
                                Nothing        -> []
                ns1 = zip (map J.fromJSON ns0) ns0
                issuc (J.Error _,_) = False
                issuc _             = True
                (ss,fs) = partition issuc ns1
                ns = map (\(J.Success n,_) -> n) ss
            mapM_ print (map snd fs)  >> return ns
    either (const $ return []) go attempt