1 files changed, 297 insertions, 1105 deletions

diff --git a/lib/KeyRing/BuildKeyDB.hs b/lib/KeyRing/BuildKeyDB.hs
index 1c2a5aa..6de217b 100644
--- a/lib/KeyRing/BuildKeyDB.hs
+++ b/lib/KeyRing/BuildKeyDB.hs
@@ -2,13 +2,21 @@
 {-# LANGUAGE DeriveFunctor            #-}
 {-# LANGUAGE DoAndIfThenElse          #-}
 {-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE LambdaCase               #-}
 {-# LANGUAGE OverloadedStrings        #-}
 {-# LANGUAGE PatternGuards            #-}
 {-# LANGUAGE TupleSections            #-}
 {-# LANGUAGE ViewPatterns             #-}
 module KeyRing.BuildKeyDB where
-import qualified Codec.Binary.Base32        as Base32
-import qualified Codec.Binary.Base64        as Base64
+
+#if defined(VERSION_memory)
+import           Data.ByteArray.Encoding
+import qualified Data.ByteString.Char8   as S8
+import qualified Data.ByteString         as S
+#elif defined(VERSION_dataenc)
+import qualified Codec.Binary.Base32 as Base32
+import qualified Codec.Binary.Base64 as Base64
+#endif
 import           Control.Applicative        (liftA2)
 import           Control.Arrow              (first, second)
 import           Control.Exception          (catch)
@@ -17,7 +25,9 @@ import           ControlMaybe               (handleIO_)
 import           Data.ASN1.BinaryEncoding   (DER (..))
 import           Data.ASN1.Encoding         (decodeASN1, encodeASN1)
 
-import           Data.ASN1.Types            (fromASN1, toASN1)
+import           Data.ASN1.Types (ASN1 (BitString, End, IntVal, Null, OID, Start),
+                                  ASN1ConstructionType (Sequence), ASN1Object,
+                                  fromASN1, toASN1)
 import           Data.Binary
 import           Data.Bits                  ((.&.), (.|.))
 import           Data.Bits                  (Bits)
@@ -101,6 +111,9 @@ import           ScanningParser
 import           TimeUtil
 
 import           KeyRing.Types
+import           Transforms
+import           PacketTranscoder
+import           GnuPGAgent
 
 -- | buildKeyDB
 --
@@ -116,16 +129,15 @@ buildKeyDB :: InputFileContext -> Maybe String -> KeyRingOperation
                                                       {- gpgnames -}[(SockAddr, (KeyKey, KeyKey))],
                                                       {- outgoing_names -}[SockAddr])
                                     ,{- accs      -} Map.Map InputFile Access
-                                    ,{- doDecrypt -} MappedPacket -> IO (KikiCondition Packet)
+                                    ,{- doDecrypt -} PacketTranscoder
                                     ,{- unspilled -} Map.Map InputFile Message
                                     )
                                    ,{- report_imports -} [(FilePath,KikiReportAction)]))
 buildKeyDB ctx grip0 keyring = do
-    let
-        files istyp = do
+    let files istyp = do
             (f,stream) <- Map.toList (opFiles keyring)
             guard (istyp $ typ stream)
-            resolveInputFile ctx f
+            return f -- resolveInputFile ctx f
 
         ringMap0 = Map.filter (isring . typ) $ opFiles keyring
         (genMap,ringMap) = Map.partitionWithKey isgen ringMap0
@@ -145,10 +157,10 @@ buildKeyDB ctx grip0 keyring = do
                                     _                                -> AutoAccess
                             acc -> acc
 
-        readw wk n = fmap (n,) (readPacketsFromWallet wk (ArgFile n))
+        readw wk n = fmap (n,) (readPacketsFromWallet wk n)
 
     -- KeyRings (todo: KikiCondition reporting?)
-    (spilled,mwk,grip,accs,keys,unspilled) <- do
+    (spilled,mwk,grip,accs,keyqs,unspilled) <- do
 #if MIN_VERSION_containers(0,5,0)
         ringPackets <- Map.traverseWithKey readp ringMap
 #else
@@ -164,39 +176,25 @@ buildKeyDB ctx grip0 keyring = do
 
             -- | spilled
             --    ring packets with info available for export
-            -- | unspilled
+            -- | unspilled 
             --    the rest
             (spilled,unspilled) = Map.partition (spillable . fst) ringPackets
 
             -- | keys
-            -- process ringPackets, and get a map of fingerprint info to
+            -- process ringPackets, and get a map of fingerprint info to 
             -- to a packet, remembering it's original file, access.
-            keys :: Map.Map KeyKey MappedPacket
-            keys = Map.foldl slurpkeys Map.empty
-                        $ Map.mapWithKey filterSecrets ringPackets
-                    where
-                          filterSecrets f (_,Message ps) =
-                            filter (isSecretKey . packet)
-                                $ zipWith (mappedPacketWithHint fname) ps [1..]
-                            where fname = resolveForReport (Just ctx) f
-                          slurpkeys m ps = m `Map.union` Map.fromList ps'
-                            where ps' = zip (map (keykey . packet) ps) ps
-            -- | mwk
-            -- first master key matching the provided grip
-            -- (the m is for "MappedPacket", wk for working key)
+            keys :: Map.Map KeyKey (OriginMapped Query)
             mwk :: Maybe MappedPacket
-            mwk = listToMaybe $ do
-                    fp <- maybeToList grip
-                    let matchfp mp = not (is_subkey p) && matchpr fp p == fp
-                            where p = packet mp
-                    Map.elems $ Map.filter matchfp keys
+            (mwk, keys) = keyQueries grip ringPackets
+
             -- | accs
             -- file access(Sec | Pub) lookup table
             accs :: Map.Map InputFile Access
             accs = fmap (access . fst) ringPackets
         return (spilled,mwk,grip,accs,keys,fmap snd unspilled)
 
-    doDecrypt <- makeMemoizingDecrypter keyring ctx keys
+    transcode <- makeMemoizingDecrypter keyring ctx (mwk,keyqs)
+    let doDecrypt = transcode (Unencrypted,S2K 100 "")
 
     let wk = fmap packet mwk
         rt0 = KeyRingRuntime { rtPubring = homepubPath ctx
@@ -205,10 +203,10 @@ buildKeyDB ctx grip0 keyring = do
                              , rtWorkingKey = wk
                              , rtRingAccess = accs
                              , rtKeyDB = Map.empty
-                             , rtPassphrases = doDecrypt
+                             , rtPassphrases = transcode
                              }
     -- autosigns and deletes
-    transformed0 <- do
+    transformed0 <-
         let trans :: InputFile -> (StreamInfo,Message) -> IO (KikiCondition (KikiReport,KeyDB))
             trans f (info,ps) = do
                 let manip = combineTransforms (transforms info)
@@ -216,87 +214,84 @@ buildKeyDB ctx grip0 keyring = do
                     acc = Just Sec /= Map.lookup f accs
                 r <- performManipulations doDecrypt rt1 mwk manip
                 try r $ \(rt2,report) -> do
-                  return $ KikiSuccess (report,rtKeyDB rt2)
+                return $ KikiSuccess (report,rtKeyDB rt2)
+        -- XXX: Unspilled keys are not obtainable from rtKeyDB.
+        --  If the working key is marked non spillable, then how
+        --  would we look up it's UID and such?
 #if MIN_VERSION_containers(0,5,0)
-        fmap sequenceA $ Map.traverseWithKey trans spilled
+        in fmap sequenceA $ Map.traverseWithKey trans spilled
 #else
-        fmap sequenceA $ Traversable.traverse (uncurry trans) $ Map.mapWithKey (,) spilled
+        in fmap sequenceA $ Traversable.traverse (uncurry trans) $ Map.mapWithKey (,) spilled
 #endif
     try transformed0 $ \transformed -> do
-      let -- | db_rings - all keyrings combined into one
-          db_rings :: Map.Map KeyKey KeyData
-          db_rings = Map.foldlWithKey' mergeIt Map.empty transformed
-                      where
-                        mergeIt db f (_,dbtrans) = Map.unionWith mergeKeyData  db dbtrans
-          -- | reportTrans
-          -- events, indexed by file
-          reportTrans :: [(FilePath, KikiReportAction)]
-          reportTrans = concat $ Map.elems $ fmap fst transformed
+    let -- | db_rings - all keyrings combined into one 
+        db_rings :: Map.Map KeyKey KeyData
+        db_rings = Map.foldlWithKey' mergeIt Map.empty transformed
+                    where
+                      mergeIt db f (_,dbtrans) = Map.unionWith mergeKeyData  db dbtrans
+        -- | reportTrans
+        -- events, indexed by file
+        reportTrans :: [(FilePath, KikiReportAction)]
+        reportTrans = concat $ Map.elems $ fmap fst transformed
 
     -- Wallets
-      let importWalletKey wk db' (top,fname,sub,tag) = do
-              try db' $ \(db',report0) -> do
-                r <- doImportG doDecrypt
-                          db'
-                          (fmap keykey $ maybeToList wk)
-                          [mkUsage tag]
-                          fname
-                          sub
-                try r $ \(db'',report) -> do
-                  return $ KikiSuccess (db'', report0 ++ report)
-
-      wms <- mapM (readw wk) (files iswallet)
-      let wallet_keys = do
-              maybeToList wk
-              (fname,xs) <- wms
-              (_,sub,(_,m)) <- xs
-              (tag,top) <- Map.toList m
-              return (top,fname,sub,tag)
-      db <- foldM (importWalletKey wk) (KikiSuccess (db_rings,[])) wallet_keys
-      try db $ \(db,reportWallets) -> do
-
-        -- PEM files
-        let pems = do
-                (n,stream) <- Map.toList $ opFiles keyring
-                grip <- maybeToList grip
-                n <- resolveInputFile ctx n
-                guard $ spillable stream && isSecretKeyFile (typ stream)
-                let us = mapMaybe usageFromFilter [fill stream,spill stream]
-                usage <- take 1 us
-                guard $ all (==usage) $ drop 1 us
-                -- TODO: KikiCondition reporting for spill/fill usage mismatch?
-                -- TODO: parseSpec3
-                let (topspec,subspec) = parseSpec grip usage
-                    ms = map fst $ filterMatches topspec (Map.toList db)
-                    cmd = initializer stream
-                return (n,subspec,ms,stream, cmd)
-
-        imports <- filterM (\(n,_,_,_,_) -> doesFileExist n) pems
-        db <- foldM (importSecretKey doDecrypt) (KikiSuccess (db,[])) imports
-        try db $ \(db,reportPEMs) -> do
-
-          -- generate keys
-          let gens = mapMaybe g $ Map.toList genMap
-                      where g (Generate _ params,v) = Just (params,v)
-                            g _                     = Nothing
-
-          db <- generateInternals doDecrypt mwk db gens
-          try db $ \(db,reportGens) -> do
-
-            r <- mergeHostFiles keyring db ctx
-            try r $ \((db,hs),reportHosts) -> do
-
-              return $ KikiSuccess ( (db, grip, mwk, hs, accs, doDecrypt, unspilled)
-                                  , reportTrans ++ reportWallets ++ reportPEMs ++ reportGens ++ reportHosts )
-
-
-resolveInputFile :: InputFileContext -> InputFile -> [FilePath]
-resolveInputFile ctx = resolve
- where
-    resolve HomeSec     = return (homesecPath ctx)
-    resolve HomePub     = return (homepubPath ctx)
-    resolve (ArgFile f) = return f
-    resolve _           = []
+    let importWalletKey wk db' (top,fname,sub,tag) = do
+            try db' $ \(db',report0) -> do
+            r <- doImportG transcode
+                      db'
+                      (fmap keykey $ maybeToList wk)
+                      [mkUsage tag]
+                      fname
+                      sub
+            try r $ \(db'',report) -> do
+            return $ KikiSuccess (db'', report0 ++ report)
+
+    wms <- mapM (readw wk) (files iswallet)
+    let wallet_keys = do
+            maybeToList wk
+            (fname,xs) <- wms
+            (_,sub,(_,m)) <- xs
+            (tag,top) <- Map.toList m
+            return (top,fname,sub,tag)
+
+    db <- foldM (importWalletKey wk) (KikiSuccess (db_rings,[])) wallet_keys
+    try db $ \(db,reportWallets) -> do
+
+    -- PEM files
+    let pems = do
+            (n,stream) <- Map.toList $ opFiles keyring
+            grip <- maybeToList grip
+            guard $ spillable stream && isSecretKeyFile (typ stream)
+            let us = mapMaybe usageFromFilter [fill stream,spill stream]
+            usage <- take 1 us
+            guard $ all (==usage) $ drop 1 us
+            -- TODO: KikiCondition reporting for spill/fill usage mismatch?
+            -- TODO: parseSpec3
+            let (topspec,subspec) = parseSpec grip usage
+                ms = map fst $ filterMatches topspec (Map.toList db)
+                cmd = initializer stream
+            return (n,subspec,ms,stream, cmd)
+
+    imports <- filterM (\case (ArgFile n,_,_,_,_) -> doesFileExist n
+                              _                   -> return True)
+                       pems
+    db <- foldM (importSecretKey transcode) (KikiSuccess (db,[])) imports
+    try db $ \(db,reportPEMs) -> do
+
+    -- generate keys
+    let gens = mapMaybe g $ Map.toList genMap
+                where g (Generate _ params,v) = Just (params,v)
+                      g _                     = Nothing
+
+    db <- generateInternals transcode mwk db gens
+    try db $ \(db,reportGens) -> do
+
+    r <- mergeHostFiles keyring db ctx
+    try r $ \((db,hs),reportHosts) -> do
+
+    return $ KikiSuccess ( (db, grip, mwk, hs, accs, transcode, unspilled)
+                         , reportTrans ++ reportWallets ++ reportPEMs ++ reportGens ++ reportHosts )
+
 
 isring :: FileType -> Bool
 isring (KeyRingFile {}) = True
@@ -327,11 +322,12 @@ readPacketsFromWallet wk fname = do
     timestamp <- getInputFileTime ctx fname
     input <- readInputFileL ctx fname
     let (ks,_) = slurpWIPKeys timestamp input
+    {-
     unless (null ks) $ do
         -- decrypt wk
         -- create sigs
         -- return key/sig pairs
-        return ()
+        return () -}
     return $ do
         wk <- maybeToList wk
         guard (not $ null ks)
@@ -344,120 +340,11 @@ spillable :: StreamInfo -> Bool
 spillable (spill -> KF_None) = False
 spillable _                  = True
 
-isSecretKey :: Packet -> Bool
-isSecretKey (SecretKeyPacket {}) = True
-isSecretKey _                    = False
-
-mappedPacketWithHint :: FilePath -> Packet -> Int -> MappedPacket
-mappedPacketWithHint filename p hint = MappedPacket
-    { packet = p
-    , locations = Map.singleton filename (origin p hint)
-    }
-
-resolveForReport :: Maybe InputFileContext -> InputFile -> FilePath
-resolveForReport mctx (Pipe fdr fdw) = resolveForReport mctx (ArgFile str)
- where str = case (fdr,fdw) of
-                (0,1) -> "-"
-                _     -> "&pipe" ++ show (fdr,fdw)
-resolveForReport mctx (FileDesc fd) = resolveForReport mctx (ArgFile str)
- where str = "&" ++ show fd
-resolveForReport mctx f = concat $ resolveInputFile ctx f
- where ctx = fromMaybe (InputFileContext "&secret" "&public") mctx
-
-keykey :: Packet -> KeyKey
-keykey key =
-    -- Note: The key's timestamp is normally included in it's fingerprint.
-    --       This is undesirable for kiki because it causes the same
-    --       key to be imported multiple times and show as apparently
-    --       distinct keys with different fingerprints.
-    --       Thus, we will remove the timestamp.
-    fingerprint_material (key {timestamp=0}) -- TODO: smaller key?
-
--- matchpr computes the fingerprint of the given key truncated to
--- be the same lenght as the given fingerprint for comparison.
---
--- matchpr fp = Data.List.Extra.takeEnd (length fp)
---
-matchpr :: String -> Packet -> String
-matchpr fp k = reverse $ zipWith const (reverse (fingerprint k)) fp
-
-makeMemoizingDecrypter :: KeyRingOperation -> InputFileContext
-                        -> Map.Map KeyKey MappedPacket
-                        -> IO (MappedPacket -> IO (KikiCondition Packet))
-makeMemoizingDecrypter operation ctx keys =
-   if null chains then  do
-    -- (*) Notice we do not pass ctx to resolveForReport.
-    -- This is because the merge function does not currently use a context
-    -- and the pws map keys must match the MappedPacket locations.
-    -- TODO: Perhaps these should both be of type InputFile rather than
-    -- FilePath?
-    -- pws :: Map.Map FilePath (IO S.ByteString)
-    {-
-    pws <-
-        Traversable.mapM (cachedContents ctx . fromJust . pwfile . typ)
-                         (Map.mapKeys (resolveForReport Nothing) -- see note (*) note above
-                            $ Map.filter (isJust . pwfile . typ) $ opFiles operation)
-    -}
-        let prompt = Just "Enter possibly multi-line passphrase (Press CTRL-D when finished):\n"
-        pws2 <-
-            Traversable.mapM (cachedContents prompt ctx)
-             $ Map.fromList $ mapMaybe
-                    (\spec -> (,passSpecPassFile spec) `fmap` do
-                        guard $ isNothing $ passSpecKeySpec spec
-                        passSpecRingFile spec)
-                    passspecs
-        defpw <- do
-            Traversable.mapM (cachedContents prompt ctx . passSpecPassFile)
-             $ listToMaybe $ filter (\sp -> isNothing (passSpecRingFile sp)
-                                            && isNothing (passSpecKeySpec sp))
-                                        $ opPassphrases operation
-        unkeysRef <- newIORef (Map.empty :: Map.Map KeyKey Packet)
-        return $ doDecrypt unkeysRef ({- pws `Map.union` -} pws2) defpw
-    else let PassphraseMemoizer f = head chains
-         in return f
- where
-    (chains,passspecs) = partition isChain $ opPassphrases operation
-                            where isChain (PassphraseMemoizer {}) = True
-                                  isChain _                       = False
-    doDecrypt :: IORef (Map.Map KeyKey Packet)
-                -> Map.Map FilePath (IO S.ByteString)
-                -> Maybe (IO S.ByteString)
-                -> MappedPacket
-                -> IO (KikiCondition Packet)
-    doDecrypt unkeysRef pws defpw mp0 = do
-        unkeys <- readIORef unkeysRef
-        let mp = fromMaybe mp0 $ do
-                    k <- Map.lookup kk keys
-                    return $ mergeKeyPacket "decrypt" mp0 k
-            wk = packet mp0
-            kk = keykey wk
-            fs = Map.keys $ locations mp
-
-            decryptIt [] = return BadPassphrase
-            decryptIt (getpw:getpws) = do
-                -- TODO: This function should use mergeKeyPacket to
-                --  combine the packet with it's unspilled version before
-                --  attempting to decrypt it.
-                pw <- getpw
-                let wkun = fromMaybe wk $ decryptSecretKey pw (packet mp)
-                case symmetric_algorithm wkun of
-                    Unencrypted -> do
-                        writeIORef unkeysRef (Map.insert kk wkun unkeys)
-                        return $ KikiSuccess wkun
-                    _ -> decryptIt getpws
-
-            getpws = mapMaybe (`Map.lookup` pws) fs ++ maybeToList defpw
-
-        case symmetric_algorithm wk of
-            Unencrypted -> return (KikiSuccess wk)
-            _ -> maybe (decryptIt getpws)
-                       (return . KikiSuccess)
-                    $ Map.lookup kk unkeys
 
 -- | combineTransforms
--- remove rundant transforms, and compile the rest to PacketUpdate(s)
+-- remove redundant transforms, and compile the rest to PacketUpdate(s)
 --
--- eqivalent to:
+-- equivalent to:
 -- > combineTransforms = group (sort trans) >>= take 1 >>= resolveTransform t rt kd
 combineTransforms :: [Transform] -> KeyRingRuntime -> KeyData -> [PacketUpdate]
 combineTransforms trans rt kd = updates
@@ -490,108 +377,6 @@ merge db inputfile (Message ps) = merge_ db filename qs
         updateTrust (PublicKeyPacket {}) _   (pre,t) p = (pre,Map.insert filename p t) -- public
         updateTrust _                    _   (pre,t) p = (pre,Map.insert filename p t) -- secret
 
-performManipulations ::
-                (MappedPacket -> IO (KikiCondition Packet))
-                -> 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])
-
-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
 
 mergeKeyData :: KeyData -> KeyData -> KeyData
 mergeKeyData (KeyData atop asigs auids asubs)
