Refactoring.

4 files changed, 27 insertions, 39 deletions

diff --git a/dht/Presence/Presence.hs b/dht/Presence/Presence.hs
index dcc76c5b..926ee3c2 100644
--- a/dht/Presence/Presence.hs
+++ b/dht/Presence/Presence.hs
@@ -54,6 +54,7 @@ import Network.Tox.NodeId (key2id,parseNoSpamId,nospam64,NoSpamId(..),ToxProgres
 import Crypto.Tox (decodeSecret)
 import DPut
 import DebugTag
+import Codec.AsciiKey256
 
 {-
 isPeerKey :: ClientAddress -> Bool
@@ -251,12 +252,12 @@ chooseResourceName state k (Remote addr) clientsNameForMe desired = do
     flgs <- atomically $ newTVar 0
     profile <- fmap (fromMaybe ".")
         $ forM ((,) <$> clientsNameForMe <*> toxManager state) $ \(wanted_profile0,toxman) ->
-        case splitLast4 wanted_profile0 of
-            ("*",".tox") -> do
+        case stripSuffix ".tox" wanted_profile0 of
+            Just "*" -> do
                 dput XMisc $ "TODO: Match single tox key profile or generate first."
                 -- TODO: Match single tox key profile or generate first.
                 _todo
-            (pub,".tox") -> do
+            Just pub -> do
                 cdir <- ConfigFiles.configPath (L.fromChunks [Text.encodeUtf8 user]) "." ""
 #if !MIN_VERSION_directory(1,2,5)
                 let listDirectory path = filter (`notElem` [".",".."]) <$> getDirectoryContents path
@@ -361,7 +362,7 @@ rosterGetStuff what state k = forClient state k (return [])
       PresenceState { server = sv } -> do
         let conns = manager state $ clientProfile client
         -- Grok peers to associate with from the roster:
-        let isTox = do (me  , ".tox") <- Just $ splitLast4 (clientProfile client)
+        let isTox = do me <- stripSuffix ".tox" (clientProfile client)
                        return me
             noToxUsers (u,h,r)
                 | Text.isSuffixOf ".tox" h = unsplitJID (Nothing,h,r)
@@ -373,8 +374,9 @@ rosterGetStuff what state k = forClient state k (return [])
             let policySetter = fromMaybe (Connection.setPolicy conns host) $ do
                     isTox
                     toxman <- toxManager state
-                    (them, ".tox") <- Just $ splitLast4 host
-                    meid <- readMaybe $ Text.unpack $ Text.dropEnd 4 (clientProfile client)
+                    them <- stripSuffix ".tox" host
+                    prof <- stripSuffix ".tox" (clientProfile client)
+                    meid   <- readMaybe $ Text.unpack prof
                     themid <- readMaybe $ Text.unpack them
                     return $ Connection.setPolicy (toxConnections toxman)
                                                   (ToxContact meid themid)
@@ -547,9 +549,9 @@ eofConn state saddr cdta = do
         Right (k,_) -> do
             forClient state k (return ()) $ \client -> do
             forM_ (toxManager state) $ \toxman -> do
-                case splitLast4 (clientProfile client) of
-                    (pub,".tox") -> deactivateAccount toxman k (clientProfile client)
-                    _            -> return ()
+                case stripSuffix ".tox" (clientProfile client) of
+                    Just pub -> deactivateAccount toxman k (clientProfile client)
+                    _        -> return ()
             stanza <- makePresenceStanza "jabber:server" Nothing Offline
             informClientPresence state k stanza
             atomically $ do
@@ -665,12 +667,12 @@ deliverMessage state fail msg =
                          -- In case the client sends us a lower-cased version of the base64
                          -- tox key hostname, we resolve it by comparing it with roster entries.
                          xs <- getBuddiesAndSolicited state (clientProfile client) $ \case
-                            rh | (_,".tox") <- splitLast4 rh
+                            rh | Just _ <- stripSuffix ".tox" rh
                                , Text.toLower rh == Text.toLower th
                                -> return True
                             _ -> return False
                          fmap join $ forM (listToMaybe xs) $ \(_,rmu,_,h) -> do
-                             let (them,_) = splitLast4 h
+                             let them = fromMaybe h $ stripSuffix ".tox" h
                              maddr <- resolveToxPeer toxman me them
                              let to' = unsplitJID (mu,h,rsc)
                              return $ fmap (to',) maddr
@@ -1168,21 +1170,19 @@ clientSubscriptionRequest state fail k stanza chan = do
                                      (connChan con)
         let policySetter = fromMaybe (Connection.setPolicy conns h) $ do
                 (toxman,_,_) <- weAreTox state client h
-                meid <- readMaybe $ Text.unpack $ case splitLast4 (clientProfile client) of
-                            (h,".tox") -> h
-                            _          -> clientProfile client
+                meid <- readMaybe $ Text.unpack $ case stripSuffix ".tox" (clientProfile client) of
+                            Just h -> h
+                            _      -> clientProfile client
                 themid <- readMaybe $ Text.unpack h
                 Just $ Connection.setPolicy (toxConnections toxman) (ToxContact meid themid)
         -- Add peer if we are not already associated ...
         policySetter Connection.TryingToConnect
 
-splitLast4 h = Text.splitAt (Text.length h - 4) h
-
 weAreTox :: PresenceState stat -> ClientState -> Text -> Maybe (ToxManager ClientAddress,Text{- me -},Text{- them -})
 weAreTox state client h = do
     toxman <- toxManager state
-    (me  , ".tox") <- Just $ splitLast4 (clientProfile client)
-    (them, ".tox") <- Just $ splitLast4 h
+    me   <- stripSuffix ".tox" (clientProfile client)
+    them <- stripSuffix ".tox" h
     return (toxman,me,them)
 
 resolvedFromRoster
diff --git a/dht/ToxManager.hs b/dht/ToxManager.hs
index 51567b27..408b12d2 100644
--- a/dht/ToxManager.hs
+++ b/dht/ToxManager.hs
@@ -9,6 +9,7 @@ module ToxManager where
 import Announcer
 import Announcer.Tox
 import ClientState
+import Codec.AsciiKey256
 import ConfigFiles
 import Control.Arrow
 import Control.Concurrent.STM
@@ -89,13 +90,6 @@ stringToKey_ s = let (xs,ys) = break (==':') s
                                        them <- readMaybe (drop 1 ys)
                                        return $ ToxContact me them
 
-dropExtension :: T.Text -> T.Text
-dropExtension pubname = case T.dropWhileEnd (/='.') pubname of
-    x | T.null x  -> pubname
-      | otherwise -> case T.dropEnd 1 pubname of
-            y | T.null y  -> pubname -- Avoid changing "." to empty string.
-              | otherwise -> y
-
 -- |
 --
 -- These hooks will be invoked in order to connect to *.tox hosts in a user's
@@ -146,7 +140,7 @@ toxman ssvar announcer toxbkts tox presence = ToxManager
     , deactivateAccount      = \k pubname -> do
        dput XMan $ "toxman DECTIVATE (todo) 1 " ++ show pubname
        let ContactInfo{ accounts } = Tox.toxContactInfo tox
-           mpubid = readMaybe $ T.unpack $ dropExtension pubname
+           mpubid = stripSuffix ".tox" pubname >>= readMaybe . T.unpack
        bStopped <- fmap (fromMaybe Nothing) $ atomically $ do
         forM mpubid $ \pubid -> do
         refs <- do
diff --git a/dht/dht-client.cabal b/dht/dht-client.cabal
index 31f78bcf..c58aa82a 100644
--- a/dht/dht-client.cabal
+++ b/dht/dht-client.cabal
@@ -157,6 +157,7 @@ library
                     Network.Tox.AggregateSession
                     Network.Tox.Session
                     DebugTag
+                    Codec.AsciiKey256
                     Paths_dht_client
 
   build-depends:      base
diff --git a/dht/examples/dhtd.hs b/dht/examples/dhtd.hs
index 3e9f8ff5..adfe0d69 100644
--- a/dht/examples/dhtd.hs
+++ b/dht/examples/dhtd.hs
@@ -63,6 +63,7 @@ import System.Posix.Signals
 import Announcer
 import Announcer.Tox
 import ToxManager
+import Codec.AsciiKey256
 import Crypto.Tox -- (zeros32,SecretKey,PublicKey, generateSecretKey, toPublic, encodeSecret, decodeSecret, userKeys)
 import DebugUtil
 import Network.UPNP as UPNP
@@ -1302,27 +1303,19 @@ onNewToxSession sv ssvar invc ContactInfo{accounts} addrTox netcrypto = do
     return ()
 
 selectManager :: Maybe (t -> ToxManager clientAddress) -> Manager Tcp.TCPStatus T.Text -> T.Text -> Manager Pending T.Text
-selectManager mtman tcp profile = case T.splitAt (T.length profile - 4) profile of
-    (k,".tox") | Just tman <- mtman
+selectManager mtman tcp profile = case stripSuffix ".tox" profile of
+    Just k | Just tman <- mtman
                -> let -- The following error call is safe because the toxConnections field
                       -- does not make use of the PresenceState passed to tman.
                       tox = toxConnections $ tman $ error "PresenseState"
-                      tkey them = do
+                      tkey them0 = do
                         me <- readMaybe (T.unpack k)
-                        them <- case T.splitAt 52 them of
-                            (them0,".tox") -> readMaybe (T.unpack them0)
-                            _              -> case T.splitAt 43 them of
-                                (them0,".tox") -> readMaybe (T.unpack them0)
-                                _              -> Nothing
+                        them <- stripSuffix ".tox" them0 >>= readMaybe . T.unpack
                         return (Tox.ToxContact me them)
                   in Manager
                     { resolvePeer = \themhost -> do
                         r <- fromMaybe (return []) $ do
-                            themT <- case T.splitAt 52 themhost of
-                                (ts,".tox") -> Just ts
-                                _           -> case T.splitAt 43 themhost of
-                                    (ts,".tox") -> Just ts
-                                    _           -> Nothing
+                            themT <- stripSuffix ".tox" themhost
                             them <- readMaybe $ T.unpack themT
                             me <- readMaybe $ T.unpack k
                             let contact = Tox.ToxContact me them