trivial refactor

1 files changed, 52 insertions, 46 deletions

diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index b81e88b5..000583c5 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -879,52 +879,7 @@ clientSession s@Session{..} sock cnum h = do
 
         -- necrypto <FRIEND-TOXID>
         -- establish a netcrypto session with specified person
-        ("netcrypto", s)
-                    | Just DHT{..} <- Map.lookup netname dhts
-                    -> cmd0 $ do
-            case selectedKey of
-                Nothing -> hPutClient h "No key is selected, see k command."
-                Just mypubkey -> do
-                    let keystr = strp s
-                        goParse = either
-                                         (\_ -> either (hPutClient h . ("Bad netcrypto target: "++))
-                                                 (goTarget . Left)
-                                                 (readEither keystr)) -- attempt read as NodeInfo type
-                                         (goTarget . Right  . Tox.id2key)
-                                         $ readEither keystr -- attempt read as NodeId type
-                        goTarget (Left userkey_nodeinfo) = do
-                            msec <- atomically $ do
-                                fmap userSecret . HashMap.lookup (Tox.key2id mypubkey) <$> readTVar (accounts roster)
-                            case mbTox of
-                                Nothing -> hPutClient h "Requires Tox enabled."
-                                Just tox-> do
-                                    case msec of
-                                        Nothing -> hPutClient h "Error getting secret key"
-                                        Just sec -> do
-                                            let their_pub = Tox.id2key $ Tox.nodeId userkey_nodeinfo
-                                                their_addr = Tox.nodeAddr userkey_nodeinfo
-                                            let acsVar = accounts (Tox.toxContactInfo tox)
-                                            acsmap <- atomically $ readTVar acsVar
-                                            case HashMap.lookup (Tox.key2id mypubkey) acsmap of
-                                                Nothing -> hPutClient h "Unable to find account for selected key"
-                                                Just account -> do
-                                                    now <- getPOSIXTime
-                                                    atomically $ setContactAddr now their_pub their_addr account
-                                                    Tox.netCrypto tox sec their_pub
-                                                    hPutClient h "Handshake sent"
-                        goTarget (Right their_pub) = do
-                            msec <- atomically $ do
-                                ks <- map swap <$> myKeyPairs roster
-                                return $ Data.List.lookup mypubkey ks
-                            case mbTox of
-                                Nothing -> hPutClient h "Requires Tox enabled."
-                                Just tox-> do
-                                    case msec of
-                                        Nothing -> hPutClient h "Error getting secret key"
-                                        Just sec -> do
-                                            Tox.netCrypto tox sec their_pub
-                                            hPutClient h "Handshake sent"
-                    goParse
+        ("netcrypto", s) -> cmd0 $ netcrypto (Map.lookup netname dhts) selectedKey h roster mbTox (strp s)
         ("g", s) | Just DHT{..} <- Map.lookup netname dhts
                     -> cmd0 $ do
                         -- arguments: method
@@ -1268,6 +1223,57 @@ clientSession s@Session{..} sock cnum h = do
 
         _    -> cmd0 $ hPutClient h "error."
 
+netcrypto
+  :: Maybe DHT
+  -> Maybe PublicKey
+  -> ClientHandle
+  -> ContactInfo extra1
+  -> Maybe (Tox.Tox extra2)
+  -> String
+  -> IO ()
+netcrypto dht selectedKey h roster mbTox keystr | Just DHT{..} <- dht = do
+            case selectedKey of
+                Nothing -> hPutClient h "No key is selected, see k command."
+                Just mypubkey -> do
+                    let goParse = either
+                                         (\_ -> either (hPutClient h . ("Bad netcrypto target: "++))
+                                                 (goTarget . Left)
+                                                 (readEither keystr)) -- attempt read as NodeInfo type
+                                         (goTarget . Right  . Tox.id2key)
+                                         $ readEither keystr -- attempt read as NodeId type
+                        goTarget (Left userkey_nodeinfo) = do
+                            msec <- atomically $ do
+                                fmap userSecret . HashMap.lookup (Tox.key2id mypubkey) <$> readTVar (accounts roster)
+                            case mbTox of
+                                Nothing -> hPutClient h "Requires Tox enabled."
+                                Just tox-> do
+                                    case msec of
+                                        Nothing -> hPutClient h "Error getting secret key"
+                                        Just sec -> do
+                                            let their_pub = Tox.id2key $ Tox.nodeId userkey_nodeinfo
+                                                their_addr = Tox.nodeAddr userkey_nodeinfo
+                                            let acsVar = accounts (Tox.toxContactInfo tox)
+                                            acsmap <- atomically $ readTVar acsVar
+                                            case HashMap.lookup (Tox.key2id mypubkey) acsmap of
+                                                Nothing -> hPutClient h "Unable to find account for selected key"
+                                                Just account -> do
+                                                    now <- getPOSIXTime
+                                                    atomically $ setContactAddr now their_pub their_addr account
+                                                    Tox.netCrypto tox sec their_pub
+                                                    hPutClient h "Handshake sent"
+                        goTarget (Right their_pub) = do
+                            msec <- atomically $ do
+                                ks <- map swap <$> myKeyPairs roster
+                                return $ Data.List.lookup mypubkey ks
+                            case mbTox of
+                                Nothing -> hPutClient h "Requires Tox enabled."
+                                Just tox-> do
+                                    case msec of
+                                        Nothing -> hPutClient h "Error getting secret key"
+                                        Just sec -> do
+                                            Tox.netCrypto tox sec their_pub
+                                            hPutClient h "Handshake sent"
+                    goParse
 
 readExternals :: (ni -> SockAddr) -> [TVar (BucketList ni)] -> IO [SockAddr]
 readExternals nodeAddr vars = do