@@ -620,40 +405,19 @@ mergeKeyData (KeyData atop asigs auids asubs)
     mergeUIDSigs (as,am) (bs,bm) = (foldl' (flip mergeSig) as bs, Map.union am bm)
 
 doImportG
-  :: (MappedPacket -> IO (KikiCondition Packet))
+  :: PacketTranscoder
      -> Map.Map KeyKey KeyData
      -> [KeyKey] -- m0,  only head is used
      -> [SignatureSubpacket] -- tags
-     -> FilePath
+     -> InputFile
      -> Packet
      -> IO (KikiCondition (Map.Map KeyKey KeyData, [(FilePath,KikiReportAction)]))
-doImportG doDecrypt db m0 tags fname key = do
+doImportG transcode db m0 tags fname key = do
     let kk = head m0
         Just kd@(KeyData top topsigs uids subs) = Map.lookup kk db
-    kdr <- insertSubkey doDecrypt kk kd tags fname key
+    kdr <- insertSubkey transcode kk kd tags fname key
     try kdr $ \(kd',rrs) -> return $ KikiSuccess (Map.insert kk kd' db, rrs)
 
-mkUsage :: String -> SignatureSubpacket
-mkUsage tag
-  | Just flags <- lookup tag specials =
-    KeyFlagsPacket
-    { certify_keys = fromEnum flags .&. 0x1 /= 0
-    , sign_data = fromEnum flags .&. 0x2 /= 0
-    , encrypt_communication = fromEnum flags .&. 0x4 /= 0
-    , encrypt_storage = fromEnum flags .&. 0x8 /= 0
-    , split_key = False
-    , authentication = False
-    , group_key = False
-    }
-  where
-    flagsets = [Special .. VouchSignEncrypt]
-    specials = map (\f -> (usageString f, f)) flagsets
-
-mkUsage tag = NotationDataPacket
-                { human_readable = True
-                , notation_name = "usage@"
-                , notation_value = tag
-                }
 
 iswallet :: FileType -> Bool
 iswallet (WalletFile {}) = True
@@ -749,32 +513,32 @@ filterMatches :: KeySpec -> [(KeyKey,KeyData)] -> [(KeyKey,KeyData)]
 filterMatches spec ks = filter (matchSpec spec . snd) ks
 
 importSecretKey ::
-  (MappedPacket -> IO (KikiCondition Packet))
+  (PacketTranscoder)
   -> KikiCondition
        (Map.Map KeyKey KeyData, [(FilePath, KikiReportAction)])
-  -> (FilePath, Maybe [Char], [KeyKey], StreamInfo, t)
+  -> (InputFile, Maybe [Char], [KeyKey], StreamInfo, t)
   -> IO (KikiCondition (Map.Map KeyKey KeyData, [(FilePath, KikiReportAction)]))
-importSecretKey doDecrypt db' tup = do
+importSecretKey transcode db' tup = do
             try db' $ \(db',report0) -> do
