Factored Transforms out of goliath KeyRing module.

1 files changed, 1 insertions, 662 deletions

diff --git a/lib/KeyRing.hs b/lib/KeyRing.hs
index 5953f12..bb32a2e 100644
--- a/lib/KeyRing.hs
+++ b/lib/KeyRing.hs
@@ -216,6 +216,7 @@ import ProcessUtils (systemEnv, ExitCode(ExitFailure, ExitSuccess) )
 import GnuPGAgent as Agent
 import Types
 import PacketTranscoder
+import Transforms
 
 -- DER-encoded elliptic curve ids
 -- nistp256_id  = 0x2a8648ce3d030107
@@ -284,33 +285,6 @@ usageFromFilter (KF_Match usage) = return usage
 usageFromFilter _                = mzero
 
 
-data KeyRingRuntime = KeyRingRuntime
-                        { rtPubring :: FilePath
-                        -- ^ Path to the file represented by 'HomePub'
-                        , rtSecring :: FilePath
-                        -- ^ Path to the file represented by 'HomeSec'
-                        , rtGrip :: Maybe String
-                        -- ^ Fingerprint or portion of a fingerprint used
-                        -- to identify the working GnuPG identity used to
-                        -- make signatures.
-                        , rtWorkingKey :: Maybe Packet
-                        -- ^ The master key of the working GnuPG identity.
-                        , rtKeyDB :: KeyDB
-                        -- ^ The common information pool where files spilled
-                        -- their content and from which they received new
-                        -- content.
-                        , rtRingAccess :: Map.Map InputFile Access
-                        -- ^ The 'Access' values used for files of type
-                        -- 'KeyRingFile'.  If 'AutoAccess' was specified
-                        -- for a file, this 'Map.Map' will indicate the
-                        -- detected value that was used by the algorithm.
-                        , rtPassphrases :: PacketTranscoder
-                        }
-
--- | Roster-entry level actions
-data PacketUpdate = InducerSignature String [SignatureSubpacket]
-                  | SubKeyDeletion KeyKey KeyKey
-
 filesToLock ::
   KeyRingOperation -> InputFileContext -> [FilePath]
 filesToLock k ctx = do
@@ -323,26 +297,11 @@ filesToLock k ctx = do
 -- kret :: a -> KeyRingOperation a
 -- kret x = KeyRingOperation Map.empty Nothing (KeyRingAction x)
 
-data RSAPublicKey = RSAKey MPI MPI deriving (Eq,Show)
 data PKCS8_RSAPublicKey = RSAKey8 MPI MPI deriving Show
 
 pkcs8 :: RSAPublicKey -> PKCS8_RSAPublicKey
 pkcs8 (RSAKey n e) = RSAKey8 n e
 
-instance ASN1Object RSAPublicKey where
-    -- PKCS #1 RSA Public Key
-    toASN1 (RSAKey (MPI n) (MPI e))
-                  = \xs -> Start Sequence
-                         : IntVal n
-                         : IntVal e
-                         : End Sequence
-                         : xs
-    fromASN1 (Start Sequence:IntVal n:IntVal e:End Sequence:xs) =
-        Right (RSAKey (MPI n) (MPI e), xs)
-
-    fromASN1 _ = 
-        Left "fromASN1: RSAPublicKey: unexpected format"
-
 instance ASN1Object PKCS8_RSAPublicKey where
 
     -- PKCS #8 Public key data
@@ -450,32 +409,6 @@ instance ASN1Object RSAPrivateKey where
 
 
 
--- | This type is used to describe events triggered by 'runKeyRing'.  In
--- addition to normal feedback (e.g. 'NewPacket'), it also may indicate
--- non-fatal IO exceptions (e.g. 'FailedExternal').  Because a
--- 'KeyRingOperation' may describe a very intricate multifaceted algorithm with
--- many inputs and outputs, an operation may be partially (or even mostly)
--- successful even when I/O failures occured.  In this situation, the files may
--- not have all the information they were intended to store, but they will be
--- in a valid format for GnuPG or kiki to operate on in the future.
-data KikiReportAction =
-        NewPacket String
-        | MissingPacket String
-        | ExportedSubkey
-        | GeneratedSubkeyFile
-        | NewWalletKey String
-        | YieldSignature
-        | YieldSecretKeyPacket String
-        | UnableToUpdateExpiredSignature
-        | WarnFailedToMakeSignature
-        | FailedExternal Int
-        | ExternallyGeneratedFile
-        | UnableToExport KeyAlgorithm String
-        | FailedFileWrite
-        | HostsDiff ByteString
-        | DeletedPacket String
- deriving (Eq,Show)
-
 uncamel :: String -> String
 uncamel str = unwords $ firstWord ++ (toLower .: otherWords) ++ args
   where
