From 094de312dfa610292afecc8c91e4ac57171babaf Mon Sep 17 00:00:00 2001
From: Andrew Cady <d@jerkface.net>
Date: Fri, 12 Jul 2019 17:58:08 -0400
Subject: more types

---
 lib/Kiki.hs | 44 ++++++++++++++++++++++++--------------------
 1 file changed, 24 insertions(+), 20 deletions(-)

diff --git a/lib/Kiki.hs b/lib/Kiki.hs
index 7fc96b3..e624ba6 100644
--- a/lib/Kiki.hs
+++ b/lib/Kiki.hs
@@ -333,7 +333,7 @@ importAndRefresh root cmn cipher = do
     when (not bUnprivileged) $ refreshCache rt rootdir
 
 data IpsecPeerConfig = IpsecPeerConfig
-  { contactname :: Char8.ByteString
+  { contactname :: UidHostname
   , addr        :: SockAddr
   , kd          :: KeyData
   }
@@ -351,8 +351,8 @@ installIpsecPeerCertificate fw IpsecPeerConfig{..} =
                 flip (either warn') (pemFromPacket k :: Either String String) $ \pem -> do
                     case sshs of
                         (sshkey:_) -> do
-                          theirHostname <- sshKeyToHostname sshkey
-                          write fw (ipsecCertPath theirHostname) pem
+                          theirHostname <- ResolvableHostname <$> sshKeyToHostname sshkey
+                          write fw (ipsecCertPath contactname) pem
                           return $ strongswanPeerConfiguration addr contactname theirHostname
                         _ -> error "fuck."
   where
@@ -370,13 +370,13 @@ installIpsecPeerCertificate fw IpsecPeerConfig{..} =
     sshs = sortOn (Down . timestamp)
              $ getSubkeys CrossSigned their_master (keySubKeys kd) "ssh-server"
 
-ipsecPath :: String -> Char8.ByteString -> String
-ipsecPath theDirName theBaseName = "ipsec.d/" ++ theDirName ++ "/" ++ Char8.unpack theBaseName ++ ".pem"
+ipsecPath :: String -> UidHostname -> String
+ipsecPath theDirName (UidHostname theBaseName) = "ipsec.d/" ++ theDirName ++ "/" ++ Char8.unpack theBaseName ++ ".pem"
 
-ipsecKeyPath :: Char8.ByteString -> FilePath
+ipsecKeyPath :: UidHostname -> FilePath
 ipsecKeyPath = ipsecPath "private"
 
-ipsecCertPath :: Char8.ByteString -> FilePath
+ipsecCertPath :: UidHostname -> FilePath
 ipsecCertPath = ipsecPath "certs"
 
 makeFileWriter :: (FilePath -> FilePath) -> (IO ()) -> FileWriter
@@ -453,11 +453,6 @@ generateHostsFile fw rt      = do
     KikiResult _ report <- runKeyRing op
     outputReport report
 
-names :: KeyRingRuntime -> Maybe Hostnames
-names rt = do wk <- rtWorkingKey rt
-              -- XXX unnecessary signature check
-              return $ getHostnames (byKeyKey (rtKeyDB rt) Map.! keykey wk)
-
 getssh               :: (Char8.ByteString, SockAddr, KeyData) -> Char8.ByteString
 getssh (contactname,_addr,kd) = do
             let their_master  = packet $ keyMappedPacket kd
@@ -468,6 +463,11 @@ getssh (contactname,_addr,kd) = do
                 taggedblobs   = map (\b                       -> contactname <> " " <> b) blobs
             Char8.unlines taggedblobs
 
+data IpsecConfig = IpsecConfig {
+  ourGpgAddress :: SockAddr,
+  ourSigKey :: (),
+  peers :: [IpsecPeerConfig]
+}
 
 installIpsecConf :: FileWriter -> SockAddr -> Char8.ByteString -> [IpsecPeerConfig] -> IO ()
 installIpsecConf fw wkaddr certBasename cs = do
@@ -500,11 +500,12 @@ refreshCache rt rootdir = do
     fw <- getMkPathAndCommit (fromMaybe "" rootdir ++ "/var/cache/kiki/config")
     generateHostsFile fw rt
     fromMaybe (error "No working key.") $ do
-    Hostnames wkaddr onames _ _ <- names rt
+    wk <- rtWorkingKey rt
+    Hostnames wkaddr onames _ _ <- Just $ getHostnames (byKeyKey (rtKeyDB rt) Map.! keykey wk)
     Just $ do
-    let oname = Char8.concat $ take 1 onames
-        bUnprivileged = False -- TODO
-    if (oname == "") && (not bUnprivileged) then error "Missing tor key" else do
+    let oname = UidHostname $ 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"
@@ -544,7 +545,10 @@ rethrowKikiErrors BadPassphrase =
   error "Operation requires correct passphrase. (Hint: Use --passphrase-fd=0 to input it on stdin.)"
 rethrowKikiErrors rt = unconditionally $ return rt
 
-writePublicKeyFiles :: KeyRingRuntime -> FileWriter -> String -> Char8.ByteString -> SockAddr -> IO ()
+newtype UidHostname = UidHostname Char8.ByteString
+newtype ResolvableHostname = ResolvableHostname Char8.ByteString
+
+writePublicKeyFiles :: KeyRingRuntime -> FileWriter -> String -> UidHostname -> SockAddr -> IO ()
 writePublicKeyFiles rt fw grip oname wkaddr = do
 
     -- Finally, export public keys if they do not exist.
@@ -554,7 +558,7 @@ writePublicKeyFiles rt fw grip oname wkaddr = do
 
     let onionkeys = mapMaybe namedContact $ Map.elems $ byKeyKey $ rtKeyDB rt
         cs = filter (\(_,_,kd) -> notme kd) onionkeys
-        cs' = cs <&> \(a,b,c) -> IpsecPeerConfig a b c
+        cs' = cs <&> \(a,b,c) -> IpsecPeerConfig (UidHostname a) b c
         kk = keykey (fromJust $ rtWorkingKey rt)
         notme kd = keykey (keyPacket kd) /= kk
 
@@ -580,8 +584,8 @@ sshKeyToHostname sshkey = do
       "f=$(mktemp) && cat > \"$f\" && ssh-keygen -r _ -f \"$f\"  |" ++
       " (read _ _ _ _ _ hash _ && echo -n $hash.ssh.cryptonomic.net); r=$?; rm -f \"$f\"; exit $r"
 
-strongswanPeerConfiguration :: SockAddr -> Char8.ByteString -> Char8.ByteString -> Char8.ByteString
-strongswanPeerConfiguration addr oname rightip = Char8.unlines
+strongswanPeerConfiguration :: SockAddr -> UidHostname -> ResolvableHostname -> Char8.ByteString
+strongswanPeerConfiguration addr (UidHostname oname) (ResolvableHostname rightip) = Char8.unlines
     [ "conn " <> oname
     , "  right=" <> rightip
     , "  rightsubnet=" <> p (showA addr) <> "/128"
-- 
cgit v1.2.3