-              r <- doImport doDecrypt
-                        db'
-                        tup
-              try r $ \(db'',report) -> do
-                return $ KikiSuccess (db'', report0 ++ report)
+            r <- doImport transcode
+                      db'
+                      tup
+            try r $ \(db'',report) -> do
+            return $ KikiSuccess (db'', report0 ++ report)
 
 generateInternals ::
-    (MappedPacket -> IO (KikiCondition Packet))
+    PacketTranscoder
     -> Maybe MappedPacket
     -> Map.Map KeyKey KeyData
     -> [(GenerateKeyParams,StreamInfo)]
     -> IO (KikiCondition (Map.Map KeyKey KeyData, [(FilePath, KikiReportAction)]))
-generateInternals doDecrypt mwk db gens = do
+generateInternals transcode mwk db gens = do
     case fmap packet mwk >>= \wk -> Map.lookup (keykey wk) db of
         Just kd0 -> do
-            kd <- foldM (generateSubkey doDecrypt) (KikiSuccess (kd0,[])) gens
+            kd <- foldM (generateSubkey transcode) (KikiSuccess (kd0,[])) gens
             try kd $ \(kd,reportGens) -> do
-              let kk = keykey $ packet $ fromJust mwk
-              return $ KikiSuccess (Map.insert kk kd db,reportGens)
+            let kk = keykey $ packet $ fromJust mwk
+            return $ KikiSuccess (Map.insert kk kd db,reportGens)
         Nothing -> return $ KikiSuccess (db,[])
 
 mergeHostFiles :: KeyRingOperation -> KeyDB -> InputFileContext
