blob: f89287fe19277b05511a450e5c19623afa04dc82 (
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
52
|
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
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 (refreshBuckets 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
|