@@ -501,23 +434,6 @@ data KikiResult a = KikiResult
     -- along with the files that triggered them.
     }
 
-type KikiReport = [ (FilePath, KikiReportAction) ]
-
-keyPacket :: KeyData -> Packet
-keyPacket (KeyData k _ _ _) = packet k
-
-subkeyMappedPacket :: SubKey -> MappedPacket
-subkeyMappedPacket (SubKey k _ ) = k
-
-
-usage :: SignatureSubpacket -> Maybe String
-usage (NotationDataPacket
-        { human_readable = True
-        , notation_name  = "usage@"
-        , notation_value = u
-        }) = Just u
-usage _    = Nothing
-
 x509cert :: SignatureSubpacket -> Maybe Char8.ByteString
 x509cert (NotationDataPacket
         { human_readable = False
@@ -526,167 +442,7 @@ x509cert (NotationDataPacket
         }) = Just (Char8.pack u)
 x509cert _    = Nothing
 
-makeInducerSig
-  :: Packet
-     -> Packet -> Packet -> [SignatureSubpacket] -> SignatureOver
--- torsig g topk wkun uid timestamp extras = todo
-makeInducerSig topk wkun uid extras
-    = CertificationSignature (secretToPublic topk)
-                             uid
-                             (sigpackets 0x13
-                                         subpackets
-                                         subpackets_unh)
-   where
-    subpackets = -- implicit: [ SignatureCreationTimePacket (fromIntegral timestamp) ]
-                 tsign
-                 ++ extras
-    subpackets_unh = [IssuerPacket (fingerprint wkun)]
-    tsign = if keykey wkun == keykey topk
-             then [] -- tsign doesnt make sense for self-signatures
-             else [ TrustSignaturePacket 1 120
-                  , RegularExpressionPacket regex]
-    -- <[^>]+[@.]asdf\.nowhere>$
-    regex = "<[^>]+[@.]"++hostname++">$"
-    -- regex = username ++ "@" ++ hostname
-    -- username = "[a-zA-Z0-9.][-a-zA-Z0-9.]*\\$?" :: String
-    hostname = subdomain' pu ++ "\\." ++ topdomain' pu
-    pu = parseUID uidstr where UserIDPacket uidstr = uid
-    subdomain' = escape . T.unpack . uid_subdomain
-    topdomain' = escape . T.unpack . uid_topdomain
-    escape s = concatMap echar s
-      where
-        echar '|' = "\\|"
-        echar '*' = "\\*"
-        echar '+' = "\\+"
-        echar '?' = "\\?"
-        echar '.' = "\\."
-        echar '^' = "\\^"
-        echar '$' = "\\$"
-        echar '\\' = "\\\\"
-        echar '[' = "\\["
-        echar ']' = "\\]"
-        echar c = [c]
-
-
-keyflags :: SignatureSubpacket -> Maybe PGPKeyFlags
-keyflags flgs@(KeyFlagsPacket {}) =
-    Just . toEnum $
-        (   bit 0x1 certify_keys
-        .|. bit 0x2 sign_data
-        .|. bit 0x4 encrypt_communication
-        .|. bit 0x8 encrypt_storage )     :: Maybe PGPKeyFlags
-    -- other flags:
-    --  split_key
-    --  authentication (ssh-client)
-    --  group_key
- where
-    bit v f = if f flgs then v else 0
-keyflags _ = Nothing
-
-
-data PGPKeyFlags =
-    Special
-    | Vouch                  -- 0001 C -- Signkey
-    | Sign                   -- 0010 S
-    | VouchSign              -- 0011
-    | Communication          -- 0100 E
-    | VouchCommunication     -- 0101
-    | SignCommunication      -- 0110
-    | VouchSignCommunication -- 0111
-    | Storage                -- 1000 E
-    | VouchStorage           -- 1001
-    | SignStorage            -- 1010
-    | VouchSignStorage       -- 1011
-    | Encrypt                -- 1100 E
-    | VouchEncrypt           -- 1101
-    | SignEncrypt            -- 1110
-    | VouchSignEncrypt       -- 1111
- deriving (Eq,Show,Read,Enum)
-
-
-usageString :: PGPKeyFlags -> String
-usageString flgs =
- case flgs of
-    Special -> "special"
-    Vouch -> "vouch" -- signkey
-    Sign -> "sign"
-    VouchSign -> "vouch-sign"
-    Communication -> "communication"
-    VouchCommunication -> "vouch-communication"
-    SignCommunication -> "sign-communication"
-    VouchSignCommunication -> "vouch-sign-communication"
-    Storage -> "storage"
-    VouchStorage -> "vouch-storage"
-    SignStorage -> "sign-storage"
-    VouchSignStorage -> "vouch-sign-storage"
-    Encrypt -> "encrypt"
-    VouchEncrypt -> "vouch-encrypt"
-    SignEncrypt -> "sign-encrypt"
-    VouchSignEncrypt -> "vouch-sign-encrypt"
-
-
-
-
-keyFlags :: t -> [Packet] -> [SignatureSubpacket]
-keyFlags  wkun uids = keyFlags0 wkun (filter isSignaturePacket uids)
-
-keyFlags0 :: t -> [Packet] -> [SignatureSubpacket]
-keyFlags0 wkun uidsigs = concat
-                      [ keyflags
-                      , preferredsym
-                      , preferredhash
-                      , preferredcomp
-                      , features ]
 
- where
-    subs = concatMap hashed_subpackets uidsigs
-    keyflags = filterOr isflags subs $
-               KeyFlagsPacket { certify_keys = True
-                              , sign_data = True
-                              , encrypt_communication = False
-                              , encrypt_storage = False
-                              , split_key = False
-                              , authentication = False
-                              , group_key = False
-                              }
-    preferredsym = filterOr ispreferedsym subs $
-               PreferredSymmetricAlgorithmsPacket
-                              [ AES256
-                              , AES192
-                              , AES128
-                              , CAST5
-                              , TripleDES
-                              ]
-    preferredhash = filterOr ispreferedhash subs $
-               PreferredHashAlgorithmsPacket
-                              [ SHA256
-                              , SHA1
-                              , SHA384
-                              , SHA512
-                              , SHA224
-                              ]
-    preferredcomp = filterOr ispreferedcomp subs $
-               PreferredCompressionAlgorithmsPacket
-                              [ ZLIB
-                              , BZip2
-                              , ZIP
-                              ]
-    features = filterOr isfeatures subs $
-               FeaturesPacket { supports_mdc = True
-                              }
-
-    filterOr pred xs def = if null rs then [def] else rs where rs=filter pred xs
-
-    isflags (KeyFlagsPacket {}) = True
-    isflags _ = False
-    ispreferedsym (PreferredSymmetricAlgorithmsPacket {}) = True
-    ispreferedsym _ = False
-    ispreferedhash (PreferredHashAlgorithmsPacket {}) = True
-    ispreferedhash _ = False
-    ispreferedcomp (PreferredCompressionAlgorithmsPacket {}) = True
-    ispreferedcomp _ = False
-    isfeatures (FeaturesPacket {}) = True
-    isfeatures _ = False
 
 
 matchSpec :: KeySpec -> KeyData -> Bool
@@ -710,36 +466,6 @@ matchSpec (KeyUidMatch pat) (KeyData _ _ uids _) = not $ null us
   where
     us = filter (isInfixOf pat) $ Map.keys uids
 
-data UserIDRecord = UserIDRecord {
-    uid_full :: String,
-    uid_realname :: T.Text,
-    uid_user :: T.Text,
-    uid_subdomain :: T.Text,
-    uid_topdomain :: T.Text
-}
- deriving Show
-
-parseUID :: String -> UserIDRecord
-parseUID str = UserIDRecord {
-                    uid_full = str,
-                    uid_realname = realname,
-                    uid_user = user,
-                    uid_subdomain = subdomain,
-                    uid_topdomain = topdomain
-                }
- where
-    text = T.pack str
-    (T.strip-> realname, T.dropAround isBracket-> email)
-                              = T.break (=='<') text
-    (user, T.drop 1-> hostname) = T.break (=='@') email
-    ( T.reverse            -> topdomain,
-      T.reverse . T.drop 1 -> subdomain)
-                              = T.break (=='.') . T.reverse $ hostname
-isBracket :: Char -> Bool
-isBracket '<' = True
-isBracket '>' = True
-isBracket _   = False
-
 
 
 
@@ -1532,32 +1258,6 @@ generateInternals transcode mwk db gens = do
             return $ KikiSuccess (Map.insert kk kd db,reportGens)
         Nothing -> return $ KikiSuccess (db,[])
 
-torhash :: Packet -> String
-torhash key = fromMaybe "" $ derToBase32 <$> derRSA key
-
-torUIDFromKey :: Packet -> String
-torUIDFromKey key = "Anonymous <root@" ++ take 16 (torhash key) ++ ".onion>"
-
-derToBase32 :: ByteString -> String
-derToBase32 = map toLower . base32 . sha1
- where
-   sha1 :: L.ByteString -> S.ByteString
-#if !defined(VERSION_cryptonite)
-   sha1 = SHA1.hashlazy
-#else
-   sha1 x = convert (Vincent.hashlazy x :: Vincent.Digest Vincent.SHA1)
-#endif
-#if defined(VERSION_memory)
-   base32 = S8.unpack . convertToBase Base32
-#elif defined(VERSION_dataenc)
-   base32 = Base32.encode . S.unpack
-#endif
-
-derRSA :: Packet -> Maybe ByteString
-derRSA rsa = do
-    k <- rsaKeyFromPacket rsa
-    return $ encodeASN1 DER (toASN1 k [])
-
 unconditionally :: IO (KikiCondition a) -> IO a
 unconditionally action = do
     r <- action
@@ -1565,13 +1265,6 @@ unconditionally action = do
         KikiSuccess x -> return x
         e -> error $ errorString e
 
-try :: Monad m => KikiCondition a -> (a -> m (KikiCondition b)) -> m (KikiCondition b)
-try x body =
-    case functorToEither x of
-           Left e -> return e
-           Right x -> body x
-
-
 data ParsedCert = ParsedCert
     { pcertKey :: Packet
     , pcertTimestamp :: UTCTime
@@ -1982,42 +1675,6 @@ writeWalletKeys krd db wk = do
     report <- foldM writeWallet [] (files isMutableWallet)
     return $ KikiSuccess report
 
-ifSecret :: Packet -> t -> t -> t
-ifSecret (SecretKeyPacket {}) t f = t
-ifSecret _                    t f = f
-
-showPacket :: Packet -> String
-showPacket p | isKey p   = (if is_subkey p
-                              then showPacket0 p
-                              else ifSecret p "---Secret" "---Public")
-                           ++ " "++fingerprint p
-                           ++ " "++show (key_algorithm p)
-                           ++ case key_nbits p of { 0 -> ""; n -> "("++show n++")" }
-             | isUserID p          = showPacket0 p ++ " " ++ show (uidkey p)
-             -- | isSignaturePacket p = showPacket0 p ++ maybe "" ((++) (" ^ signed"++sigusage p++": ")) (signature_issuer p)
-             | isSignaturePacket p = showPacket0 p ++ maybe "" (" ^ signed: "++) (signature_issuer p) ++ sigusage p
-             | otherwise           = showPacket0 p
- where
-    sigusage p =
-        case take 1 (tagStrings p) of
-            []    -> ""
-            tag:_ -> " "++show tag -- "("++tag++")"
-     where
-        tagStrings p = usage_tags ++ flags
-         where
-            usage_tags = mapMaybe usage xs
-            flags = mapMaybe (fmap usageString . keyflags) xs
-            xs = hashed_subpackets p
-
-
-showPacket0 p = dropSuffix "Packet" . concat . take 1 $ words (show p)
- where
-    dropSuffix :: String -> String -> String
-    dropSuffix _    [] = ""
-    dropSuffix suff (x:xs) | (x:xs)==suff = ""
-                           | otherwise    = x:dropSuffix suff xs
-
-
 -- | returns Just True so as to indicate that
 -- the public portions of keys will be imported
 importPublic :: Maybe Bool
@@ -2312,75 +1969,6 @@ writePEMKeys doDecrypt db exports = do
         try pun $ \pun -> do
         return $ KikiSuccess (fname,stream,pun)
 
-performManipulations ::
-                (PacketDecrypter)
-                -> KeyRingRuntime
-                -> Maybe MappedPacket
-                -> (KeyRingRuntime -> KeyData -> [PacketUpdate])
-                -> IO (KikiCondition (KeyRingRuntime,KikiReport))
-performManipulations doDecrypt rt wk manip = do
-    let db = rtKeyDB rt
-        performAll kd = foldM perform (KikiSuccess (kd,[])) $ manip rt kd
-    r <- Traversable.mapM performAll db
-    try (sequenceA r) $ \db -> do
-    return $ KikiSuccess (rt { rtKeyDB =  fmap fst db }, concatMap snd $ Map.elems db)
- where
-    perform :: KikiCondition (KeyData,KikiReport) -> PacketUpdate -> IO (KikiCondition (KeyData,KikiReport))
-    perform kd (InducerSignature uid subpaks) = do
-        try kd $ \(kd,report) -> do
-        flip (maybe $ return NoWorkingKey) wk $ \wk' -> do
-        wkun' <- doDecrypt wk'
-        try wkun' $ \wkun -> do    
-        let flgs = if keykey (keyPacket kd) == keykey wkun
-                    then keyFlags0 (keyPacket kd) (map (\(x,_,_)->x) selfsigs)
-                    else []
-            sigOver = makeInducerSig (keyPacket kd)
-                                     wkun
-                                     (UserIDPacket uid)
-                                     $ flgs ++ subpaks
-            om = Map.singleton "--autosign" (origin p (-1)) where p = UserIDPacket uid
-            toMappedPacket om p = (mappedPacket "" p) {locations=om}
-            selfsigs = filter (\(sig,v,whosign) -> isJust (v >> Just wkun >>= guard
-                                   . (== keykey whosign)
-                                   . keykey)) vs
-            keys = map keyPacket $ Map.elems (rtKeyDB rt)
-            overs sig = signatures $ Message (keys++[keyPacket kd,UserIDPacket uid,sig])
-            vs :: [ ( Packet -- signature
-                   , Maybe SignatureOver -- Nothing means non-verified
-                   , Packet ) -- key who signed
-                 ]
-            vs = do
-                   x <- maybeToList $ Map.lookup uid (keyUids kd)
-                   sig <- map (packet . fst) (fst x)
-                   o <- overs sig
-                   k <- keys
-                   let ov = verify (Message [k]) $ o
-                   signatures_over ov
-                   return (sig,Just ov,k)
-            additional new_sig = do
-                new_sig <- maybeToList new_sig
-                guard (null $ selfsigs)
-                signatures_over new_sig
-        sigr <- pgpSign (Message [wkun]) sigOver SHA1 (fingerprint wkun)
-        let f ::([SigAndTrust],OriginMap) -> ([SigAndTrust],OriginMap)
-            f x = ( map ( (,Map.empty) . toMappedPacket om) (additional sigr) ++ fst x
-                  , om `Map.union` snd x )
-        -- XXX: Shouldn't this signature generation show up in the KikiReport ?
-        return $ KikiSuccess $ ( kd { keyUids = Map.adjust f uid (keyUids kd) }, report )
-
-    perform kd (SubKeyDeletion topk subk) = do
-        try kd $ \(kd,report) -> do
-        let kk = keykey $ packet $ keyMappedPacket kd
-            kd' | kk /= topk = kd
-                | otherwise  = kd { keySubKeys = Map.filterWithKey pred $ keySubKeys kd }
-            pred k _ = k /= subk
-            ps = concat $ maybeToList $ do
-                SubKey mp sigs <- Map.lookup subk (keySubKeys kd)
-                return $ packet mp : concatMap (\(p,ts) -> packet p : Map.elems ts) sigs
-            ctx = InputFileContext (rtSecring rt) (rtPubring rt)
-            rings = [HomeSec, HomePub] >>= resolveInputFile ctx
-        return $ KikiSuccess (kd' , report ++ [ (f,DeletedPacket $ showPacket p) | f <- rings, p <- ps ])
-
 initializeMissingPEMFiles ::
     KeyRingOperation
       -> InputFileContext
@@ -2503,150 +2091,7 @@ combineTransforms trans rt kd = updates
               concatMap (\t -> resolveTransform t rt kd) sanitized
     sanitized = group (sort trans) >>= take 1
 
-isSubkeySignature (SubkeySignature {}) = True
-isSubkeySignature _                    = False
-
--- Returned data is simmilar to getBindings but the Word8 codes
--- are ORed together.
-accBindings ::
-  Bits t =>
-  [(t, (Packet, Packet), [a], [a1], [a2])]
-  -> [(t, (Packet, Packet), [a], [a1], [a2])]
-accBindings bs = as
-  where
-    gs = groupBy samePair . sortBy (comparing bindingPair) $ bs
-    as = map (foldl1 combine) gs
-    bindingPair (_,p,_,_,_) = pub2 p
-      where
-        pub2 (a,b) = (pub a, pub b)
-        pub a = fingerprint_material a
-    samePair a b = bindingPair a == bindingPair b
-    combine (ac,p,akind,ahashed,aclaimaints)
-            (bc,_,bkind,bhashed,bclaimaints)
-        = (ac .|. bc,p,akind++bkind,ahashed++bhashed,aclaimaints++bclaimaints)
-
-
-
-verifyBindings keys nonkeys = (top ++ filter isSubkeySignature embedded,othersigs)
- where
-    verified = do
-        sig <- signatures (Message nonkeys)
-        let v = verify (Message keys) sig
-        guard (not . null $ signatures_over v)
-        return v
-    (top,othersigs) = partition isSubkeySignature verified
-    embedded = do
-        sub <- top
-        let sigover = signatures_over sub
-            unhashed = sigover >>= unhashed_subpackets
-            subsigs = mapMaybe backsig unhashed
-            -- This should consist only of 0x19 values
-            -- subtypes = map signature_type subsigs
-        -- trace ("subtypes = "++show subtypes) (return ())
-        -- trace ("issuers: "++show (map signature_issuer subsigs)) (return ())
-        sig <- signatures (Message ([topkey sub,subkey sub]++subsigs))
-        let v = verify (Message [subkey sub]) sig
-        guard (not . null $ signatures_over v)
-        return v
-
-smallpr k = drop 24 $ fingerprint k
-
-disjoint_fp ks = {- concatMap group2 $ -} transpose grouped
- where
-    grouped    = groupBy samepr . sortBy (comparing smallpr) $ ks
-    samepr a b = smallpr a == smallpr b
-
-    {-
-    -- useful for testing
-    group2 :: [a] -> [[a]]
-    group2 (x:y:ys) = [x,y]:group2 ys
-    group2 [x]      = [[x]]
-    group2 []       = []
-    -}
-
 
-getBindings ::
-  [Packet]
-  ->
-    ( [([Packet],[SignatureOver])] --  other signatures with key sets
-                                   --  that were used for the verifications
-    , [(Word8,
-       (Packet, Packet), -- (topkey,subkey)
-       [String],         -- usage flags
-       [SignatureSubpacket], -- hashed data
-       [Packet])] -- binding signatures
-    )
-getBindings pkts = (sigs,bindings)
- where
-    (sigs,concat->bindings) = unzip $ do
-        let (keys,_) = partition isKey pkts
-        keys <- disjoint_fp keys
-        let (bs,sigs) = verifyBindings keys pkts
-        return . ((keys,sigs),) $ do
-            b <- bs -- trace ("sigs = "++show (map (map signature_issuer . signatures_over) sigs)) bs
-            i <- map signature_issuer (signatures_over b)
-            i <- maybeToList i
-            who <- maybeToList $ find_key fingerprint (Message keys) i
-            let (code,claimants) =
-                    case () of
-                        _ | who == topkey b -> (1,[])
-                        _ | who == subkey b -> (2,[])
-                        _                   -> (0,[who])
-            let hashed = signatures_over b >>= hashed_subpackets
-                kind = guard (code==1) >> hashed >>= maybeToList . usage
-            return (code,(topkey b,subkey b), kind, hashed,claimants)
-
--- | resolveTransform
-resolveTransform :: Transform -> KeyRingRuntime -> KeyData -> [PacketUpdate]
-resolveTransform Autosign rt kd@(KeyData k ksigs umap submap) = ops
- where
-    ops = map (\u -> InducerSignature u []) us
-    us = filter torStyle $ Map.keys umap
-    torStyle 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')
-
-
--- (2 of 3) resolveTransform :: Transform -> KeyRingRuntime -> KeyData -> [PacketUpdate]
-resolveTransform (DeleteSubkeyByFingerprint fp) rt kd@(KeyData k ksigs umap submap) = fmap (SubKeyDeletion topk) subk
- where
-    topk = keykey $ packet k -- key to master of key to be deleted
-    subk = do
-        (k,sub) <- Map.toList submap
-        guard (map toUpper fp == fingerprint (packet (subkeyMappedPacket sub)))
-        return k
-
--- (3 of 3) resolveTransform :: Transform -> KeyRingRuntime -> KeyData -> [PacketUpdate]
-resolveTransform (DeleteSubkeyByUsage tag) rt kd@(KeyData k ksigs umap submap) = fmap (SubKeyDeletion topk) subk
- where
-    topk = keykey $ packet k -- key to master of key to be deleted
-    subk = do
-        (k,SubKey p sigs) <- Map.toList submap
-        take 1 $ filter (has_tag tag) $ map (packet . fst) sigs
-        return k
 
 -- | Load and update key files according to the specified 'KeyRingOperation'.
 runKeyRing :: KeyRingOperation -> IO (KikiResult KeyRingRuntime)
@@ -2790,36 +2235,6 @@ lookupEnv var =
     handleIO_ (return Nothing) $ fmap Just (getEnv var)
 #endif
 
-sigpackets ::
-  Monad m =>
-  Word8 -> [SignatureSubpacket] -> [SignatureSubpacket] -> m Packet
-sigpackets typ hashed unhashed = return $
-    signaturePacket
-        4 -- version
-        typ -- 0x18 subkey binding sig, or 0x19 back-signature
-        RSA
-        SHA1
-        hashed
-        unhashed
-        0 -- Word16 -- Left 16 bits of the signed hash value
-        [] -- [MPI]
-
-secretToPublic :: Packet -> Packet
-secretToPublic pkt@(SecretKeyPacket {}) =
-    PublicKeyPacket { version = version pkt
-                    , timestamp = timestamp pkt
-                    , key_algorithm = key_algorithm pkt
-                    -- , ecc_curve = ecc_curve pkt
-                    , key = let seckey = key pkt
-                                pubs = public_key_fields (key_algorithm pkt)
-                            in filter (\(k,v) -> k `elem` pubs) seckey
-                    , is_subkey = is_subkey pkt
-                    , v3_days_of_validity = Nothing
-                    }
-secretToPublic pkt = pkt
-
-
-
 slurpWIPKeys :: Posix.EpochTime -> L.ByteString -> ( [(Word8,Packet)], [L.ByteString])
 slurpWIPKeys stamp "" = ([],[])
 slurpWIPKeys stamp cs =
@@ -2878,14 +2293,6 @@ decode_btc_key timestamp str = do
             , is_subkey = True
             }
 
-rsaKeyFromPacket :: Packet -> Maybe RSAPublicKey
-rsaKeyFromPacket p | isKey p = do
-    n <- lookup 'n' $ key p
-    e <- lookup 'e' $ key p
-    return $ RSAKey n e
-
-rsaKeyFromPacket _ = Nothing
-
 
 readPacketsFromWallet ::
     Maybe Packet
@@ -3111,26 +2518,6 @@ makeSig doDecrypt top fname subkey_p tags mbsig = do
         newsig <- addOrigin new_sig
         return $ fmap (,[]) newsig
 
-
-type TrustMap = Map.Map FilePath Packet
-type SigAndTrust = ( MappedPacket
-                   , TrustMap     ) -- trust packets
-
-data SubKey = SubKey MappedPacket [SigAndTrust] deriving Show
-
--- | This is a GPG Identity which includes a master key and all its UIDs and
--- subkeys and associated signatures.
-data KeyData = KeyData { keyMappedPacket :: MappedPacket    -- main key
-                       , keySigAndTrusts :: [SigAndTrust]  -- sigs on main key
-                       , keyUids :: (Map.Map String ([SigAndTrust],OriginMap))  -- uids
-                       , keySubKeys :: (Map.Map KeyKey SubKey)    -- subkeys
-                       } deriving Show
-
-type KeyDB = Map.Map KeyKey KeyData
-
-uidkey :: Packet -> String
-uidkey (UserIDPacket str) = str
-
 merge :: KeyDB -> InputFile -> Message -> KeyDB
 merge db inputfile (Message ps) = merge_ db filename qs
  where
@@ -3298,24 +2685,6 @@ mergeSig sig sigs =
         mergeSameSig a b = b -- trace ("discarding dup "++show a) b
 
 
-unsig :: FilePath -> Bool -> SigAndTrust -> [MappedPacket]
-unsig fname isPublic (sig,trustmap) =
-    sig : map (asMapped (-1)) ( take 1 . Map.elems $ Map.filterWithKey f trustmap)
-  where
-    f n _ = n==fname -- && trace ("fname=n="++show n) True
-    asMapped n p = let m = mappedPacket fname p
-                   in m { locations = fmap (\x->x {originalNum=n}) (locations m) }
-
-concatSort ::
-  FilePath -> ([a] -> MappedPacket) -> (b -> [a]) -> [b] -> [a]
-concatSort fname getp f = concat . sortByHint fname getp . map f
-
-sortByHint :: FilePath -> (a -> MappedPacket) -> [a] -> [a]
-sortByHint fname f = sortBy (comparing gethint)
-  where
-    gethint = maybe defnum originalNum . Map.lookup fname . locations . f
-    defnum = -1
-
 flattenKeys :: Bool -> KeyDB -> Message
 flattenKeys isPublic db = Message $ concatMap (map packet . flattenTop "" isPublic . snd) (prefilter . Map.assocs $ db)
  where
@@ -3329,27 +2698,6 @@ flattenKeys isPublic db = Message $ concatMap (map packet . flattenTop "" isPubl
                   isSecret _          = False
 
 
-flattenTop :: FilePath -> Bool -> KeyData -> [MappedPacket]
-flattenTop fname ispub (KeyData key sigs uids subkeys) =
-    unk ispub key :
-            ( flattenAllUids fname ispub uids
-             ++ concatSort fname head (flattenSub fname ispub) (Map.elems subkeys))
-
-flattenSub :: FilePath -> Bool -> SubKey -> [MappedPacket]
-flattenSub fname ispub (SubKey key sigs) = unk ispub key: concatSort fname head (unsig fname ispub) sigs
-
-unk :: Bool -> MappedPacket -> MappedPacket
-unk isPublic = if isPublic then toPacket secretToPublic else id
-                where toPacket f mp@(MappedPacket {packet=p}) = mp {packet=(f p)}
-
-flattenAllUids :: FilePath -> Bool -> Map.Map String ([SigAndTrust],OriginMap) -> [MappedPacket]
-flattenAllUids fname ispub uids =
-    concatSort fname head (flattenUid fname ispub) (Map.assocs uids)
-
-flattenUid :: FilePath -> Bool -> (String,([SigAndTrust],OriginMap)) -> [MappedPacket]
-flattenUid fname ispub (str,(sigs,om)) =
-    (mappedPacket "" $ UserIDPacket str) {locations=om} : concatSort fname head (unsig fname ispub) sigs
-
 data SubkeyStatus = Unsigned | OwnerSigned | CrossSigned
  deriving (Eq,Ord,Enum,Show,Read)
 
@@ -3384,11 +2732,6 @@ getSubkeys ck topk subs tag = do
         guard (not $ null sigs')
         return subk
 
-has_tag tag p = isSignaturePacket p
-                    && or [ tag `elem` mapMaybe usage (hashed_subpackets p)
-                          , tag `elem` map usageString (mapMaybe keyflags (hashed_subpackets p)) ]
-
-
 -- |
 -- Returns (ip6 fingerprint address,(onion names,other host names))
 --
@@ -3494,10 +2837,6 @@ fingerdress topk = fromMaybe zero $ Hosts.inet_pton addr_str
     colons (a:b:c:d:xs@(_:_)) = [a,b,c,d,':'] ++ colons xs
     colons xs                 = xs
 
-backsig :: SignatureSubpacket -> Maybe Packet
-backsig (EmbeddedSignaturePacket s) = Just s
-backsig _                           = Nothing
-
 socketFamily :: SockAddr -> Family
 socketFamily (SockAddrInet _ _)      = AF_INET
 socketFamily (SockAddrInet6 {}) = AF_INET6