@@ -875,89 +639,6 @@ slurpWIPKeys stamp cs =
         else let (ks,js) = slurpWIPKeys stamp xs
              in maybe (ks,b58:js) (\(net,Message [k])->((net,k):ks,js)) mb
 
-origin :: Packet -> Int -> OriginFlags
-origin p n = OriginFlags ispub n
- where
-    ispub = case p of
-                    SecretKeyPacket {} -> False
-                    _                  -> True
-
-cachedContents :: Maybe S.ByteString -> InputFileContext -> InputFile -> IO (IO S.ByteString)
-cachedContents maybePrompt ctx fd = do
-    ref <- newIORef Nothing
-    return $ get maybePrompt ref fd
- where
-    trimCR bs = fst $ S.spanEnd (\x -> x==10 || x==13) bs
-
-    get maybePrompt ref fd = do
-        pw <- readIORef ref
-        flip (flip maybe return) pw $ do
-            if fd == FileDesc 0 then case maybePrompt of
-                                    Just prompt -> S.hPutStr stderr prompt
-                                    Nothing     -> return ()
-                               else return ()
-            pw <- fmap trimCR $ readInputFileS ctx fd
-            writeIORef ref (Just pw)
-            return pw
-
-mergeKeyPacket :: String -> MappedPacket -> MappedPacket -> MappedPacket
-mergeKeyPacket what key p =
-    key { packet = minimumBy (keyCompare what) [packet key,packet p]
-        , locations = Map.union (locations key) (locations p)
-        }
-
--- | 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
-
 merge_ :: KeyDB -> FilePath -> [(Packet,Packet,(Packet,Map.Map FilePath Packet))]
                 -> KeyDB
 merge_ db filename qs = foldl mergeit db (zip [0..] qs)
@@ -972,140 +653,38 @@ merge_ db filename qs = foldl mergeit db (zip [0..] qs)
 
     whatP (a,_) = concat . take 1 . words . show $ a
 
-isKey :: Packet -> Bool
-isKey (PublicKeyPacket {}) = True
-isKey (SecretKeyPacket {}) = True
-isKey _                    = False
-
-isUserID :: Packet -> Bool
-isUserID (UserIDPacket {}) = True
-isUserID _                 = False
-
-isTrust :: Packet -> Bool
-isTrust (TrustPacket {}) = True
-isTrust _                = False
 
-keyPacket :: KeyData -> Packet
-keyPacket (KeyData k _ _ _) = packet k
-
-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
-
-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]
-
-insertSubkey :: (MappedPacket -> IO (KikiCondition Packet)) -> t -> KeyData -> [SignatureSubpacket] -> [Char] -> Packet -> IO (KikiCondition (KeyData, [([Char], KikiReportAction)]))
-insertSubkey doDecrypt kk (KeyData top topsigs uids subs) tags fname key = do
-    let subkk = keykey key
-        (is_new, subkey) = maybe (True, SubKey (mappedPacket fname key)
-                                               [])
-                                 ( (False,) . addOrigin )
-                                 (Map.lookup subkk subs)
-                             where
-                                addOrigin (SubKey mp sigs) =
+-- insertSubkey :: (MappedPacket -> IO (KikiCondition Packet)) -> t -> KeyData -> [SignatureSubpacket] -> [Char] -> Packet -> IO (KikiCondition (KeyData, [([Char], KikiReportAction)]))
+insertSubkey transcode kk (KeyData top topsigs uids subs) tags inputfile key0 = do
+    let topcipher = symmetric_algorithm $ packet top
+        tops2k    = s2k $ packet top
+        doDecrypt = transcode (Unencrypted,S2K 100 "")
+        fname = resolveForReport Nothing inputfile
+        subkk = keykey key0
+        istor = do
+            guard ("tor" `elem` mapMaybe usage tags)
+            return $ torUIDFromKey key0
+        addOrigin (SubKey mp sigs) =
                                     let mp' = mp
                                           { locations = Map.insert fname
                                                              (origin (packet mp) (-1))
                                                              (locations mp) }
                                     in SubKey mp' sigs
