1 files changed, 120 insertions, 5 deletions

diff --git a/lib/KeyRing/Types.hs b/lib/KeyRing/Types.hs
index 3c1f0a5..4a0b34e 100644
--- a/lib/KeyRing/Types.hs
+++ b/lib/KeyRing/Types.hs
@@ -3,12 +3,13 @@
 {-# LANGUAGE PatternSynonyms   #-}
 module KeyRing.Types where
 
+import           Data.Bits
 import           Data.Char (isLower,toLower)
 import           Data.Functor
-import           Data.List (groupBy,find)
+import           Data.List (groupBy,find,isInfixOf)
 import           Data.Map as Map (Map)
 import qualified Data.Map as Map
-import           Data.Maybe (maybeToList)
+import           Data.Maybe (maybeToList,isJust,fromJust,mapMaybe)
 import           Data.OpenPGP
 import           Data.OpenPGP.Util
 import           Data.Time.Clock
@@ -335,9 +336,9 @@ isSecretKey (SecretKeyPacket {}) = True
 isSecretKey _                    = False
 
 
-isUserID :: Packet -> Bool
-isUserID (UserIDPacket {}) = True
-isUserID _                 = False
+isUserID :: Packet -> Maybe String
+isUserID (UserIDPacket str) = Just str
+isUserID _                  = Nothing
 
 isTrust :: Packet -> Bool
 isTrust (TrustPacket {}) = True
@@ -408,3 +409,117 @@ data SingleKeySpec = FingerprintMatch String
                    | WorkingKeyMatch
  deriving (Show,Eq,Ord)
 
+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
+
+seek_key :: KeySpec -> [Packet] -> ([Packet],[Packet])
+seek_key (KeyGrip grip) sec = (pre, subs)
+  where
+    (pre,subs) = break pred sec
+    pred p@(SecretKeyPacket {}) = matchpr grip p == grip
+    pred p@(PublicKeyPacket {}) = matchpr grip p == grip
+    pred _                      = False
+
+seek_key (KeyTag key tag) ps
+    | null bs = (ps, [])
+    | null qs =
+      let (as', bs') = seek_key (KeyTag key tag) (tail bs) in
+        (as ++ (head bs : as'), bs')
+    | otherwise = (reverse (tail qs), head qs : reverse rs ++ bs)
+  where
+    (as,bs) = break (\p -> isSignaturePacket p
+                        && has_tag tag p
+                        && isJust (signature_issuer p)
+                        && matchpr (fromJust $ signature_issuer p) key == fromJust (signature_issuer p) )
+                    ps
+    (rs,qs) = break isKey (reverse as)
+
+    has_tag tag p = tag `elem` mapMaybe usage (hashed_subpackets p)
+                    || tag `elem` map usageString (mapMaybe keyflags (hashed_subpackets p))
+
+seek_key (KeyUidMatch pat) ps
+    | null bs = (ps, [])
+    | null qs = let (as', bs') = seek_key (KeyUidMatch pat) (tail bs) in
+                    (as ++ (head bs : as'), bs')
+    | otherwise = (reverse (tail qs), head qs : reverse rs ++ bs)
+  where
+    (as,bs) = break (isInfixOf pat . uidStr) ps
+    (rs,qs) = break isKey (reverse as)
+
+    uidStr (UserIDPacket s) = s
+    uidStr _                = ""
+
+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"
+
+usage :: SignatureSubpacket -> Maybe String
+usage (NotationDataPacket
+        { human_readable = True
+        , notation_name  = "usage@"
+        , notation_value = u
+        }) = Just u
+usage _    = 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)
+
+-- XXX keyFlags and keyflags are different functions.
+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
+