From a391d183e2f79ab942e1516e1875793cd1d5abcc Mon Sep 17 00:00:00 2001 From: joe Date: Mon, 21 Apr 2014 21:48:06 -0400 Subject: Some type signatures --- KeyRing.hs | 39 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 39 insertions(+) (limited to 'KeyRing.hs') diff --git a/KeyRing.hs b/KeyRing.hs index 229348f..e57861f 100644 --- a/KeyRing.hs +++ b/KeyRing.hs @@ -4,6 +4,8 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DoAndIfThenElse #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE KindSignatures #-} module KeyRing ( InputFile(..) , backsig @@ -112,6 +114,7 @@ import ProcessUtils (systemEnv, ExitCode(ExitFailure, ExitSuccess) ) -- DER-encoded elliptic curve ids -- nistp256_id = 0x2a8648ce3d030107 +secp256k1_id :: Integer secp256k1_id = 0x2b8104000a -- "\x2a\x86\x48\xce\x3d\x03\x01\x07" {- OID Curve description Curve name @@ -137,6 +140,7 @@ data HomeDir = , optfile_alts :: [String] } +home :: HomeDir home = HomeDir { homevar = "GNUPGHOME" , appdir = ".gnupg" @@ -171,21 +175,28 @@ data RefType = ConstRef -- Initializer is a shell command that creates -- the file; eg, ssh-keygen +isMutable :: RefType -> Bool isMutable (MutableRef {}) = True isMutable _ = False +isring :: FileType -> Bool isring (KeyRingFile {}) = True isring _ = False +pwfile :: FileType -> Maybe PassWordFile pwfile (KeyRingFile f) = f pwfile _ = Nothing +iswallet :: FileType -> Bool iswallet (WalletFile {}) = True iswallet _ = False +initializer :: RefType -> Maybe Initializer initializer (MutableRef x) = x initializer _ = Nothing +getUsage :: + forall (m :: * -> *). MonadPlus m => FileType -> m UsageTag getUsage (PEMFile usage) = return usage getUsage _ = mzero @@ -230,6 +241,8 @@ resolveInputFile secring pubring = resolve resolve _ = [] +filesToLock :: + KeyRingOperation -> FilePath -> FilePath -> [FilePath] filesToLock k secring pubring = do (f,(rtyp,ftyp)) <- Map.toList (kFiles k) case rtyp of @@ -243,6 +256,7 @@ filesToLock k secring pubring = do 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 @@ -386,12 +400,15 @@ data KikiResult a = KikiResult , kikiReport :: [ (FilePath, KikiReportAction) ] } +keyPacket :: KeyData -> Packet keyPacket (KeyData k _ _ _) = packet k -- subkeyPacket (SubKey k _ ) = packet k +subkeyMappedPacket :: SubKey -> MappedPacket subkeyMappedPacket (SubKey k _ ) = k +usage :: SignatureSubpacket -> Maybe String usage (NotationDataPacket { human_readable = True , notation_name = "usage@" @@ -441,6 +458,7 @@ makeInducerSig topk wkun uid extras echar c = [c] +keyflags :: SignatureSubpacket -> Maybe PGPKeyFlags keyflags flgs@(KeyFlagsPacket {}) = Just . toEnum $ ( bit 0x1 certify_keys @@ -474,6 +492,9 @@ data PGPKeyFlags = | SignEncrypt | VouchSignEncrypt deriving (Eq,Show,Read,Enum) + + +usageString :: PGPKeyFlags -> String usageString flgs = case flgs of Special -> "special" @@ -498,9 +519,13 @@ usageString flgs = -- matchpr computes the fingerprint of the given key truncated to -- be the same lenght as the given fingerprint for comparison. +matchpr :: String -> Packet -> String matchpr fp k = reverse $ zipWith const (reverse (fingerprint k)) fp +keyFlags :: t -> [Packet] -> [SignatureSubpacket] keyFlags wkun uids = keyFlags0 wkun (filter isSignaturePacket uids) + +keyFlags0 :: t -> [Packet] -> [SignatureSubpacket] keyFlags0 wkun uidsigs = concat [ keyflags , preferredsym @@ -559,6 +584,7 @@ keyFlags0 wkun uidsigs = concat isfeatures _ = False +matchSpec :: KeySpec -> (t, KeyData) -> Bool matchSpec (KeyGrip grip) (_,KeyData p _ _ _) | matchpr grip (packet p)==grip = True | otherwise = False @@ -588,6 +614,7 @@ data UserIDRecord = UserIDRecord { } deriving Show +parseUID :: String -> UserIDRecord parseUID str = UserIDRecord { uid_full = str, uid_realname = realname, @@ -748,6 +775,12 @@ cachedContents secring pubring fd = do let fname = resolveInputFile secring pubring inp fmap S.concat $ mapM S.readFile fname +importPEMKey :: + (MappedPacket -> IO (KikiCondition Packet)) + -> KikiCondition + (Map.Map KeyKey KeyData, [(FilePath, KikiReportAction)]) + -> ([Char], Maybe [Char], [KeyKey], t) + -> IO (KikiCondition (Map.Map KeyKey KeyData, [(FilePath, KikiReportAction)])) importPEMKey doDecrypt db' tup = do try db' $ \(db',report0) -> do r <- doImport doDecrypt @@ -937,10 +970,13 @@ buildKeyDB doDecrypt secring pubring grip0 keyring = do return $ KikiSuccess ( (db, grip, mwk, hs), reportWallets ++ reportPEMs ) +torhash :: Packet -> String torhash key = maybe "" id $ derToBase32 <$> derRSA key +derToBase32 :: ByteString -> String derToBase32 = map toLower . Base32.encode . S.unpack . SHA1.hashlazy +derRSA :: Packet -> Maybe ByteString derRSA rsa = do k <- rsaKeyFromPacket rsa return $ encodeASN1 DER (toASN1 k []) @@ -951,6 +987,7 @@ try x body = Left e -> return e Right x -> body x +readKeyFromFile :: Bool -> String -> FilePath -> IO Message readKeyFromFile False "PEM" fname = do -- warn $ fname ++ ": reading ..." -- Note: The key's timestamp is included in it's fingerprint. @@ -991,6 +1028,7 @@ readKeyFromFile False "PEM" fname = do } readKeyFromFile is_public fmt filename = error ("unimplemented key type: "++fmt) +extractPEM :: ByteString -> ByteString -> ByteString extractPEM typ pem = dta where dta = case ys of @@ -1106,6 +1144,7 @@ doImportG doDecrypt db m0 tag fname key = do , report ) Just (False,sig) -> doInsert (Just sig) db -- We have a sig, but is missing usage@ tag +isCryptoCoinKey :: Packet -> Bool isCryptoCoinKey p = and [ isKey p , key_algorithm p == ECDSA -- cgit v1.2.3