diff options
author | Andrew Cady <d@jerkface.net> | 2018-06-21 15:47:37 -0400 |
---|---|---|
committer | Andrew Cady <d@jerkface.net> | 2018-06-21 22:35:10 -0400 |
commit | 4fc283da8edff660e1e7a3161745a8b2f11dc356 (patch) | |
tree | dd724032b18747a015ed91f2747d08e4267a4bc7 /examples | |
parent | 51afa5a352b515ed77fba27e5e7e07ee2238ac1c (diff) |
trivial refactor; ran autoformatter
Diffstat (limited to 'examples')
-rw-r--r-- | examples/dhtd.hs | 74 |
1 files changed, 40 insertions, 34 deletions
diff --git a/examples/dhtd.hs b/examples/dhtd.hs index fe639af1..da93bed4 100644 --- a/examples/dhtd.hs +++ b/examples/dhtd.hs | |||
@@ -1,4 +1,5 @@ | |||
1 | {-# LANGUAGE BangPatterns #-} | 1 | {-# LANGUAGE BangPatterns #-} |
2 | {-# LANGUAGE ViewPatterns #-} | ||
2 | {-# LANGUAGE CPP #-} | 3 | {-# LANGUAGE CPP #-} |
3 | {-# LANGUAGE ExistentialQuantification #-} | 4 | {-# LANGUAGE ExistentialQuantification #-} |
4 | {-# LANGUAGE FlexibleContexts #-} | 5 | {-# LANGUAGE FlexibleContexts #-} |
@@ -1233,41 +1234,46 @@ netcrypto | |||
1233 | -> IO () | 1234 | -> IO () |
1234 | netcrypto _ _ h _ Nothing _ = hPutClient h "Requires Tox enabled." | 1235 | netcrypto _ _ h _ Nothing _ = hPutClient h "Requires Tox enabled." |
1235 | netcrypto _ Nothing h _ _ _ = hPutClient h "No key is selected, see k command." | 1236 | netcrypto _ Nothing h _ _ _ = hPutClient h "No key is selected, see k command." |
1236 | netcrypto dht (Just mypubkey) h roster (Just tox) keystr | Just DHT{..} <- dht = do | 1237 | netcrypto (Just (DHT {..})) (Just mypubkey) h roster (Just tox) keystr = |
1237 | let goParse = either | 1238 | either |
1238 | (\_ -> either (hPutClient h . ("Bad netcrypto target: "++)) | 1239 | (const $ |
1239 | (goTarget . Left) | 1240 | either |
1240 | (readEither keystr)) -- attempt read as NodeInfo type | 1241 | (hPutClient h . ("Bad netcrypto target: " ++)) |
1241 | (goTarget . Right . Tox.id2key) | 1242 | goNodeInfo |
1242 | $ readEither keystr -- attempt read as NodeId type | 1243 | (readEither keystr) -- attempt read as NodeInfo type |
1243 | goParse | 1244 | ) |
1245 | (goPubkey . Tox.id2key) $ | ||
1246 | readEither keystr -- attempt read as NodeId type | ||
1244 | where | 1247 | where |
1245 | goTarget (Left userkey_nodeinfo) = do | 1248 | goNodeInfo userkey_nodeinfo = do |
1246 | msec <- atomically $ do | 1249 | msec <- |
1247 | fmap userSecret . HashMap.lookup (Tox.key2id mypubkey) <$> readTVar (accounts roster) | 1250 | atomically $ do |
1248 | case msec of | 1251 | fmap userSecret . HashMap.lookup (Tox.key2id mypubkey) <$> |
1249 | Nothing -> hPutClient h "Error getting secret key" | 1252 | readTVar (accounts roster) |
1250 | Just sec -> do | 1253 | case msec of |
1251 | let their_pub = Tox.id2key $ Tox.nodeId userkey_nodeinfo | 1254 | Nothing -> hPutClient h "Error getting secret key" |
1252 | their_addr = Tox.nodeAddr userkey_nodeinfo | 1255 | Just sec -> do |
1253 | let acsVar = accounts (Tox.toxContactInfo tox) | 1256 | let their_pub = Tox.id2key $ Tox.nodeId userkey_nodeinfo |
1254 | acsmap <- atomically $ readTVar acsVar | 1257 | their_addr = Tox.nodeAddr userkey_nodeinfo |
1255 | case HashMap.lookup (Tox.key2id mypubkey) acsmap of | 1258 | let acsVar = accounts (Tox.toxContactInfo tox) |
1256 | Nothing -> hPutClient h "Unable to find account for selected key" | 1259 | acsmap <- atomically $ readTVar acsVar |
1257 | Just account -> do | 1260 | case HashMap.lookup (Tox.key2id mypubkey) acsmap of |
1258 | now <- getPOSIXTime | 1261 | Nothing -> hPutClient h "Unable to find account for selected key" |
1259 | atomically $ setContactAddr now their_pub their_addr account | 1262 | Just account -> do |
1260 | Tox.netCrypto tox sec their_pub | 1263 | now <- getPOSIXTime |
1261 | hPutClient h "Handshake sent" | 1264 | atomically $ setContactAddr now their_pub their_addr account |
1262 | goTarget (Right their_pub) = do | 1265 | Tox.netCrypto tox sec their_pub |
1263 | msec <- atomically $ do | 1266 | hPutClient h "Handshake sent" |
1264 | ks <- map swap <$> myKeyPairs roster | 1267 | goPubkey their_pub = do |
1265 | return $ Data.List.lookup mypubkey ks | 1268 | msec <- |
1266 | case msec of | 1269 | atomically $ do |
1267 | Nothing -> hPutClient h "Error getting secret key" | 1270 | ks <- map swap <$> myKeyPairs roster |
1268 | Just sec -> do | 1271 | return $ Data.List.lookup mypubkey ks |
1269 | Tox.netCrypto tox sec their_pub | 1272 | case msec of |
1270 | hPutClient h "Handshake sent" | 1273 | Nothing -> hPutClient h "Error getting secret key" |
1274 | Just sec -> do | ||
1275 | Tox.netCrypto tox sec their_pub | ||
1276 | hPutClient h "Handshake sent" | ||
1271 | 1277 | ||
1272 | readExternals :: (ni -> SockAddr) -> [TVar (BucketList ni)] -> IO [SockAddr] | 1278 | readExternals :: (ni -> SockAddr) -> [TVar (BucketList ni)] -> IO [SockAddr] |
1273 | readExternals nodeAddr vars = do | 1279 | readExternals nodeAddr vars = do |