refactor "resolveTransform Autosign"

1 files changed, 32 insertions, 28 deletions

diff --git a/lib/Transforms.hs b/lib/Transforms.hs
index 7750ec5..9571e7e 100644
--- a/lib/Transforms.hs
+++ b/lib/Transforms.hs
@@ -751,39 +751,43 @@ parseUID str = UserIDRecord {
       T.reverse . T.drop 1 -> subdomain)
                               = T.break (=='.') . T.reverse $ hostname
 
+selfAuthenticated :: OriginMapped Packet -> KeyData -> UidString -> Bool
+selfAuthenticated k kd (UidString str) =
+  and [ uid_topdomain parsed == "onion"
+      , uid_realname parsed `elem` ["","Anonymous"]
+      , uid_user parsed == "root"
+      , fmap (match . fst) (lookup (packet k) torbindings) == Just True
+      ]
+  where
+    parsed      = parseUID str
+    match       = (==subdom) . take (fromIntegral len)
+    len         = T.length (uid_subdomain parsed)
+    subdom0     = L.fromChunks [encodeUtf8 (uid_subdomain parsed)]
+    subdom      = Char8.unpack subdom0
+    torbindings = getTorKeys (map packet $ flattenTop "" True kd)
+
+getTorKeys :: [Packet] -> [(Packet, (String, Packet))]
+getTorKeys pub = do
+    xs <- groupBindings pub
+    (_,(top,sub),us,_,_) <- xs
+    guard ("tor" `elem` us)
+    let torhash = fromMaybe "" $ derToBase32 <$> derRSA sub
+    return (top,(torhash,sub))
+
+groupBindings :: [Packet] -> [[(Word8, (Packet, Packet), [String], [SignatureSubpacket], [Packet])]]
+groupBindings (accBindings . snd . getBindings -> bindings) = gs
+  where
+    code (c,(m,s),_,_,_)                   = (fingerprint_material m,-c)
+    ownerkey (_,(a,_),_,_,_)               = a
+    sameMaster (ownerkey->a) (ownerkey->b) = fingerprint_material a==fingerprint_material b
+    gs                                     = groupBy sameMaster (sortBy (comparing code) bindings)
+
 -- | resolveTransform
 resolveTransform :: Transform -> KeyRingRuntime -> KeyData -> [PacketUpdate]
 resolveTransform Autosign rt kd@(KeyData k ksigs umap submap) = ops
  where
     ops = map (\(UidString u) -> InducerSignature u []) us
-    us = filter torStyle $ Map.keys umap
-    torStyle (UidString str) = and [ uid_topdomain parsed == "onion"
-                                    , uid_realname parsed `elem` ["","Anonymous"]
-                                    , uid_user parsed == "root"
-                                    , fmap (match . fst) (lookup (packet k) torbindings)
-                                        == Just True ]
-      where parsed = parseUID str
-            match =  (==subdom) . take (fromIntegral len)
-            subdom0 = L.fromChunks [encodeUtf8 (uid_subdomain parsed)]
-            subdom = Char8.unpack subdom0
-            len = T.length (uid_subdomain parsed)
-            torbindings = getTorKeys (map packet $ flattenTop "" True kd)
-            getTorKeys pub = do
-                xs <- groupBindings pub
-                (_,(top,sub),us,_,_) <- xs
-                guard ("tor" `elem` us)
-                let torhash = fromMaybe "" $ derToBase32 <$> derRSA sub
-                return (top,(torhash,sub))
-
-            groupBindings pub = gs
-             where (_,bindings) = getBindings pub
-                   bindings' = accBindings bindings
-                   code (c,(m,s),_,_,_) = (fingerprint_material m,-c)
-                   ownerkey (_,(a,_),_,_,_) = a
-                   sameMaster (ownerkey->a) (ownerkey->b)
-                        = fingerprint_material a==fingerprint_material b
-                   gs = groupBy sameMaster (sortBy (comparing code) bindings')
-
+    us = filter (selfAuthenticated k kd) $ Map.keys umap
 
 -- (2 of 4) resolveTransform :: Transform -> KeyRingRuntime -> KeyData -> [PacketUpdate]
 resolveTransform (DeleteSubkeyByFingerprint fp) rt kd@(KeyData k ksigs umap submap) = fmap (SubKeyDeletion topk) subk