hopenpgp-tools 0.25.13 → 0.26
raw patch · 6 files changed
+64/−66 lines, 6 filesdep ~hOpenPGP
Dependency ranges changed: hOpenPGP
Files
- HOpenPGP/Tools/Common/HKP.hs +1/−2
- HOpenPGP/Tools/Common/WKD.hs +16/−3
- HOpenPGP/Tools/Hokey/Canonicalize.hs +3/−2
- hkt.hs +5/−5
- hop.hs +36/−51
- hopenpgp-tools.cabal +3/−3
HOpenPGP/Tools/Common/HKP.hs view
@@ -38,7 +38,6 @@ , TK (..) , keyPktPKPayload , someTKToPublicViewTK- , someTKToUnknown ) import Control.Arrow ((&&&)) import Control.Lens ((^..))@@ -147,4 +146,4 @@ . runPut . put . Block- $ map someTKToUnknown stks+ $ stks
HOpenPGP/Tools/Common/WKD.hs view
@@ -210,16 +210,29 @@ zbase32 = BC8.pack . encodeZBase32 . B.unpack encodeZBase32 :: [Word8] -> String-encodeZBase32 = go 0 0+encodeZBase32 = go (0 :: Integer) (0 :: Int) where alphabet = "ybndrfg8ejkmcpqxot1uwisza345h769" pick i = alphabet !! i+ go :: Integer -> Int -> [Word8] -> String go _ 0 [] = [] go acc bits [] =- [pick (fromIntegral (((acc `shiftL` (5 - bits)) .&. 31) :: Int))]+ if bits >= 5+ then+ pick+ (fromIntegral (((acc `shiftR` (bits - 5)) .&. 31) :: Integer))+ : go acc (bits - 5) []+ else+ if bits > 0+ then+ [ pick+ (fromIntegral (((acc `shiftL` (5 - bits)) .&. 31) :: Integer))+ ]+ else [] go acc bits (x : xs) | bits >= 5 =- pick (fromIntegral (((acc `shiftR` (bits - 5)) .&. 31) :: Int))+ pick+ (fromIntegral (((acc `shiftR` (bits - 5)) .&. 31) :: Integer)) : go acc (bits - 5) (x : xs) | otherwise = go ((acc `shiftL` 8) .|. fromIntegral x) (bits + 8) xs
HOpenPGP/Tools/Hokey/Canonicalize.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE FlexibleContexts #-}+ -- Canonicalize.hs: hOpenPGP key tool canonicalize subcommand -- Copyright © 2013-2026 Clint Adams --@@ -23,7 +25,6 @@ import Codec.Encryption.OpenPGP.Serialize () import Codec.Encryption.OpenPGP.Types ( SomeTK (..)- , someTKToUnknown , _tkRevs , _tkSubs , _tkUAts@@ -53,13 +54,13 @@ .| conduitToSomeTKsDroppingEither .| conduitDropErrorsAndNothings .| CL.map canonicalize- .| CL.map someTKToUnknown .| CL.map put .| conduitPut .| CB.sinkHandle stdout where canonicalize (SomePublicTK tk) = SomePublicTK (canonicalizeTK tk) canonicalize (SomeSecretTK tk) = SomeSecretTK (canonicalizeTK tk)+ canonicalize (SomeMixedTK tk) = SomeMixedTK (canonicalizeTK tk) canonicalizeTK tk = tk { _tkRevs = sort (_tkRevs tk)
hkt.hs view
@@ -49,10 +49,10 @@ , TK (..) , UserAttribute (..) , UserId (..)+ , asMixedTK , keyPktPKPayload , keyPktToPkt , someTKToPublicViewTK- , someTKToUnknown , _pkalgo , _pubkey )@@ -529,8 +529,8 @@ grabMatchingKeys (keyring o) (targetIsFilter o) (ttarget1 o) case pathsOutputFormat o of Unstructured -> mapM_ (BL.putStr . putTK') keys- JSON -> BL.putStr . A.encode $ map someTKToUnknown keys- YAML -> B.putStr . Y.encode $ map someTKToUnknown keys+ JSON -> BL.putStr . A.encode $ keys+ YAML -> B.putStr . Y.encode $ keys where putTK' tk = runPut $ do@@ -604,7 +604,7 @@ fp = fingerprint (keyPktPKPayload (_tkPrimaryKey publicView)) keyids = rights . map eightOctetKeyID $- (someTKToUnknown stk ^.. biplate :: [SomePKPayload])+ (asMixedTK stk ^.. biplate :: [SomePKPayload]) i' = i + 1 k2f' = foldr (\k m -> HashMap.insert k fp m) k2f keyids f2i' = HashMap.insert fp i' f2i@@ -645,7 +645,7 @@ ("hkt: no graph node for fingerprint " ++ renderFingerprint fp) fakejoin (x, y) = fmap ((,) x) y sigs tk =- someTKToUnknown tk ^.. biplate :: [SignaturePayload]+ asMixedTK tk ^.. biplate :: [SignaturePayload] samesies (x, y, _) = x == y data PaF
hop.hs view
@@ -260,7 +260,7 @@ , SignaturePayload (SigV3, SigV4, SigV6, SigVOther) , SignatureSalt (..) , SomePKPayload (..)- , SomeTK (SomePublicTK, SomeSecretTK)+ , SomeTK (SomeMixedTK, SomePublicTK, SomeSecretTK) , SymmetricAlgorithm ( AES128 , AES192@@ -279,9 +279,8 @@ , UserAttribute (..) , UserId (..) , Verification (..)+ , asMixedTK , fromFVal- , fromUnknownToTK- , fromUnknownToTKEither , keyPktPKPayload , keyPktToPkt , modifyTKSecretKeys@@ -295,7 +294,6 @@ , renderSignError , someTKToPublicViewTK , someTKToSecretTK- , someTKToUnknown , tkSecretKeyPairs , toFVal , _keyVersion@@ -377,6 +375,7 @@ ( conduitVerify , verifyPacketsBatch )+import Data.Containers.ListUtils (nubOrd) import Data.Data.Lens (biplate) import Data.Either (fromRight, isLeft, isRight, rights) import Data.IORef (IORef, atomicModifyIORef', newIORef)@@ -1449,7 +1448,7 @@ encryptTransferableSecretKey password tk- let lbs = runPut $ Bin.put (someTKToUnknown (SomeSecretTK tk'))+ let lbs = runPut $ Bin.put (SomeSecretTK tk') BL.putStr $ if not noArmor then AA.encodeLazy [Armor ArmorPrivateKeyBlock [] lbs]@@ -1485,18 +1484,17 @@ \pkp ska -> (pkp, fromMaybe ska (lookup pkp index)) data KeyGenProfile- = KeyGenRFC4880- | KeyGenSecurity- | KeyGenSigningOnly+ = KeyGenRFC9580+ | KeyGenRFC4880 deriving (Eq) keyGenProfiles :: [Profile KeyGenProfile] keyGenProfiles = [ Profile- "security"+ "rfc9580" "Ed25519 signing key, X25519 encryption subkey"- KeyGenSecurity- ["default", "performance", "rfc9580"]+ KeyGenRFC9580+ ["default", "performance", "security"] , Profile "rfc4880" "RSA-4096 (v4 keys)"@@ -1515,7 +1513,7 @@ not (null name) && not (any isSpace name) parseKeyGenProfile :: Maybe String -> IO KeyGenProfile-parseKeyGenProfile Nothing = pure KeyGenSecurity+parseKeyGenProfile Nothing = pure KeyGenRFC9580 parseKeyGenProfile (Just name) = if not (validProfileName name) then@@ -1531,8 +1529,7 @@ keyVersionForProfile :: KeyGenProfile -> KeyVersion keyVersionForProfile KeyGenRFC4880 = V4-keyVersionForProfile KeyGenSecurity = V6-keyVersionForProfile KeyGenSigningOnly = V6+keyVersionForProfile KeyGenRFC9580 = V6 parseGenerateKeyPassword :: Maybe String -> IO (Maybe Passphrase)@@ -1720,7 +1717,7 @@ passwordRetryCandidates :: B.ByteString -> [B.ByteString] passwordRetryCandidates passwordBytes =- case TE.decodeUtf8' passwordBytes of+ nubOrd $ case TE.decodeUtf8' passwordBytes of Left _ -> [passwordBytes] Right txt -> let trimmed = TE.encodeUtf8 (T.dropWhileEnd isSpace txt)@@ -1738,16 +1735,13 @@ _ <- addSubkey RSA [EncryptStorageKey, EncryptCommunicationsKey] _ <- addSubkey RSA [AuthKey] pure ()-addSubkeysForProfile KeyGenSecurity signingOnly = do+addSubkeysForProfile KeyGenRFC9580 signingOnly = do _ <- addSubkey Ed25519 [SignDataKey] unless signingOnly $ do _ <- addSubkey X25519 [EncryptStorageKey, EncryptCommunicationsKey] _ <- addSubkey Ed25519 [AuthKey] pure ()-addSubkeysForProfile KeyGenSigningOnly _ = do- _ <- addSubkey Ed25519 [SignDataKey]- pure () encryptUnencryptedV4SecretKey :: SomePKPayload@@ -1956,7 +1950,7 @@ failWith MissingInput "extract-cert: no transferable secret key found on standard input"- let output = runPut $ mapM_ (Bin.put . someTKToUnknown . pubToSecret) tks+ let output = runPut $ mapM_ (Bin.put . pubToSecret) tks BL.putStr $ if not ecNoArmor then AA.encodeLazy [Armor ArmorPublicKeyBlock [] output]@@ -2009,7 +2003,7 @@ KeyIsProtected err Right rewrittenTks ->- let output = runPut (mapM_ (Bin.put . someTKToUnknown) rewrittenTks)+ let output = runPut (mapM_ Bin.put rewrittenTks) in BL.putStr $ if changeKeyPasswordNoArmor || BL.null output then output@@ -2216,7 +2210,7 @@ signerTks ) targetTks- let output = runPut (mapM_ (Bin.put . someTKToUnknown) updatedTargets)+ let output = runPut (mapM_ Bin.put updatedTargets) BL.putStr $ if certifyUserIdNoArmor then output@@ -2501,7 +2495,7 @@ ) secretKeyTks revocationSigPkts- output = runPut (mapM_ (Bin.put . someTKToUnknown) mergedCerts)+ output = runPut (mapM_ Bin.put mergedCerts) BL.putStr $ if revokeKeyNoArmor then output@@ -2582,22 +2576,19 @@ let mergedTks = map ( \targetTk ->- let mergedTkUnknown =+ let merged = foldl' (<>)- (someTKToUnknown (SomeSecretTK targetTk))- ( map- someTKToUnknown- ( selectUpdateMergeInputs- cpt- updateKeyNoAddedCapabilities- (SomeSecretTK targetTk)- updateTks- )+ (SomeSecretTK targetTk)+ ( selectUpdateMergeInputs+ cpt+ updateKeyNoAddedCapabilities+ (SomeSecretTK targetTk)+ updateTks )- in case fromUnknownToTKEither mergedTkUnknown of- Right mergedStk -> mergedStk- Left _ -> SomeSecretTK targetTk+ in case merged of+ SomeSecretTK mergedStk -> SomeSecretTK mergedStk+ _ -> SomeSecretTK targetTk ) stdinUnlocked strippedTks =@@ -2623,7 +2614,7 @@ if any hasSecretKeyMaterial modernizedTks then ArmorPrivateKeyBlock else ArmorPublicKeyBlock- output = runPut (mapM_ (Bin.put . someTKToUnknown) modernizedTks)+ output = runPut (mapM_ Bin.put modernizedTks) BL.putStr $ if updateKeyNoArmor then output@@ -2647,7 +2638,7 @@ (\p -> loadCertTKsFromFile "merge-certs" p) mergeCertsFiles let mergedTks = mergeCertificatesForOutput stdinTks mergeInTks- output = runPut (mapM_ (Bin.put . someTKToUnknown) mergedTks)+ output = runPut (mapM_ Bin.put mergedTks) BL.putStr $ if mergeCertsNoArmor || BL.null output then output@@ -2663,21 +2654,15 @@ mergeGroup (base, rest) = let primary = certificatePrimaryFingerprint base mergedStdin =- case fromUnknownToTKEither- (foldl' (<>) (someTKToUnknown base) (map someTKToUnknown rest)) of- Right mergedStk -> mergedStk- Left _ -> base+ case foldl' (<>) base rest of+ SomeMixedTK _ -> base+ x -> x matchingMergeInputs = filter ((== primary) . certificatePrimaryFingerprint) mergeInTks mergedAll =- case fromUnknownToTKEither- ( foldl'- (<>)- (someTKToUnknown mergedStdin)- (map someTKToUnknown matchingMergeInputs)- ) of- Right mergedStk -> mergedStk- Left _ -> mergedStdin+ case foldl' (<>) mergedStdin matchingMergeInputs of+ SomeMixedTK _ -> mergedStdin+ x -> x in mergedAll groupByPrimaryKey :: [SomeTK] -> [(SomeTK, [SomeTK])]@@ -7038,7 +7023,7 @@ tkToEncryptPayloads stk = filter supportsRecipientPKESKAlgorithm- (someTKToUnknown stk ^.. biplate :: [SomePKPayload])+ (asMixedTK stk ^.. biplate :: [SomePKPayload]) extractEncryptRecipientPayload :: Pkt -> Maybe SomePKPayload extractEncryptRecipientPayload pkt =
hopenpgp-tools.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: hopenpgp-tools-version: 0.25.13+version: 0.26 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.6.3 && < 3.7+ , hOpenPGP >= 3.7 && < 3.8 , 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.13+ tag: hopenpgp-tools/0.26