From e12e30f216538ab2e96fd241d8ff77984dbcc271 Mon Sep 17 00:00:00 2001
From: Andrew Cady <d@jerkface.net>
Date: Tue, 9 Jul 2019 15:54:04 -0400
Subject: use type more

---
 lib/KeyRing/BuildKeyDB.hs | 22 +++++++++++++---------
 1 file changed, 13 insertions(+), 9 deletions(-)

(limited to 'lib/KeyRing/BuildKeyDB.hs')

diff --git a/lib/KeyRing/BuildKeyDB.hs b/lib/KeyRing/BuildKeyDB.hs
index 5e90655..2074ce3 100644
--- a/lib/KeyRing/BuildKeyDB.hs
+++ b/lib/KeyRing/BuildKeyDB.hs
@@ -525,6 +525,14 @@ parseSpec grip spec = (topspec,subspec)
      unprefix c spec = if null (snd p) then swap p else (fst p, tail (snd p))
       where p = break (==c) spec
 -}
+outgoing_names :: KeyDB -> [Hosts.Hosts] -> IPsToWriteToHostsFile
+outgoing_names db hostdbs0 = IPsToWriteToHostsFile $ do
+    Hostnames addr _ gns _ <- gpgnames
+    guard . not $ null gns
+    guard $ all (null . Hosts.namesForAddress addr) hostdbs0
+    return addr
+  where
+    gpgnames = map getHostnames $ Map.elems db
 
 filterMatches :: KeySpec -> [(KeyKey,KeyData)] -> [(KeyKey,KeyData)]
 filterMatches spec ks = filter (matchSpec spec . snd) ks
@@ -593,11 +601,7 @@ mergeHostFiles krd db ctx = do
         setOnions hosts = foldl' (flip $ uncurry Hosts.assignName) hosts os
         -- we ensure .onion names are set properly
         hostdbs = map setOnions hostdbs0
-        outgoing_names = do
-            Hostnames addr _ gns _ <- gpgnames
-            guard . not $ null gns
-            guard $ all (null . Hosts.namesForAddress addr) hostdbs0
-            return addr
+        addrs = outgoing_names db hostdbs0
     -- putStrLn $ "hostdbs = " ++ show hostdbs
 
     -- 1. let U = union all the host dbs
@@ -618,9 +622,9 @@ mergeHostFiles krd db ctx = do
 
     -- 2. replace gpg annotations with those in U
     -- forM use_db
-    db' <- Traversable.mapM (setHostnames outgoing_names u1) db
+    db' <- Traversable.mapM (setHostnames addrs u1) db
 
-    return $ KikiSuccess ((db',(hostdbs0,hostdbs,u1,gpgnames,IPsToWriteToHostsFile outgoing_names)),[])
+    return $ KikiSuccess ((db',(hostdbs0,hostdbs,u1,gpgnames,addrs)),[])
 
 readInputFileL :: InputFileContext -> InputFile -> IO L.ByteString
 readInputFileL ctx (Pipe fd _)   = fdToHandle fd >>= L.hGetContents
@@ -948,8 +952,8 @@ hasFingerDress db addr = pre=="fd" && isJust (selectPublicKey (KeyGrip g',Nothin
     g' = map toUpper g
 
 -- We return into IO in case we want to make a signature here.
-setHostnames :: [SockAddr] -> Hosts.Hosts -> KeyData -> IO KeyData
-setHostnames outgoing_names hosts kd@(KeyData topmp topsigs uids subs) =
+setHostnames :: IPsToWriteToHostsFile -> Hosts.Hosts -> KeyData -> IO KeyData
+setHostnames (IPsToWriteToHostsFile outgoing_names) hosts kd@(KeyData topmp topsigs uids subs) =
     -- TODO: we are removing the origin from the UID OriginMap,
     --       when we should be removing origins from the locations
     --       field of the sig's MappedPacket records.
-- 
cgit v1.2.3