-        subs' = Map.insert subkk subkey subs
 
-        istor = do
-            guard ("tor" `elem` mapMaybe usage tags)
-            return $ "Anonymous <root@" ++ take 16 (torhash key) ++ ".onion>"
+    subkey_result <- do
+        case Map.lookup subkk subs of
+            Just sub -> return $ KikiSuccess (False,addOrigin sub,Nothing)
+            Nothing  -> do
+                wkun' <- doDecrypt top
+                try wkun' $ \wkun -> do
+                key' <- transcode (topcipher,tops2k) $ mappedPacket "" key0
+                try key' $ \key -> do
+                return $ KikiSuccess (True, SubKey (mappedPacket fname key) [], Just (wkun,key))
+
+
+    try subkey_result $ \(is_new,subkey,decrypted) -> do
+
+    let subs' = Map.insert subkk subkey subs
 
     uids' <- flip (maybe $ return $ KikiSuccess (uids,[])) istor $ \idstr -> do
                 let has_torid = do
@@ -1115,72 +694,58 @@ insertSubkey doDecrypt kk (KeyData top topsigs uids subs) tags fname key = do
                          s <- (signatures $ Message (packet top:UserIDPacket idstr:map (packet . fst) sigtrusts))
                          signatures_over $ verify (Message [packet top]) s
                 flip (flip maybe $ const $ return $ KikiSuccess (uids,[])) has_torid $ do
-                  wkun <- doDecrypt top
-
-                  try wkun $ \wkun -> do
-
-                    let keyflags = keyFlags wkun (map packet $ flattenAllUids fname True uids)
-                        uid = UserIDPacket idstr
-                        -- sig_ov = fst $ torsig g (packet top) wkun uid timestamp keyflags
-                        tor_ov = makeInducerSig (packet top) wkun uid keyflags
-                    sig_ov <- pgpSign (Message [wkun])
-                                      tor_ov
-                                      SHA1
-                                      (fingerprint wkun)
-                    flip (maybe $ return $ KikiSuccess (uids,[(fname, WarnFailedToMakeSignature)]))
-                        (sig_ov >>= listToMaybe . signatures_over)
-                        $ \sig -> do
-                          let om = Map.singleton fname (origin sig (-1))
-                              trust = Map.empty
-                          return $ KikiSuccess
-                              ( Map.insert idstr ([( (mappedPacket fname sig) {locations=om}
-                                                  , trust)],om) uids
-                              , [] )
+
+                let keyflags = keyFlags (error "dummy argument (insertSubkey)") (map packet $ flattenAllUids fname True uids)
+                    uid = UserIDPacket idstr
+                    -- sig_ov = fst $ torsig g (packet top) wkun uid timestamp keyflags
+                    tor_ov = makeInducerSig (packet top) (packet top) uid keyflags
+                wkun' <- maybe (doDecrypt top) (return . KikiSuccess . fst) decrypted
+                try wkun' $ \wkun -> do
+                sig_ov <- pgpSign (Message [wkun])
+                                  tor_ov
+                                  SHA1
+                                  (fingerprint wkun)
+                flip (maybe $ return $ KikiSuccess (uids,[(fname, WarnFailedToMakeSignature)]))
+                     (sig_ov >>= listToMaybe . signatures_over)
+                     $ \sig -> do
+                let om = Map.singleton fname (origin sig (-1))
+                    trust = Map.empty
+                return $ KikiSuccess
+                    ( Map.insert idstr ([( (mappedPacket fname sig) {locations=om}
+                                         , trust)],om) uids
+                    , [] )
 
     try uids' $ \(uids',report) -> do
 
-      let SubKey subkey_p subsigs = subkey
-          wk = packet top
-          (xs',minsig,ys') = findTag tags wk key subsigs
-          doInsert mbsig = do
-              -- NEW SUBKEY BINDING SIGNATURE
-              sig' <- makeSig doDecrypt top fname subkey_p tags mbsig
-              try sig' $ \(sig',report) -> do
-                report <- return $ fmap (fname,) report ++ [(fname, YieldSignature)]
-                let subs' = Map.insert subkk
-                                      (SubKey subkey_p $ xs'++[sig']++ys')
-                                      subs
-                return $ KikiSuccess ( KeyData top topsigs uids' subs'
-                                    , report )
-
-      report <- let f = if is_new then (++[(fname,YieldSecretKeyPacket s)])
-                                      else id
-                    s = show (fmap fst minsig,fingerprint key)
-                in return (f report)
-
-      case minsig of
-          Nothing          -> doInsert Nothing -- we need to create a new sig
-          Just (True,sig)  -> -- we can deduce is_new == False
-                              -- we may need to add a tor id
-                              return $ KikiSuccess ( KeyData top topsigs uids' subs'
-                                                  , report )
-          Just (False,sig) -> doInsert (Just sig) -- We have a sig, but is missing usage@ tag
-
-mappedPacket :: FilePath -> Packet -> MappedPacket
-mappedPacket filename p = MappedPacket
-    { packet = p
-    , locations = Map.singleton filename (origin p (-1))
-    }
-
-showPacket :: Packet -> String
-showPacket p | isKey p   = (if is_subkey p
-                              then showPacket0 p
-                              else ifSecret p "----Secret-----" "----Public-----")
-                           ++ " "++show (key_algorithm p)++" "++fingerprint p
-             | isUserID p = showPacket0 p ++ " " ++ show (uidkey p)
-             | otherwise = showPacket0 p
-showPacket0 :: Show a => a -> [Char]
-showPacket0 p = concat . take 1 $ words (show p)
+    let SubKey subkey_p subsigs = subkey
+        wk = packet top
+        (xs',minsig,ys') = findTag tags wk key0 subsigs
+        doInsert mbsig = do
+            -- NEW SUBKEY BINDING SIGNATURE
+            -- XXX: Here I assume that key0 is the unencrypted version
+            --      of subkey_p.  TODO: Check this assumption.
+            sig' <- makeSig doDecrypt top fname subkey_p{packet=key0} tags mbsig
+            try sig' $ \(sig',report) -> do
+            report <- return $ fmap (fname,) report ++ [(fname, YieldSignature)]
+            let subs' = Map.insert subkk
+                                   (SubKey subkey_p $ xs'++[sig']++ys')
+                                   subs
+            return $ KikiSuccess ( KeyData top topsigs uids' subs'
+                                 , report )
+
+    report <- let f = if is_new then (++[(fname,YieldSecretKeyPacket s)])
+                                    else id
+                  s = show (fmap fst minsig,fingerprint key0)
+              in return (f report)
+
+    case minsig of
+        Nothing          -> doInsert Nothing -- we need to create a new sig
+        Just (True,sig)  -> -- we can deduce is_new == False
+                            -- we may need to add a tor id
+                            return $ KikiSuccess ( KeyData top topsigs uids' subs'
+                                                 , report )
+        Just (False,sig) -> doInsert (Just sig) -- We have a sig, but is missing usage@ tag
+
 
 mergeSig :: SigAndTrust -> [SigAndTrust] -> [SigAndTrust]
 mergeSig sig sigs =
