hopenpgp-tools 0.25.7 → 0.25.8
raw patch · 5 files changed
+356/−200 lines, 5 filesdep ~hOpenPGP
Dependency ranges changed: hOpenPGP
Files
- HOpenPGP/Tools/Common/Lexer.x +2/−2
- HOpenPGP/Tools/Common/Parser.y +2/−2
- HOpenPGP/Tools/Hokey/Lint/Policy.hs +2/−2
- hop.hs +347/−191
- hopenpgp-tools.cabal +3/−3
HOpenPGP/Tools/Common/Lexer.x view
@@ -68,7 +68,7 @@ [Pp]ositive[Cc]ert { lex' TokenPositiveCert } [Ss]ubkey[Bb]inding[Ss]ig { lex' TokenSubkeyBindingSig } [Pp]rimary[Kk]ey[Bb]inding[Ss]ig { lex' TokenPrimaryKeyBindingSig }- [Ss]ignature[Dd]irectly[Oo]n[Aa][Kk]ey { lex' TokenSignatureDirectlyOnAKey }+ [Dd]irect[Kk]ey[Ss]ignature { lex' TokenDirectKeySignature } [Kk]ey[Rr]evocation[Ss]ig { lex' TokenKeyRevocationSig } [Ss]ubkey[Rr]evocation[Ss]ig { lex' TokenSubkeyRevocationSig } [Cc]ert[Rr]evocation[Ss]ig { lex' TokenCertRevocationSig }@@ -134,7 +134,7 @@ | TokenPositiveCert | TokenSubkeyBindingSig | TokenPrimaryKeyBindingSig- | TokenSignatureDirectlyOnAKey+ | TokenDirectKeySignature | TokenKeyRevocationSig | TokenSubkeyRevocationSig | TokenCertRevocationSig
HOpenPGP/Tools/Common/Parser.y view
@@ -65,7 +65,7 @@ positivecert { TokenPositiveCert } subkeybindingsig { TokenSubkeyBindingSig } primarykeybindingsig { TokenPrimaryKeyBindingSig }- signaturedirectlyonakey { TokenSignatureDirectlyOnAKey }+ directkeysignature { TokenDirectKeySignature } keyrevocationsig { TokenKeyRevocationSig } subkeyrevocationsig { TokenSubkeyRevocationSig } certrevocationsig { TokenCertRevocationSig }@@ -165,7 +165,7 @@ | positivecert { fromIntegral (fromFVal PositiveCert) } | subkeybindingsig { fromIntegral (fromFVal SubkeyBindingSig) } | primarykeybindingsig { fromIntegral (fromFVal PrimaryKeyBindingSig) }- | signaturedirectlyonakey { fromIntegral (fromFVal SignatureDirectlyOnAKey) }+ | directkeysignature { fromIntegral (fromFVal DirectKeySignature) } | keyrevocationsig { fromIntegral (fromFVal KeyRevocationSig) } | subkeyrevocationsig { fromIntegral (fromFVal SubkeyRevocationSig) } | certrevocationsig { fromIntegral (fromFVal CertRevocationSig) }
HOpenPGP/Tools/Hokey/Lint/Policy.hs view
@@ -553,7 +553,7 @@ "<uat:[" ++ intercalate "," (map uaspToString us) ++ "]>" uaspToString :: UserAttrSubPacket -> String-uaspToString (ImageAttribute hdr d) =+uaspToString (ImageAttribute hdr (ImageData d)) = hdrToString hdr ++ ':' : show (BL.length d)@@ -707,7 +707,7 @@ grabReasons _ _ = [] grabReasons' :: SigSubPacketPayload -> Maybe RevocationStatus-grabReasons' (ReasonForRevocation a b) =+grabReasons' (ReasonForRevocation a (RevocationReason b)) = Just (RevocationStatus True (show a) b) grabReasons' _ = Nothing
hop.hs view
@@ -25,6 +25,7 @@ ( Armor (..) , ArmorType (..) )+import Codec.Encryption.OpenPGP.CFB (encryptNoNonce) import Codec.Encryption.OpenPGP.Compression ( CompressionError , decompressPkt@@ -52,6 +53,10 @@ ( eightOctetKeyID , fingerprint )+import Codec.Encryption.OpenPGP.KeyGeneration+ ( KeyGenSpec (..)+ , generateSecretKey+ ) import Codec.Encryption.OpenPGP.KeyInfo (pubkeySize) import Codec.Encryption.OpenPGP.Message ( EncryptMessageOptions (..)@@ -74,14 +79,24 @@ ) import Codec.Encryption.OpenPGP.S2K ( decodeOpenPGPEncodedSessionKey+ , renderS2KError , skesk2Key , skesk2SessionKey+ , string2Key ) import Codec.Encryption.OpenPGP.SecretKey- ( decryptPrivateKey+ ( SecretKeyEncryptOptions (..)+ , SecretKeyError (..)+ , decryptPrivateKey , encryptSecretKeyWithPolicy+ , mkUnencryptedSKAddendum+ , reencryptSecretKey+ , renderSecretKeyError )-import Codec.Encryption.OpenPGP.Serialize (parsePkts)+import Codec.Encryption.OpenPGP.Serialize+ ( parsePkts+ , putSKeyForPKPayload+ ) import Codec.Encryption.OpenPGP.Signatures ( SignError (..) , renderSignError@@ -112,9 +127,11 @@ import Control.Monad (forM, forM_, unless, when, (>=>)) import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.State.Lazy (StateT, evalStateT, get, modify)+import Control.Monad.Trans.Except (ExceptT, runExceptT) import Crypto.Error (eitherCryptoError)+import qualified Crypto.Hash as CH+import qualified Crypto.Hash.Algorithms as CHA import Crypto.Number.Serialize (i2ospOf_, os2ip)-import qualified Crypto.PubKey.Curve25519 as Curve25519 import qualified Crypto.PubKey.Ed25519 as Ed25519 import qualified Crypto.PubKey.Ed448 as Ed448 import qualified Crypto.PubKey.RSA as RSA@@ -1133,12 +1150,13 @@ profile <- parseKeyGenProfile keyProfile password <- parseGenerateKeyPassword keyPassword let ts = ThirtyTwoBitTimeStamp (floor pt)- keyVersion =- if isJust password && keyVersionForProfile profile == V4- then V6- else keyVersionForProfile profile- primaryKeySpec = primaryKeySpecForProfile profile- sk <- generateSecretKey ts keyVersion primaryKeySpec+ keyVersion = keyVersionForProfile profile+ sk <-+ runExceptT+ ( runSomeKeyGenSpec+ (primaryKeySpecForProfile ts keyVersion profile)+ )+ >>= either (failWith BadData) pure baseKey <- buildKeyWith sk $ do case userIds of@@ -1172,7 +1190,7 @@ signWithKey "generate-key" pkp- SignatureDirectlyOnAKey+ DirectKeySignature SHA512 hashed issuer@@ -1195,72 +1213,68 @@ type KeyBuilder = StateT (TK 'SecretTK) IO -buildKeyWith :: SecretKey -> KeyBuilder a -> IO a-buildKeyWith sk a = evalStateT a (bareTK sk)+buildKeyWith :: (SomePKPayload, SKey) -> KeyBuilder a -> IO a+buildKeyWith (pkp, ska) a =+ case secretAddendumForGeneratedKey pkp ska of+ Right add -> evalStateT a (bareKT pkp add)+ Left err ->+ failWith+ BadData+ ("generate-key: invalid secret key material: " ++ err) where- bareTK (SecretKey pkp ska) =+ bareKT pkp add = TK- { _tkPrimaryKey = KeyPktSecretPrimary pkp ska+ { _tkPrimaryKey = KeyPktSecretPrimary pkp add , _tkRevs = []+ , _tkDirectKeySigs = [] , _tkUIDs = [] , _tkUAts = [] , _tkSubs = [] } -data GeneratedKeySpec- = GeneratedRSAKey Int- | GeneratedEd25519Key- | GeneratedX25519Key- deriving (Eq)+secretAddendumForGeneratedKey+ :: SomePKPayload -> SKey -> Either String SKAddendum+secretAddendumForGeneratedKey pkp skey =+ mkUnencryptedSKAddendum pkp skey -generateSecretKey- :: ThirtyTwoBitTimeStamp- -> KeyVersion- -> GeneratedKeySpec- -> IO SecretKey-generateSecretKey ts keyVersion (GeneratedRSAKey bits) = do- (pub, priv) <- liftIO $ RSA.generate (bits `div` 8) 0x10001- return $ SecretKey (pkp pub) (ska priv)- where- pkp pub = PKPayload keyVersion ts 0 RSA (RSAPubKey (RSA_PublicKey pub))- ska priv = SUUnencrypted (RSAPrivateKey (RSA_PrivateKey priv)) 0 -- FIXME: calculate checksum-generateSecretKey ts keyVersion GeneratedEd25519Key = do- priv <- Ed25519.generateSecretKey- let pub = Ed25519.toPublic priv- pubBytes = BA.convert pub :: B.ByteString- privBytes = BA.convert priv :: B.ByteString- pure $- SecretKey- ( PKPayload- keyVersion- ts- 0- (toFVal 27)- ( EdDSAPubKey- EdSigningCurve25519- (NativeEPoint (EPoint (os2ip pubBytes)))- )- )- (SUUnencrypted (EdDSAPrivateKey EdSigningCurve25519 privBytes) 0)-generateSecretKey ts keyVersion GeneratedX25519Key = do- priv <- Curve25519.generateSecretKey- let pub = Curve25519.toPublic priv- pubBytes = BA.convert pub :: B.ByteString- privBytes = BA.convert priv :: B.ByteString+data SomeKeyGenSpec where+ SomeKeyGenSpec :: KeyGenSpec v -> SomeKeyGenSpec++runSomeKeyGenSpec+ :: MonadRandom m+ => SomeKeyGenSpec+ -> ExceptT String m (SomePKPayload, SKey)+runSomeKeyGenSpec (SomeKeyGenSpec spec) = generateSecretKey spec++modifyTKSecretKeysM+ :: Monad m+ => TK 'SecretTK+ -> (SomePKPayload -> SKAddendum -> m SKAddendum)+ -> m (TK 'SecretTK)+modifyTKSecretKeysM tk cb = do+ let keys = tkSecretKeyPairs tk+ newSkas <- mapM (uncurry cb) keys+ let index = zip (map fst keys) newSkas pure $- SecretKey- ( PKPayload- keyVersion- ts- 0- X25519- ( EdDSAPubKey- EdSigningCurve25519- (NativeEPoint (EPoint (os2ip pubBytes)))- )- )- (SUUnencrypted (X25519PrivateKey privBytes) 0)+ modifyTKSecretKeys tk $+ \pkp ska -> (pkp, fromMaybe ska (lookup pkp index)) +modifyTKSecretKeysE+ :: TK 'SecretTK+ -> (SomePKPayload -> SKAddendum -> IO (Either String SKAddendum))+ -> IO (Either String (TK 'SecretTK))+modifyTKSecretKeysE tk cb = do+ let keys = tkSecretKeyPairs tk+ result <- mapM (uncurry cb) keys+ case sequence result of+ Left err -> pure (Left err)+ Right skas ->+ let index = zip (map fst keys) skas+ in pure $+ Right $+ modifyTKSecretKeys tk $+ \pkp ska -> (pkp, fromMaybe ska (lookup pkp index))+ data KeyGenProfile = KeyGenRFC4880 | KeyGenSecurity@@ -1302,9 +1316,18 @@ keyVersionForProfile KeyGenSecurity = V6 keyVersionForProfile KeyGenSigningOnly = V6 -primaryKeySpecForProfile :: KeyGenProfile -> GeneratedKeySpec-primaryKeySpecForProfile KeyGenRFC4880 = GeneratedRSAKey 4096-primaryKeySpecForProfile _ = GeneratedEd25519Key+primaryKeySpecForProfile+ :: ThirtyTwoBitTimeStamp+ -> KeyVersion+ -> KeyGenProfile+ -> SomeKeyGenSpec+primaryKeySpecForProfile ts version KeyGenRFC4880 =+ case version of+ V4 -> SomeKeyGenSpec (KeyGenRSA ts 4096 :: KeyGenSpec V4)+ V6 -> SomeKeyGenSpec (KeyGenRSA ts 4096 :: KeyGenSpec V6)+ DeprecatedV3 -> error "primaryKeySpecForProfile: V3 unsupported"+primaryKeySpecForProfile ts _ _ =+ SomeKeyGenSpec (KeyGenEd25519 ts) parseGenerateKeyPassword :: Maybe String -> IO (Maybe BL.ByteString)@@ -1485,60 +1508,189 @@ addSubkey ts keyVersion _profile [AuthKey] subkeySpecForProfile- :: KeyGenProfile -> [KeyFlag] -> GeneratedKeySpec-subkeySpecForProfile KeyGenRFC4880 _ = GeneratedRSAKey 4096-subkeySpecForProfile _ keyflags+ :: ThirtyTwoBitTimeStamp+ -> KeyVersion+ -> KeyGenProfile+ -> [KeyFlag]+ -> SomeKeyGenSpec+subkeySpecForProfile ts version KeyGenRFC4880 _ =+ case version of+ V4 -> SomeKeyGenSpec (KeyGenRSA ts 4096 :: KeyGenSpec V4)+ V6 -> SomeKeyGenSpec (KeyGenRSA ts 4096 :: KeyGenSpec V6)+ DeprecatedV3 -> error "subkeySpecForProfile: V3 unsupported"+subkeySpecForProfile ts _ _ keyflags | any (`elem` keyflags) [EncryptStorageKey, EncryptCommunicationsKey] =- GeneratedX25519Key- | otherwise = GeneratedEd25519Key+ SomeKeyGenSpec (KeyGenX25519 ts)+ | otherwise =+ SomeKeyGenSpec (KeyGenEd25519 ts) +encryptUnencryptedV4SecretKey+ :: SomePKPayload+ -> SKey+ -> BL.ByteString+ -> IO (Either String SKAddendum)+encryptUnencryptedV4SecretKey pkp skey passphrase = do+ saltBytes <- getRandomBytes 8+ ivBytes <- getRandomBytes 16+ let sa = AES256+ keyLen = 32+ s2k = IteratedSalted SHA256 (Salt8 saltBytes) 65536+ iv = IV ivBytes+ pure $+ case string2Key s2k keyLen passphrase of+ Left err -> Left (renderS2KError err)+ Right keyMaterial ->+ case putSKeyForPKPayload pkp skey of+ Left err -> Left err+ Right putAction ->+ let cleartext = runPut putAction+ sha1Checksum =+ BA.convert+ (CH.hash (BL.toStrict cleartext) :: CH.Digest CHA.SHA1)+ clearWithChecksum =+ BL.toStrict (cleartext <> BL.fromStrict sha1Checksum)+ in case encryptNoNonce sa s2k iv clearWithChecksum keyMaterial of+ Left err -> Left (show err)+ Right encrypted ->+ Right (SUSSHA1 sa s2k iv (BL.fromStrict encrypted))+ encryptTransferableSecretKey :: BL.ByteString -> SomeTK -> IO SomeTK encryptTransferableSecretKey password stk = case stk of SomePublicTK _ -> pure stk- SomeSecretTK tk ->- case _tkPrimaryKey tk of- KeyPktSecretPrimary pkp ska -> do- encrypted <- encryptSecretAddendumForOutput pkp ska- subs' <- mapM encryptSub (_tkSubs tk)- pure $- SomeSecretTK- tk- { _tkPrimaryKey = KeyPktSecretPrimary pkp encrypted- , _tkSubs = subs'- }- _ -> pure stk+ SomeSecretTK tk -> do+ tk' <-+ modifyTKSecretKeysM tk (encryptSecretAddendumForOutput password)+ pure $ SomeSecretTK tk' where- encryptSub- :: (MonadIO m, MonadRandom m) => (KeyPkt k, b) -> m (KeyPkt k, b)- encryptSub (KeyPktSecretSubkey pkp ska, sigs) = do- encrypted <- liftIO $ encryptSecretAddendumForOutput pkp ska- pure (KeyPktSecretSubkey pkp encrypted, sigs)- encryptSub other = pure other- encryptSecretAddendumForOutput pkp ska =+ encryptSecretAddendumForOutput+ :: BL.ByteString -> SomePKPayload -> SKAddendum -> IO SKAddendum+ encryptSecretAddendumForOutput password pkp ska = case ska of- SUUnencrypted skey _ -> doEncryptSecret skey- _ -> pure ska- where- doEncryptSecret skey = do- encryptedResult <-+ SUUnencrypted skey _+ | _keyVersion pkp == V4 -> do+ result <- encryptUnencryptedV4SecretKey pkp skey password+ case result of+ Left err ->+ failWith+ BadData+ ( "generate-key: failed to protect V4 secret key material: "+ ++ err+ )+ Right val -> pure val+ SUUnencrypted skey _ -> encryptSecretKeyWithPolicy defaultPolicy pkp skey (Passphrase password)- case encryptedResult of- Left err ->- failWith- BadData- ( "generate-key: failed to protect secret key material: "- ++ show err+ >>= \result -> case result of+ Left err ->+ failWith+ BadData+ ( "generate-key: failed to protect secret key material: "+ ++ show err+ )+ Right val -> pure val+ _ -> pure ska++changeTKPassword+ :: [BL.ByteString]+ -> Maybe BL.ByteString+ -> SomeTK+ -> IO (Either String SomeTK)+changeTKPassword oldPasswords mNewPassword stk =+ case stk of+ SomePublicTK _ -> pure $ Right stk+ SomeSecretTK tk -> do+ result <-+ modifyTKSecretKeysE+ tk+ (changeSKAddendum oldPasswords mNewPassword)+ case result of+ Left err -> pure $ Left err+ Right tk' -> pure $ Right $ SomeSecretTK tk'+ where+ changeSKAddendum+ :: [BL.ByteString]+ -> Maybe BL.ByteString+ -> SomePKPayload+ -> SKAddendum+ -> IO (Either String SKAddendum)+ changeSKAddendum oldPasswords mNewPassword pkp ska =+ case ska of+ SUUnencrypted skey _ ->+ case _keyVersion pkp of+ V4 ->+ case mNewPassword of+ Just newPassword -> do+ result <- encryptUnencryptedV4SecretKey pkp skey newPassword+ case result of+ Right newSka -> pure $ Right newSka+ Left err -> pure $ Left err+ Nothing -> pure $ Right ska+ _ ->+ case mNewPassword of+ Just newPassword -> do+ encryptedResult <-+ encryptSecretKeyWithPolicy+ defaultPolicy+ pkp+ skey+ (Passphrase newPassword)+ case encryptedResult of+ Right newSka -> pure $ Right newSka+ Left err -> pure $ Left (renderSecretKeyError err)+ Nothing -> pure $ Right ska+ _ ->+ case mNewPassword of+ Just newPassword ->+ tryReencrypt oldPasswords newPassword pkp ska+ Nothing ->+ tryDecrypt oldPasswords pkp ska++ tryReencrypt [] _ _ _ = pure $ Left "no usable password for encrypted key material"+ tryReencrypt (old : rest) newPassword pkp ska = do+ if _keyVersion pkp == V4+ then do+ case decryptPrivateKey (pkp, ska) old of+ Left _ -> tryReencrypt rest newPassword pkp ska+ Right (SUUnencrypted skey _) -> do+ result <- encryptUnencryptedV4SecretKey pkp skey newPassword+ case result of+ Right newSka -> pure $ Right newSka+ Left _ -> tryReencrypt rest newPassword pkp ska+ Right _ -> tryReencrypt rest newPassword pkp ska+ else do+ result <-+ reencryptSecretKey+ ( SecretKey+ { _secretKeyPKPayload = pkp+ , _secretKeySKAddendum = ska+ } )- Right val -> pure val+ (Passphrase old)+ (Passphrase newPassword)+ SecretKeyEncryptOptions+ { skeoPolicy = defaultPolicy+ , skeoGenerateSaltAndIV = True+ , skeoSalt = Nothing+ , skeoIV = Nothing+ }+ case result of+ Right (SecretKey {_secretKeySKAddendum = newSka}) ->+ pure $ Right newSka+ Left _ -> tryReencrypt rest newPassword pkp ska + tryDecrypt [] _ _ = pure $ Left "no usable password for encrypted key material"+ tryDecrypt (old : rest) pkp ska =+ case decryptPrivateKey (pkp, ska) old of+ Right decrypted -> pure $ Right decrypted+ Left _ -> tryDecrypt rest pkp ska+ rsaSigningKey :: SKAddendum -> IO RSA.PrivateKey rsaSigningKey (SUUnencrypted (RSAPrivateKey (RSA_PrivateKey k)) _) = pure (k {RSA.private_p = 0, RSA.private_q = 0})@@ -1614,12 +1766,20 @@ -> KeyBuilder () addSubkey ts keyVersion profile keyflags = do tk <- get- (SecretKey subpkp subska) <-+ (subpkp, subska) <- liftIO $- generateSecretKey- ts- keyVersion- (subkeySpecForProfile profile keyflags)+ runExceptT+ ( runSomeKeyGenSpec+ (subkeySpecForProfile ts keyVersion profile keyflags)+ )+ >>= either (failWith BadData) pure+ subska <-+ case secretAddendumForGeneratedKey subpkp subska of+ Right add -> pure add+ Left err ->+ failWith+ BadData+ ("generate-key: invalid subkey material: " ++ err) let pkp = keyPktPKPayload (_tkPrimaryKey tk) ska :: SKAddendum ska = case _tkPrimaryKey tk of@@ -1681,7 +1841,7 @@ putKeyForSigning :: SomePKPayload -> Bin.Put putKeyForSigning pkp@(PKPayload V6 _ _ _ _) = do- putWord8 0x9A+ putWord8 0x9B let bs = runPut (Bin.put pkp) putWord32be (fromIntegral (BL.length bs)) putLazyByteString bs@@ -1781,24 +1941,18 @@ let oldPasswords = concatMap passwordRetryCandidates oldPasswordsRaw newPassword <- parseChangeKeyPasswordNewPassword changeKeyPasswordNewPassword- unlockedTks <-- mapM- ( unlockTransferableSecretKeyMaterial- "change-key-password"- "standard input"- "--old-key-password"- oldPasswords- )- tks- rewrittenTks <-- case newPassword of- Just password -> mapM (encryptTransferableSecretKey password) unlockedTks- Nothing -> pure unlockedTks- let output = runPut (mapM_ (Bin.put . someTKToUnknown) rewrittenTks)- BL.putStr $- if changeKeyPasswordNoArmor || BL.null output- then output- else AA.encodeLazy [Armor ArmorPrivateKeyBlock [] output]+ changed <- mapM (changeTKPassword oldPasswords newPassword) tks+ case sequence changed of+ Left err ->+ failWith+ BadData+ err+ Right rewrittenTks ->+ let output = runPut (mapM_ (Bin.put . someTKToUnknown) rewrittenTks)+ in BL.putStr $+ if changeKeyPasswordNoArmor || BL.null output+ then output+ else AA.encodeLazy [Armor ArmorPrivateKeyBlock [] output] parseChangeKeyPasswordNewPassword :: Maybe String -> IO (Maybe BL.ByteString)@@ -2545,43 +2699,15 @@ -> [BL.ByteString] -> SomeTK -> IO SomeTK--- Upstream could expose a TK-wide secret-key rewrite helper so SOP--- subcommands do not need to walk primary and subkey packets separately.-unlockTransferableSecretKeyMaterial context path passwordOption keyPasswords stk = do+unlockTransferableSecretKeyMaterial context path passwordOption keyPasswords stk = case stk of SomePublicTK _ -> pure stk SomeSecretTK tk -> do- let pkp = keyPktPKPayload (_tkPrimaryKey tk)- ska' <-- unlockSecretAddendum- context- path- passwordOption- keyPasswords- pkp- ( case _tkPrimaryKey tk of- KeyPktSecretPrimary _ ska -> ska- _ ->- error- "unlockTransferableSecretKeyMaterial: expected secret primary key"- )- let primaryKey = KeyPktSecretPrimary pkp ska'- subs' <- mapM decryptSub (_tkSubs tk)- pure $- SomeSecretTK tk {_tkPrimaryKey = primaryKey, _tkSubs = subs'}- where- decryptSub :: MonadIO m => (KeyPkt k, b) -> m (KeyPkt k, b)- decryptSub (KeyPktSecretSubkey pkp ska, sigs) = do- ska' <-- unlockSecretAddendum- context- path- passwordOption- keyPasswords- pkp- ska- pure (KeyPktSecretSubkey pkp ska', sigs)- decryptSub other = pure other+ tk' <-+ modifyTKSecretKeysM+ tk+ (unlockSecretAddendum context path passwordOption keyPasswords)+ pure $ SomeSecretTK tk' unlockSecretAddendum :: MonadIO m@@ -2698,6 +2824,8 @@ && case fmska k of Just (SUUnencrypted (RSAPrivateKey (RSA_PrivateKey _)) _) -> True Just (SUUnencrypted (EdDSAPrivateKey _ _) _) -> True+ Just (SUUnencrypted (Ed25519PrivateKey _) _) -> True+ Just (SUUnencrypted (Ed448PrivateKey _) _) -> True Just (SUUnencrypted (UnknownSKey _) _) -> isEd25519PKA (_pkalgo (fpkp k)) || isEdDSAPKA (_pkalgo (fpkp k))@@ -2738,34 +2866,30 @@ (k {RSA.private_p = 0, RSA.private_q = 0}) Just (SUUnencrypted (EdDSAPrivateKey EdSigningCurve25519 rawBytes) _) ->- case eitherCryptoError (Ed25519.secretKey rawBytes) of- Left err ->- failWith- BadData- (ctx ++ " failed: bad Ed25519 secret key: " ++ show err)- Right sk- | _keyVersion signerPKP == V6 -> signEd25519 sk- | isEdDSAPKA (_pkalgo signerPKP) ->- case signDataWithEd25519Legacy st sk hsd usd payload of- Left err' -> failWith BadData (ctx ++ " failed: " ++ renderSignError err')- Right sig -> pure sig- | otherwise ->- case signDataWithEd25519 st sk hsd usd payload of- Left err' -> failWith BadData (ctx ++ " failed: " ++ renderSignError err')- Right sig -> pure sig+ signWithEd25519SecretKey+ ctx+ signerPKP+ st+ hsd+ usd+ payload+ rawBytes Just+ (SUUnencrypted (Ed25519PrivateKey rawBytes) _) ->+ signWithEd25519SecretKey+ ctx+ signerPKP+ st+ hsd+ usd+ payload+ rawBytes+ Just (SUUnencrypted (EdDSAPrivateKey EdSigningCurve448 rawBytes) _) ->- case eitherCryptoError (Ed448.secretKey rawBytes) of- Left err ->- failWith- BadData- (ctx ++ " failed: bad Ed448 secret key: " ++ show err)- Right sk- | _keyVersion signerPKP == V6 -> signEd448 sk- | otherwise ->- case signDataWithEd448 st sk hsd usd payload of- Left err' -> failWith BadData (ctx ++ " failed: " ++ renderSignError err')- Right sig -> pure sig+ signWithEd448SecretKey ctx signerPKP st hsd usd payload rawBytes+ Just+ (SUUnencrypted (Ed448PrivateKey rawBytes) _) ->+ signWithEd448SecretKey ctx signerPKP st hsd usd payload rawBytes Just (SUUnencrypted (UnknownSKey rawBytes) _) -> case () of _@@ -2853,6 +2977,35 @@ Left err -> failWith BadData (ctx ++ " failed: " ++ renderSignError err) Right sig -> pure sig + signWithEd25519SecretKey ctx signerPKP st hsd usd payload rawBytes =+ case eitherCryptoError (Ed25519.secretKey rawBytes) of+ Left err ->+ failWith+ BadData+ (ctx ++ " failed: bad Ed25519 secret key: " ++ show err)+ Right sk+ | _keyVersion signerPKP == V6 -> signEd25519 sk+ | isEdDSAPKA (_pkalgo signerPKP) ->+ case signDataWithEd25519Legacy st sk hsd usd payload of+ Left err' -> failWith BadData (ctx ++ " failed: " ++ renderSignError err')+ Right sig -> pure sig+ | otherwise ->+ case signDataWithEd25519 st sk hsd usd payload of+ Left err' -> failWith BadData (ctx ++ " failed: " ++ renderSignError err')+ Right sig -> pure sig+ signWithEd448SecretKey ctx signerPKP st hsd usd payload rawBytes =+ case eitherCryptoError (Ed448.secretKey rawBytes) of+ Left err ->+ failWith+ BadData+ (ctx ++ " failed: bad Ed448 secret key: " ++ show err)+ Right sk+ | _keyVersion signerPKP == V6 -> signEd448 sk+ | otherwise ->+ case signDataWithEd448 st sk hsd usd payload of+ Left err' -> failWith BadData (ctx ++ " failed: " ++ renderSignError err')+ Right sig -> pure sig+ normalizeUnknownSecretForEdDSA :: String -> Int -> BL.ByteString -> IO B.ByteString normalizeUnknownSecretForEdDSA ctx expectedLen rawLbs@@ -3042,6 +3195,7 @@ TK { _tkPrimaryKey = KeyPktSecretPrimary pkp ska , _tkRevs = []+ , _tkDirectKeySigs = [] , _tkUIDs = [] , _tkUAts = [] , _tkSubs = []@@ -3250,7 +3404,7 @@ verifyWithLiteralData format payload sigs keyring upperBound = runConduitRes $ CC.yieldMany- (V.cons (LiteralDataPkt format mempty 0 payload) sigs)+ (V.cons (LiteralDataPkt format (FileName mempty) 0 payload) sigs) .| conduitVerify keyring upperBound .| CC.sinkList @@ -3496,7 +3650,7 @@ ( True , LiteralDataPkt TextData- BL.empty+ (FileName B.empty) 0 (BL.fromStrict (BLC8.toStrict cleartext)) : sigPkts@@ -5721,7 +5875,7 @@ Bin.put ( Block ( map SignaturePkt sigs- ++ [LiteralDataPkt literalDataType BL.empty 0 payloadRaw]+ ++ [LiteralDataPkt literalDataType (FileName B.empty) 0 payloadRaw] ) ) BL.putStr $@@ -5742,6 +5896,8 @@ && case fmska k of Just (SUUnencrypted (RSAPrivateKey (RSA_PrivateKey _)) _) -> True Just (SUUnencrypted (EdDSAPrivateKey _ _) _) -> True+ Just (SUUnencrypted (Ed25519PrivateKey _) _) -> True+ Just (SUUnencrypted (Ed448PrivateKey _) _) -> True Just (SUUnencrypted (UnknownSKey _) _) -> isEd25519PKA (_pkalgo (fpkp k)) || isEdDSAPKA (_pkalgo (fpkp k))
hopenpgp-tools.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: hopenpgp-tools-version: 0.25.7+version: 0.25.8 synopsis: hOpenPGP-based command-line tools description: command-line tools for performing some OpenPGP-related operations homepage: https://salsa.debian.org/clint/hOpenPGP-tools@@ -25,7 +25,7 @@ , bytestring , conduit >= 1.3 , errors- , hOpenPGP >= 3.3 && < 3.4+ , hOpenPGP >= 3.4 && < 3.5 , lens , optparse-applicative >= 0.18.1 , prettyprinter >= 1.7@@ -132,4 +132,4 @@ source-repository this type: git location: https://salsa.debian.org/clint/hopenpgp-tools.git- tag: hopenpgp-tools/0.25.7+ tag: hopenpgp-tools/0.25.8