Moved persistence and generic dht api from main module to library.

1 files changed, 3 insertions, 105 deletions

diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index fb42597e..67507634 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -72,12 +72,12 @@ import Network.UPNP as UPNP
 import Network.Address hiding (NodeId, NodeInfo(..))
 import Network.QueryResponse
 import Network.StreamServer
+import Network.Kademlia.CommonAPI
+import Network.Kademlia.Persistence
+import Network.Kademlia.Routing as R
 import Network.Kademlia.Search
 import qualified Network.BitTorrent.MainlineDHT as Mainline
 import qualified Network.Tox as Tox
-import Network.Kademlia.Routing as R
-import Data.Aeson as J (ToJSON, FromJSON)
-import qualified Data.Aeson as J
 import qualified Data.ByteString.Lazy as L
 import qualified Data.ByteString.Char8 as B
 import qualified Data.Text as T
@@ -159,108 +159,6 @@ hPutClientChunk (ClientHandle h hstate) s = do
     hPutStr h (' ' : marshalForClient s)
     putMVar hstate 2 -- ready for more output
 
-data DHTQuery nid ni = forall addr r tok.
-                        ( Ord addr
-                        , Typeable r
-                        , Typeable tok
-                        , Typeable ni
-                        ) => DHTQuery
-    { qsearch     :: Search nid addr tok ni r
-    , qhandler    :: ni -> nid -> IO ([ni], [r], Maybe tok) -- ^ Invoked on local node, when there is no query destination.
-    , qshowR      :: r -> String
-    , qshowTok    :: tok -> Maybe String
-    }
-
-data DHTAnnouncable nid = forall dta tok ni r.
-                        ( Show r
-                        , Typeable dta -- information being announced
-                        , Typeable tok -- token
-                        , Typeable r   -- search result
-                        , Typeable ni  -- node
-                        ) => DHTAnnouncable
-    { announceParseData    :: String -> Either String dta
-    , announceParseToken   :: dta -> String -> Either String tok
-    , announceParseAddress :: String -> Either String ni
-    , announceSendData     :: Either ( String {- search name -}
-                                     , String -> Either String r
-                                     , PublicKey {- me -} -> dta -> r -> IO ())
-                                     (dta -> tok -> Maybe ni -> IO (Maybe r))
-    , announceInterval     :: POSIXTime
-    , announceTarget       :: dta -> nid
-    }
-
-data DHTSearch nid ni = forall addr tok r. DHTSearch
-    { searchThread     :: ThreadId
-    , searchState      :: SearchState nid addr tok ni r
-    , searchShowTok    :: tok -> Maybe String
-    , searchResults    :: TVar (Set.Set String)
-    }
-
-data DHTPing ni = forall r. DHTPing
-    { pingQuery :: [String] -> ni -> IO (Maybe r)
-    , pingShowResult :: r -> String
-    }
-
-data DHT = forall nid ni. ( Show     ni
-                          , Read     ni
-                          , ToJSON   ni
-                          , FromJSON ni
-                          , Ord      ni
-                          , Hashable ni
-                          , Show     nid
-                          , Ord      nid
-                          , Hashable nid
-                          , Typeable ni
-                          , S.Serialize nid
-                          ) =>
-    DHT
-    { dhtBuckets       :: TVar (BucketList ni)
-    , dhtSecretKey     :: STM (Maybe SecretKey)
-    , dhtPing          :: Map.Map String (DHTPing ni)
-    , dhtQuery         :: Map.Map String (DHTQuery nid ni)
-    , dhtAnnouncables  :: Map.Map String (DHTAnnouncable nid)
-    , dhtParseId       :: String -> Either String nid
-    , dhtSearches      :: TVar (Map.Map (String,nid) (DHTSearch nid ni))
-    , dhtFallbackNodes :: IO [ni]
-    , dhtBootstrap     :: [ni] -> [ni] -> IO ()
-    }
-
-nodesFileName :: String -> String
-nodesFileName netname = netname ++ "-nodes.json"
-
-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
-
-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
-
 
 {-
 pingNodes :: String -> DHT -> IO Bool