@@ -1207,26 +772,6 @@ mergeSig sig sigs =
 
         mergeSameSig a b = b -- trace ("discarding dup "++show a) b
 
-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"
-
 parseSingleSpec :: String -> SingleKeySpec
 parseSingleSpec "*"              = AnyMatch
 parseSingleSpec "-"              = WorkingKeyMatch
@@ -1270,66 +815,66 @@ matchSpec (KeyUidMatch pat) (KeyData _ _ uids _) = not $ null us
     us = filter (isInfixOf pat) $ Map.keys uids
 
 doImport
-  :: (MappedPacket -> IO (KikiCondition Packet))
+  :: PacketTranscoder
      -> Map.Map KeyKey KeyData
-     -> (FilePath, Maybe [Char], [KeyKey], StreamInfo, t)
+     -> (InputFile, Maybe [Char], [KeyKey], StreamInfo, t)
      -> IO (KikiCondition (Map.Map KeyKey KeyData, [(FilePath,KikiReportAction)]))
-doImport doDecrypt db (fname,subspec,ms,typ -> typ,_) = do
+doImport transcode db (fname,subspec,ms,typ -> typ,_) = do
     flip (maybe $ return CannotImportMasterKey)
          subspec $ \tag -> do
-      (certs,keys) <- case typ of
-          PEMFile -> do
-              ps <- readSecretPEMFile (ArgFile fname)
-              let (mapMaybe spemCert -> certs,mapMaybe spemPacket-> keys)
-                      = partition (isJust . spemCert) ps
-              return (certs,keys)
-          DNSPresentation -> do
-              p <- readSecretDNSFile (ArgFile fname)
-              return ([],[p])
-      -- TODO Probably we need to move to a new design where signature
-      -- packets are merged into the database in one phase with null
-      -- signatures, and then the signatures are made in the next phase.
-      -- This would let us merge annotations (like certificates) from
-      -- seperate files.
-      foldM (importKey tag certs) (KikiSuccess (db,[])) keys
+    (certs,keys) <- case typ of
+        PEMFile -> do
+            ps <- readSecretPEMFile fname
+            let (mapMaybe spemCert -> certs,mapMaybe spemPacket-> keys)
+                    = partition (isJust . spemCert) ps
+            return (certs,keys)
+        DNSPresentation -> do
+            p <- readSecretDNSFile fname
+            return ([],[p])
+    -- TODO Probably we need to move to a new design where signature
+    -- packets are merged into the database in one phase with null
+    -- signatures, and then the signatures are made in the next phase.
+    -- This would let us merge annotations (like certificates) from
+    -- seperate files.
+    foldM (importKey tag certs) (KikiSuccess (db,[])) keys
  where
     importKey tag certs prior key = do
         try prior $ \(db,report) -> do
-          let (m0,tailms) = splitAt 1 ms
-          if (not (null tailms) || null m0)
-              then return $ AmbiguousKeySpec fname
-              else do
-                  let kk = keykey key
-                      cs = filter (\c -> kk==keykey (pcertKey c)) certs
-                      blobs = map mkCertNotation $ nub $ map pcertBlob cs
-                      mkCertNotation bs = NotationDataPacket
-                          { human_readable = False
-                          , notation_name = "x509cert@"
-                          , notation_value = Char8.unpack bs }
-                      datedKey = key { timestamp = fromTime $ minimum dates }
-                      dates = fromTime (timestamp key) : map pcertTimestamp certs
-                  r <- doImportG doDecrypt db m0 (mkUsage tag:blobs) fname datedKey
-                  try r $ \(db',report') -> do
-                    return $ KikiSuccess (db',report++report')
+        let (m0,tailms) = splitAt 1 ms
+        if (not (null tailms) || null m0)
+            then return $ AmbiguousKeySpec (resolveForReport Nothing fname)
+            else do
+                let kk = keykey key
+                    cs = filter (\c -> kk==keykey (pcertKey c)) certs
+                    blobs = map mkCertNotation $ nub $ map pcertBlob cs
+                    mkCertNotation bs = NotationDataPacket
+                        { human_readable = False
+                        , notation_name = "x509cert@"
+                        , notation_value = Char8.unpack bs }
+                    datedKey = key { timestamp = fromTime $ minimum dates }
+                    dates = fromTime (timestamp key) : map pcertTimestamp certs
+                r <- doImportG transcode db m0 (mkUsage tag:blobs) fname datedKey
+                try r $ \(db',report') -> do
+                return $ KikiSuccess (db',report++report')
 
 generateSubkey ::
-  (MappedPacket -> IO (KikiCondition Packet)) -- decrypt[
+  PacketTranscoder
   -> KikiCondition (KeyData, [(FilePath, KikiReportAction)]) -- db
   -> (GenerateKeyParams, StreamInfo)
   -> IO (KikiCondition (KeyData, [(FilePath, KikiReportAction)]))
-generateSubkey doDecrypt kd' (genparam,StreamInfo { spill = KF_Match tag }) = do
+generateSubkey transcode kd' (genparam,StreamInfo { spill = KF_Match tag }) = do
     try kd' $ \(kd,report0) -> do
-      let subs = do
-              SubKey p sigs <- Map.elems $ keySubKeys kd
-              filter (has_tag tag) $ map (packet . fst) sigs
-      if null subs
-        then do
-          newkey <- generateKey genparam
-          kdr <- insertSubkey doDecrypt (keykey (keyPacket kd)) kd [mkUsage tag] "" newkey
-          try kdr $ \(newkd,report) -> do
-            return $ KikiSuccess (newkd, report ++ [("", NewPacket $ showPacket newkey)])
-        else do
-          return $ KikiSuccess (kd,report0)
+    let subs = do
+            SubKey p sigs <- Map.elems $ keySubKeys kd
+            filter (has_tag tag) $ map (packet . fst) sigs
+    if null subs
+      then do
+        newkey <- generateKey genparam
+        kdr <- insertSubkey transcode (keykey (keyPacket kd)) kd [mkUsage tag] (ArgFile "") newkey
+        try kdr $ \(newkd,report) -> do
+        return $ KikiSuccess (newkd, report ++ [("", NewPacket $ showPacket newkey)])
+      else do
+        return $ KikiSuccess (kd,report0)
 generateSubkey _ kd _ = return kd
 
 -- |
@@ -1496,12 +1041,6 @@ secp256k1_id = 0x2b8104000a
     "NIST P-521"  6   0x05, 0x2B, 0x81, 0x04, 0x00, 0x23
 -}
 
-readInputFileS :: InputFileContext -> InputFile -> IO S.ByteString
-readInputFileS ctx (Pipe fd _)   = fdToHandle fd >>= S.hGetContents
-readInputFileS ctx (FileDesc fd) = fdToHandle fd >>= S.hGetContents
-readInputFileS ctx inp = do
-    let fname = resolveInputFile ctx inp
-    fmap S.concat $ mapM S.readFile fname
 
 keyCompare :: String -> Packet -> Packet -> Ordering
 keyCompare what (SecretKeyPacket {}) (PublicKeyPacket {}) = LT
@@ -1514,101 +1053,6 @@ keyCompare what a b = error $ unlines ["Unable to merge "++what++":"
                               , PP.ppShow b
                               ]
 
