simplify refreshCache

1 files changed, 19 insertions, 24 deletions

diff --git a/lib/Kiki.hs b/lib/Kiki.hs
index 58dfa20..5481241 100644
--- a/lib/Kiki.hs
+++ b/lib/Kiki.hs
@@ -38,7 +38,6 @@ import           System.Posix.Types         (FileMode)
 import           System.Posix.IO            as Posix (createPipe)
 import           System.Posix.User
 #if defined(VERSION_memory)
-import           Data.ByteArray (convert)
 import           Data.ByteArray.Encoding
 import qualified Data.ByteString.Char8      as S8
 #elif defined(VERSION_dataenc)
@@ -48,7 +47,6 @@ import qualified Data.ByteString.Lazy       as L
 import qualified Data.ByteString.Lazy.Char8 as Char8
 import qualified Data.Map.Strict            as Map
 import           Network.Socket
-import           ProcessUtils
 import qualified SSHKey                     as SSH
 
 import           CommandLine
@@ -378,10 +376,10 @@ ipsecPath :: String -> Char8.ByteString -> String
 ipsecPath theDirName theBaseName = "ipsec.d/" ++ theDirName ++ "/" ++ Char8.unpack theBaseName
 
 ipsecKeyPath :: MyIdentity -> FilePath
-ipsecKeyPath (MyIdentity (Char8.pack . showA -> addr)) = ipsecPath "private" (addr <> ".pem")
+ipsecKeyPath (MyIdentity (Char8.pack . showA -> addr) _) = ipsecPath "private" (addr <> ".pem")
 
 ipsecCertPath :: MyIdentity -> FilePath
-ipsecCertPath (MyIdentity (Char8.pack . showA -> addr)) = ipsecPath "certs" (addr <> ".pem")
+ipsecCertPath (MyIdentity (Char8.pack . showA -> addr) _) = ipsecPath "certs" (addr <> ".pem")
 
 peerCertPath :: Peer -> FilePath
 peerCertPath = ipsecPath "certs" . coerce . peerCertificateName
@@ -475,11 +473,12 @@ getSshKnownHosts peer@Peer{kd} = Char8.unlines taggedblobs
       map ((coerce n <> " ") <>) blobs
 
 data MyIdentity = MyIdentity {
-  myGpgAddress :: SockAddr
+  myGpgAddress :: SockAddr,
+  myGpgKeyGrip :: String
 }
 
 installIpsecConf :: FileWriter -> MyIdentity -> [Peer] -> IO ()
-installIpsecConf fw (MyIdentity wkaddr) cs = do
+installIpsecConf fw MyIdentity{myGpgAddress} cs = do
     snippets <- mapM (coerce . installIpsecPeerCertificate fw) cs
     writeL fw "ipsec.conf" . Char8.unlines
           $ [ "conn %default"
@@ -491,10 +490,10 @@ installIpsecConf fw (MyIdentity wkaddr) cs = do
             , "  dpddelay=10s"
             , "  dpdaction=restart"
             , "  left=%defaultroute"
-            , "  leftsubnet=" <> Char8.pack (showA wkaddr) <> "/128"
+            , "  leftsubnet=" <> Char8.pack (showA myGpgAddress) <> "/128"
             , "  leftauth=pubkey"
-            , "  leftid=" <> Char8.pack (showA wkaddr)
-            , "  leftsigkey=" <> Char8.pack (showA wkaddr) <> ".pem"
+            , "  leftid=" <> Char8.pack (showA myGpgAddress)
+            , "  leftsigkey=" <> Char8.pack (showA myGpgAddress) <> ".pem"
             , "  leftikeport=4500"
             , "  rightikeport=4500"
             , "  right=%any"
@@ -504,25 +503,21 @@ installIpsecConf fw (MyIdentity wkaddr) cs = do
             , ""
             ] ++ filter (not . Char8.null) snippets
 
+getMyIdentity :: KeyRingRuntime -> Maybe MyIdentity
+getMyIdentity rt = do
+    wk <- rtWorkingKey rt
+    Hostnames wkaddr _ _ _ <- Just $ getHostnames (byKeyKey (rtKeyDB rt) Map.! keykey wk)
+    return $ MyIdentity wkaddr (fingerprint wk)
+
 refreshCache :: KeyRingRuntime -> Maybe FilePath -> IO ()
 refreshCache rt rootdir = do
     fw <- getMkPathAndCommit (fromMaybe "" rootdir ++ "/var/cache/kiki/config")
     generateHostsFile fw rt
     fromMaybe (error "No working key.") $ do
-    wk <- rtWorkingKey rt
-    Hostnames wkaddr onames _ _ <- Just $ getHostnames (byKeyKey (rtKeyDB rt) Map.! keykey wk)
+    myId <- getMyIdentity rt
     Just $ do
-    let oname = Char8.concat $ take 1 onames
-    if (oname == "") then error "Missing tor key" else do
-    -- sshcpathpub0 = fromMaybe "" rootdir ++ osHomeDir </> ".ssh" </> "id_rsa.pub"
-    -- sshspathpub0 = fromMaybe "" rootdir ++ "/etc/ssh/ssh_host_rsa_key.pub"
-    -- contactipsec0 = fromMaybe "" rootdir ++ "/etc/ipsec.d/certs/%(onion).pem"
-
-    flip (maybe $ warn "missing working key?") (rtWorkingKey rt) $ \wk -> do
 
-    let grip = fingerprint wk
-        myId = MyIdentity wkaddr
-        exportOp = passphrases <> pemSecrets
+    let exportOp = passphrases <> pemSecrets
                                <> minimalOp False
                                             (CommonArgsParsed (Just $ takeDirectory $ rtPubring rt)
                                                               Nothing)
@@ -547,7 +542,7 @@ refreshCache rt rootdir = do
     outputReport report
     -- outputReport $ map (first $ resolveForReport ctx) $ filter ((/=ExportedSubkey) . snd) report
     rt'' <- rethrowKikiErrors rt'
-    writePublicKeyFiles rt'' fw grip myId
+    writePublicKeyFiles rt'' fw myId
 
 rethrowKikiErrors :: KikiCondition a -> IO a
 rethrowKikiErrors BadPassphrase =
@@ -567,8 +562,8 @@ listPeers rt = map (uncurry Peer) . filter notme . mapMaybe namedContact . Map.e
       _ <- listToMaybe $ allNames h
       return (h, kd)
 
-writePublicKeyFiles :: KeyRingRuntime -> FileWriter -> String -> MyIdentity -> IO ()
-writePublicKeyFiles rt fw grip myId = do
+writePublicKeyFiles :: KeyRingRuntime -> FileWriter -> MyIdentity -> IO ()
+writePublicKeyFiles rt fw myId@(MyIdentity _ grip) = do
 
     -- Finally, export public keys if they do not exist.
     either warn (write fw "root/.ssh/id_rsa.pub") $ show_ssh' "ssh-client" grip (rtKeyDB rt)