-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
-
-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))
-
-derToBase32 :: ByteString -> String
-#if !defined(VERSION_cryptonite)
-derToBase32 = map toLower . Base32.encode . S.unpack . SHA1.hashlazy
-#else
-derToBase32 = map toLower . Base32.encode . S.unpack . sha1
- where
-   sha1 :: L.ByteString -> S.ByteString
-   sha1 x = convert (Vincent.hashlazy x :: Vincent.Digest Vincent.SHA1)
-#endif
-
-derRSA :: Packet -> Maybe ByteString
-derRSA rsa = do
-    k <- rsaKeyFromPacket rsa
-    return $ encodeASN1 DER (toASN1 k [])
-
-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)
-
--- 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)
-
-subkeyMappedPacket :: SubKey -> MappedPacket
-subkeyMappedPacket (SubKey k _ ) = k
-
-has_tag :: String -> Packet -> Bool
-has_tag tag p = isSignaturePacket p
-                    && or [ tag `elem` mapMaybe usage (hashed_subpackets p)
-                          , tag `elem` map usageString (mapMaybe keyflags (hashed_subpackets p)) ]
 
 dbInsertPacket :: KeyData -> FilePath -> (Int,(Packet,Packet,(Packet,Map.Map FilePath Packet))) -> Maybe KeyData
 dbInsertPacket kd filename (n,(top,sub,ptt@(p,trustmap))) = update (Just kd)
@@ -1689,200 +1133,55 @@ secretToPublic pkt@(SecretKeyPacket {}) =
                     }
 secretToPublic pkt = pkt
 
-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]
-
-usage :: SignatureSubpacket -> Maybe String
-usage (NotationDataPacket
-        { human_readable = True
-        , notation_name  = "usage@"
-        , notation_value = u
-        }) = Just u
-usage _    = Nothing
-
-torhash :: Packet -> String
-torhash key = fromMaybe "" $ derToBase32 <$> derRSA key
-
-keyFlags :: t -> [Packet] -> [SignatureSubpacket]
-keyFlags  wkun uids = keyFlags0 wkun (filter isSignaturePacket uids)
-
-flattenAllUids :: FilePath -> Bool -> Map.Map String ([SigAndTrust],OriginMap) -> [MappedPacket]
-flattenAllUids fname ispub uids =
-    concatSort fname head (flattenUid fname ispub) (Map.assocs uids)
-
--- | Given list of subpackets, a master key, one of its subkeys and a
--- list of signatures on that subkey, yields:
---
---   * preceding list of signatures
---
---   * The most recent valid signature made by the master key along with a
---   flag that indicates whether or not all of the supplied subpackets occur in
---   it or, if no valid signature from the working key is present, Nothing.
---
---   * following list of signatures
---
-findTag ::
-  [SignatureSubpacket]
-  -> Packet
-  -> Packet
-  -> [(MappedPacket, b)]
-  -> ([(MappedPacket, b)],
-      Maybe (Bool, (MappedPacket, b)),
-      [(MappedPacket, b)])
-findTag tag topk subkey subsigs = (xs',minsig,ys')
-         where
-            vs = map (\sig ->
-                          (sig, do
-                                sig <- Just (packet . fst $ sig)
-                                guard (isSignaturePacket sig)
-                                guard $ flip isSuffixOf
-                                             (fingerprint topk)
-                                        . fromMaybe "%bad%"
-                                        . signature_issuer
-                                        $ sig
-                                listToMaybe $
-                                  map (signature_time . verify (Message [topk]))
-                                      (signatures $ Message [topk,subkey,sig])))
-                     subsigs
-            (xs,ys) = splitAtMinBy (comparing (Down . snd)) vs
-            xs' = map fst xs
-            ys' = map fst $ if isNothing minsig then ys else drop 1 ys
-            minsig = do
-                (sig,ov) <- listToMaybe ys
-                ov
-                let hshed = hashed_subpackets $ packet $ fst sig
-                return ( null $ tag \\ hshed, sig)
-
-makeSig ::
-  (MappedPacket -> IO (KikiCondition Packet))
-  -> MappedPacket
-  -> [Char]
-  -> MappedPacket
-  -> [SignatureSubpacket]
-  -> Maybe (MappedPacket, Map.Map k a)
-  -> IO (KikiCondition ((MappedPacket, Map.Map k a), [KikiReportAction]))
-makeSig doDecrypt top fname subkey_p tags mbsig = do
-  let wk = packet top
-  wkun <- doDecrypt top
-  try wkun $ \wkun -> do
-    let grip = fingerprint wk
-        addOrigin new_sig =
-          flip
-            (maybe $ return FailedToMakeSignature)
-            (new_sig >>= listToMaybe . signatures_over) $ \new_sig -> do
-            let mp' = mappedPacket fname new_sig
-            return $ KikiSuccess (mp', Map.empty)
-        parsedkey = [packet subkey_p]
-        hashed0
-          | any isFlagsPacket tags = tags
-          | otherwise =
-            KeyFlagsPacket
-            { certify_keys = False
-            , sign_data = False
-            , encrypt_communication = False
-            , encrypt_storage = False
-            , split_key = False
-            , authentication = True
-            , group_key = False
-            } :
-            tags
-                    -- implicitly added:
-                    -- , SignatureCreationTimePacket (fromIntegral timestamp)
-        isFlagsPacket (KeyFlagsPacket {}) = True
-        isFlagsPacket _                   = False
-        subgrip = fingerprint (head parsedkey)
-    back_sig <-
-      pgpSign
-        (Message parsedkey)
-        (SubkeySignature
-           wk
-           (head parsedkey)
-           (sigpackets 0x19 hashed0 [IssuerPacket subgrip]))
-        (if key_algorithm (head parsedkey) == ECDSA
-           then SHA256
-           else SHA1)
-        subgrip
-    let iss = IssuerPacket (fingerprint wk)
-        cons_iss back_sig =
-          iss : map EmbeddedSignaturePacket (signatures_over back_sig)
-        unhashed0 = maybe [iss] cons_iss back_sig
-    new_sig <-
-      pgpSign
-        (Message [wkun])
-        (SubkeySignature wk (head parsedkey) (sigpackets 0x18 hashed0 unhashed0))
-        SHA1
-        grip
-    let newSig = do
-          r <- addOrigin new_sig
-          return $ fmap (, []) r
-    flip (maybe newSig) mbsig $ \(mp, trustmap) -> do
-      let sig = packet mp
-          isCreation (SignatureCreationTimePacket {}) = True
-          isCreation _                                = False
-          isExpiration (SignatureExpirationTimePacket {}) = True
-          isExpiration _                                  = False
-          (cs, ps) = partition isCreation (hashed_subpackets sig)
-          (es, qs) = partition isExpiration ps
-          stamp = listToMaybe . sortBy (comparing Down) $ map unwrap cs
-            where
-              unwrap (SignatureCreationTimePacket x) = x
-          exp = listToMaybe $ sort $ map unwrap es
-            where
-              unwrap (SignatureExpirationTimePacket x) = x
-          expires = liftA2 (+) stamp exp
-      timestamp <- now
-      if fmap ((< timestamp) . fromIntegral) expires == Just True
-        then return $
-             KikiSuccess ((mp, trustmap), [UnableToUpdateExpiredSignature])
-        else do
-          let times =
-                (:) (SignatureExpirationTimePacket (fromIntegral timestamp)) $
-                maybeToList $ do
-                  e <- expires
-                  return $
-                    SignatureExpirationTimePacket (e - fromIntegral timestamp)
-              sig' = sig {hashed_subpackets = times ++ (qs `union` tags)}
-          new_sig <-
-            pgpSign
-              (Message [wkun])
-              (SubkeySignature wk (packet subkey_p) [sig'])
-              SHA1
-              (fingerprint wk)
-          newsig <- addOrigin new_sig
-          return $ fmap (, []) newsig
 
 ifSecret :: Packet -> t -> t -> t
 ifSecret (SecretKeyPacket {}) t f = t
 ifSecret _                    t f = f
 
-uidkey :: Packet -> String
-uidkey (UserIDPacket str) = str
-
-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
+instance ASN1Object RSAPrivateKey where
+    toASN1 rsa@(RSAPrivateKey {})
+        = \xs -> Start Sequence
+               : IntVal 0
+               : mpiVal rsaN
+               : mpiVal rsaE
+               : mpiVal rsaD
+               : mpiVal rsaP
+               : mpiVal rsaQ
+               : mpiVal rsaDmodP1
+               : mpiVal rsaDmodQminus1
+               : mpiVal rsaCoefficient
+               : End Sequence
+               : xs
+                  where mpiVal f = IntVal x where MPI x = f rsa
+
+    fromASN1 ( Start Sequence
+             : IntVal _ -- version
+             : IntVal n
+             : IntVal e
+             : IntVal d
+             : IntVal p
+             : IntVal q
+             : IntVal dmodp1
+             : IntVal dmodqminus1
+             : IntVal coefficient
+             : ys) =
+        Right ( privkey, tail $ dropWhile notend ys)
+         where
+            notend (End Sequence) = False
+            notend _              = True
+            privkey = RSAPrivateKey
+                { rsaN = MPI n
+                , rsaE = MPI e
+                , rsaD = MPI d
+                , rsaP = MPI p
+                , rsaQ = MPI q
+                , rsaDmodP1 = MPI dmodp1
+                , rsaDmodQminus1 = MPI dmodqminus1
+                , rsaCoefficient = MPI coefficient
+                }
+    fromASN1 _ =
+        Left "fromASN1: RSAPrivateKey: unexpected format"
+
 
 readSecretPEMFile :: InputFile -> IO [SecretPEMData]
 readSecretPEMFile fname = do
@@ -1912,6 +1211,7 @@ readSecretPEMFile fname = do
         mergeDate (tm,_) (Right mb) = (tm,mb)
     return $ dta
 
+
 readSecretDNSFile :: InputFile -> IO Packet
 readSecretDNSFile fname = do
     let ctx = InputFileContext "" ""
@@ -1992,97 +1292,6 @@ socketFamily (SockAddrUnix _)   = AF_UNIX
 selectPublicKey :: (KeySpec,Maybe String) -> KeyDB -> Maybe Packet
 selectPublicKey (spec,mtag) db = selectKey0 True (spec,mtag) db
 
-isBracket :: Char -> Bool
-isBracket '<' = True
-isBracket '>' = True
-isBracket _   = False
-
-unk :: Bool -> MappedPacket -> MappedPacket
-unk isPublic = if isPublic then toPacket secretToPublic else id
-                where toPacket f mp@(MappedPacket {packet=p}) = mp {packet=(f p)}
-
-concatSort ::
-  FilePath -> ([a] -> MappedPacket) -> (b -> [a]) -> [b] -> [a]
-concatSort fname getp f = concat . sortByHint fname getp . map f
-
-flattenSub :: FilePath -> Bool -> SubKey -> [MappedPacket]
-flattenSub fname ispub (SubKey key sigs) = unk ispub key: concatSort fname head (unsig fname ispub) sigs
-
-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
-
-disjoint_fp :: [Packet] -> [[Packet]]
-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 []       = []
-    -}
-
-verifyBindings :: [Packet] -> [Packet] -> ([SignatureOver], [SignatureOver])
-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
-
-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
-
--- | Get the time stamp of a signature.
---
--- Warning: This function checks unhashed_subpackets if no timestamp occurs in
--- the hashed section.  TODO: change this?
---
-signature_time :: SignatureOver -> Word32
-signature_time ov = case (if null cs then ds else cs) of
-                                [] -> minBound
-                                xs -> maximum xs
-          where
-            ps = signatures_over ov
-            ss = filter isSignaturePacket ps
-            cs = concatMap (concatMap creationTime . hashed_subpackets) ss
-            ds = concatMap (concatMap creationTime . unhashed_subpackets) ss
-            creationTime (SignatureCreationTimePacket t) = [t]
-            creationTime _                               = []
-
-splitAtMinBy :: (t -> t -> Ordering) -> [t] -> ([t], [t])
-splitAtMinBy comp xs = minimumBy comp' xxs
- where
-    xxs = zip (inits xs) (tails xs)
-    comp' (_,as) (_,bs) = compM (listToMaybe as) (listToMaybe bs)
-    compM (Just a) (Just b) = comp a b
-    compM Nothing  mb       = GT
-    compM _        _        = LT
-
 parseCertBlob :: Bool -> ByteString -> Maybe ParsedCert
 parseCertBlob comp bs = do
     asn1 <- either (const Nothing) Just
@@ -2171,15 +1380,18 @@ extractRSAKeyFields kvs = do
         , rsaCoefficient = u }
  where
     parseField blob = MPI <$> m
+#if defined(VERSION_memory)
+     where m = bigendian <$> functorToMaybe (convertFromBase Base64 $ Char8.toStrict blob)
+    bigendian bs = snd $ S.foldl' (\(c,a) w8 -> (c-1, a + 256^c * fromIntegral w8)) (nlen-1,0) bs
+     where
+        nlen = S.length bs
+#elif defined(VERSION_dataenc)
      where m = bigendian <$> Base64.decode (Char8.unpack blob)
-
     bigendian bs = snd $ foldl' (\(c,a) w8 -> (c-1, a + 256^c * fromIntegral w8)) (nlen-1,0) bs
      where
         nlen = length bs
+#endif
 
-backsig :: SignatureSubpacket -> Maybe Packet
-backsig (EmbeddedSignaturePacket s) = Just s
-backsig _                           = Nothing
 
 selectKey0 :: Bool -> (KeySpec,Maybe String) -> KeyDB -> Maybe Packet
 selectKey0 wantPublic (spec,mtag) db = do
@@ -2190,27 +1402,7 @@ selectKey0 wantPublic (spec,mtag) db = do
           y:ys1 -> listToMaybe $ snd $ seek_key (KeyTag y tag) ys1
           []    -> Nothing
 
-sortByHint :: FilePath -> (a -> MappedPacket) -> [a] -> [a]
-sortByHint fname f = sortBy (comparing gethint)
-  where
-    gethint = maybe defnum originalNum . Map.lookup fname . locations . f
-    defnum = -1
-
-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) }
-
-smallpr :: Packet -> [Char]
-smallpr k = drop 24 $ fingerprint k
-
-isSubkeySignature :: SignatureOver -> Bool
-isSubkeySignature (SubkeySignature {}) = True
-isSubkeySignature _                    = False
-
+-- TODO: Data.ByteString.Lazy now exports this.
 toStrict :: L.ByteString -> S.ByteString
 toStrict = foldr1 (<>) . L.toChunks