diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown --- a/CHANGELOG.markdown +++ b/CHANGELOG.markdown @@ -1,5 +1,27 @@ # Changelog +## 0.6.3.0 + +### New Features + +- feat: add importKeyFromBytes function: https://github.com/rethab/h-gpgme/pull/66 +- feat: add exportKey, exportSecretKey and exportKeys functions: https://github.com/rethab/h-gpgme/pull/70 +- feat: support gpgme 2.x by allowing bindings-gpgme 0.2: https://github.com/rethab/h-gpgme/pull/69 + +### Bug fixes + +- fix: release the gpgme data buffer after import and export operations: https://github.com/rethab/h-gpgme/pull/70 +- fix: importKeyFromFile and importKeyFromBytes reported success instead of the actual error when the import operation failed: https://github.com/rethab/h-gpgme/pull/70 +- docs: fix reversed doc comments on IncludeSecret: https://github.com/rethab/h-gpgme/pull/68 +- fix(test): skip gpg-agent sockets when copying the key fixture, which broke removeAliceKey wherever GnuPG puts its sockets in the homedir: https://github.com/rethab/h-gpgme/pull/69 + +### Maintenance + +- chore(ci): modernize CI with a real multi-GHC matrix, latest actions and hardened permissions: https://github.com/rethab/h-gpgme/pull/67 +- chore(ci): release to Hackage from a version tag: https://github.com/rethab/h-gpgme/pull/69 +- chore(ci): test against gpgme 1.x and 2.x, both built from source: https://github.com/rethab/h-gpgme/pull/69 +- chore: give every dependency a PVP upper bound: https://github.com/rethab/h-gpgme/pull/69 + ## 0.6.2.0 ### New Features diff --git a/h-gpgme.cabal b/h-gpgme.cabal --- a/h-gpgme.cabal +++ b/h-gpgme.cabal @@ -1,5 +1,5 @@ Name: h-gpgme -Version: 0.6.2.0 +Version: 0.6.3.0 Description: High Level Binding for GnuPG Made Easy (gpgme): A Haskell API for the gpgme C library. Synopsis: High Level Binding for GnuPG Made Easy (gpgme) License: MIT @@ -9,9 +9,12 @@ Copyright: (c) Reto 2022 Homepage: https://github.com/rethab/h-gpgme Bug-reports: https://github.com/rethab/h-gpgme/issues -Tested-With: GHC==8.8 - , GHC==9.0 - , GHC==9.2 +Tested-With: GHC==8.10.7 + , GHC==9.2.8 + , GHC==9.4.8 + , GHC==9.6.6 + , GHC==9.8.4 + , GHC==9.10.3 Category: Cryptography Build-Type: Simple Cabal-Version: >=1.10 @@ -36,15 +39,14 @@ , Crypto.Gpgme.Crypto , Crypto.Gpgme.Internal , Crypto.Gpgme.Types - build-depends: base == 4.* - , bindings-gpgme >= 0.1.8 && <0.2 - , bytestring >= 0.9 - , transformers >= 0.4.1 && <0.6 - , time >= 1.4 && <2.0 - , unix >= 2.5 - , email-validate - , time - , data-default + build-depends: base >= 4.14 && <5 + , bindings-gpgme >= 0.1.8 && <0.3 + , bytestring >= 0.10 && <0.13 + , transformers >= 0.4.1 && <0.7 + , time >= 1.4 && <2 + , unix >= 2.5 && <2.9 + , email-validate >= 2.0 && <2.4 + , data-default >= 0.5 && <0.9 default-language: Haskell2010 test-suite tests @@ -53,24 +55,24 @@ ghc-options: -Wall hs-source-dirs: src, test main-is: Main.hs - build-depends: base == 4.* - , bindings-gpgme >= 0.1.6 && <0.2 - , bytestring >= 0.9 - , transformers >= 0.4.1 && <0.6 - , time >= 1.4 && <2.0 - , unix >= 2.5 - , directory - , filepath - , email-validate - , data-default - , temporary - , exceptions + build-depends: base >= 4.14 && <5 + , bindings-gpgme >= 0.1.8 && <0.3 + , bytestring >= 0.10 && <0.13 + , transformers >= 0.4.1 && <0.7 + , time >= 1.4 && <2 + , unix >= 2.5 && <2.9 + , email-validate >= 2.0 && <2.4 + , data-default >= 0.5 && <0.9 + , directory >= 1.2 && <2 + , filepath >= 1.3 && <2 + , temporary >= 1.2 && <2 + , exceptions >= 0.8 && <0.11 - , HUnit - , tasty - , tasty-quickcheck - , tasty-hunit - , QuickCheck + , HUnit >= 1.3 && <2 + , tasty >= 1.0 && <2 + , tasty-quickcheck >= 0.9 && <0.12 + , tasty-hunit >= 0.10 && <0.11 + , QuickCheck >= 2.10 && <3 other-modules: Crypto.Gpgme , Crypto.Gpgme.Crypto , Crypto.Gpgme.Ctx diff --git a/src/Crypto/Gpgme.hs b/src/Crypto/Gpgme.hs --- a/src/Crypto/Gpgme.hs +++ b/src/Crypto/Gpgme.hs @@ -50,12 +50,18 @@ -- * Keys , Key , importKeyFromFile + , importKeyFromBytes , getKey , listKeys , removeKey , RemoveKeyFlags(..) , searchKeys + -- * Exporting keys + , exportKey + , exportSecretKey + , exportKeys + , ExportMode(..) -- * Information about keys , Validity (..) , PubKeyAlgo (..) diff --git a/src/Crypto/Gpgme/Internal.hs b/src/Crypto/Gpgme/Internal.hs --- a/src/Crypto/Gpgme/Internal.hs +++ b/src/Crypto/Gpgme/Internal.hs @@ -94,6 +94,17 @@ fromKeyListingMode KeyListingValidate = c'GPGME_KEYLIST_MODE_VALIDATE +-- The GPGME_EXPORT_MODE_* values are replicated from gpgme.h: +-- bindings-gpgme 0.1 does not bind these constants and 0.2 only +-- binds the ones known to the gpgme version it was built against. +fromExportMode :: ExportMode -> CUInt +fromExportMode ExportMinimal = 4 -- GPGME_EXPORT_MODE_MINIMAL +fromExportMode ExportSecret = 16 -- GPGME_EXPORT_MODE_SECRET +fromExportMode ExportRaw = 32 -- GPGME_EXPORT_MODE_RAW +fromExportMode ExportPKCS12 = 64 -- GPGME_EXPORT_MODE_PKCS12 +fromExportMode ExportSSH = 256 -- GPGME_EXPORT_MODE_SSH +fromExportMode ExportSecretSubkey = 512 -- GPGME_EXPORT_MODE_SECRET_SUBKEY + fromProtocol :: (Num a) => Protocol -> a fromProtocol CMS = c'GPGME_PROTOCOL_CMS fromProtocol GPGCONF = c'GPGME_PROTOCOL_GPGCONF diff --git a/src/Crypto/Gpgme/Key.hs b/src/Crypto/Gpgme/Key.hs --- a/src/Crypto/Gpgme/Key.hs +++ b/src/Crypto/Gpgme/Key.hs @@ -1,9 +1,15 @@ module Crypto.Gpgme.Key ( getKey , importKeyFromFile + , importKeyFromBytes , listKeys , removeKey , searchKeys + -- * Exporting keys + , exportKey + , exportSecretKey + , exportKeys + , ExportMode (..) -- * Information about keys , Validity (..) , PubKeyAlgo (..) @@ -18,6 +24,7 @@ ) where import Bindings.Gpgme +import Control.Monad (when) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BSC8 import Data.Time.Clock @@ -31,13 +38,13 @@ -- | Returns a list of all known 'Key's from the @context@. listKeys :: Ctx -- ^ context to operate in - -> IncludeSecret -- ^ whether to include the secrets + -> IncludeSecret -- ^ whether to restrict to secret keys -> IO [Key] listKeys ctx secret = listKeys' ctx secret nullPtr -- | Returns a list of known 'Key's from the @context@ that match a given pattern. searchKeys :: Ctx -- ^ context to operate in - -> IncludeSecret -- ^ whether to include the secrets + -> IncludeSecret -- ^ whether to restrict to secret keys -> String -- ^ The pattern to look for; It is typically -- matched against the user ids of a key. -> IO [Key] @@ -45,7 +52,7 @@ -- | Internal helper function used by both `listKeys` and `searchKeys`. listKeys' :: Ctx -- ^ context to operate in - -> IncludeSecret -- ^ whether to include the secrets + -> IncludeSecret -- ^ whether to restrict to secret keys -> CString -- ^ The pattern to look for; It is typically -- matched against the user ids of a key. -> IO [Key] @@ -68,7 +75,7 @@ -- Returns 'Nothing' if no 'Key' with this 'Fpr' exists. getKey :: Ctx -- ^ context to operate in -> Fpr -- ^ fingerprint - -> IncludeSecret -- ^ whether to include secrets when searching for the key + -> IncludeSecret -- ^ whether to look for a secret key -> IO (Maybe Key) getKey Ctx {_ctx=ctxPtr} fpr secret = do key <- allocKey @@ -85,11 +92,38 @@ importKeyFromFile :: Ctx -- ^ context to operate in -> FilePath -- ^ file path to read from -> IO (Maybe GpgmeError) -importKeyFromFile Ctx {_ctx=ctxPtr} fp = do - dataPtr <- newDataBuffer - ret <- +importKeyFromFile ctx fp = + importData ctx $ \dataPtr -> BS.useAsCString (BSC8.pack fp) $ \cFp -> c'gpgme_data_new_from_file dataPtr cFp 1 + +-- | Import a key from a 'BS.ByteString', this happens in two steps: populate a +-- @gpgme_data_t@ with the contents of the buffer, import the @gpgme_data_t@ +importKeyFromBytes :: Ctx -- ^ context to operate in + -> BS.ByteString -- ^ buffer to read the key from + -> IO (Maybe GpgmeError) +importKeyFromBytes ctx key = + importData ctx $ \dataPtr -> + BS.useAsCString key $ \cKey -> do + -- gpgme must copy the buffer: the import in 'importData' runs after + -- useAsCString returns, at which point cKey has been freed + let copyData = 1 + let keylen = fromIntegral (BS.length key) + c'gpgme_data_new_from_mem dataPtr cKey keylen copyData + +-- | Populate a fresh @gpgme_data_t@ using the given action and import it. +-- The action is responsible for filling the buffer and returns the result +-- of doing so. +importData :: Ctx -- ^ context to operate in + -> (Ptr C'gpgme_data_t -> IO C'gpgme_error_t) -- ^ populate the buffer + -> IO (Maybe GpgmeError) +importData Ctx {_ctx=ctxPtr} populate = do + -- the populate action allocates the data object itself, so it only + -- needs an empty cell; it is initialized to NULL because gpgme + -- leaves it untouched if populating fails + dataPtr <- malloc + poke dataPtr nullData + ret <- populate dataPtr mGpgErr <- case ret of x | x == noError -> do @@ -99,10 +133,64 @@ c'gpgme_op_import ctx dat pure $ if retIn == noError then Nothing - else Just $ GpgmeError ret + else Just $ GpgmeError retIn err -> pure $ Just $ GpgmeError err + dat <- peek dataPtr + when (dat /= nullData) $ c'gpgme_data_release dat free dataPtr pure mGpgErr + where + -- gpgme_data_t is bound as an integral type, so NULL is 0 + nullData = 0 :: C'gpgme_data_t + +-- | Export the public key with the given @fingerprint@ from the +-- @context@. Returns an empty 'BS.ByteString' if no key with +-- this 'Fpr' exists. +exportKey :: Ctx -- ^ context to operate in + -> Fpr -- ^ fingerprint of the key to export + -> IO (Either GpgmeError BS.ByteString) +exportKey ctx fpr = exportKeys ctx [] [fpr] + +-- | Export the secret key with the given @fingerprint@ from the +-- @context@. +-- +-- Exporting a protected secret key requires its passphrase, which +-- may be supplied through @setPassphraseCallback@. +exportSecretKey :: Ctx -- ^ context to operate in + -> Fpr -- ^ fingerprint of the key to export + -> IO (Either GpgmeError BS.ByteString) +exportSecretKey ctx fpr = exportKeys ctx [ExportSecret] [fpr] + +-- | Export all keys matching the given @fingerprints@ from the +-- @context@, or all keys if no fingerprint is given. +-- +-- The keys are returned in armored format if armor has been +-- enabled on the @context@ (see @setArmor@) and in binary +-- format otherwise. +exportKeys :: Ctx -- ^ context to operate in + -> [ExportMode] -- ^ modes for the export + -> [Fpr] -- ^ fingerprints of the keys to export, + -- or empty to export all keys + -> IO (Either GpgmeError BS.ByteString) +exportKeys Ctx {_ctx=ctxPtr} modes fprs = do + dataPtr <- newDataBuffer + dat <- peek dataPtr + ret <- withMany BS.useAsCString fprs $ \cFprs -> + withArray0 nullPtr cFprs $ \pats -> do + ctx <- peek ctxPtr + c'gpgme_op_export_ext ctx pats cMode dat + result <- if ret == noError + then do + -- collectResult is lazy: force the copy while the buffer + -- it reads from is still alive + let key = collectResult dat + key `seq` return (Right key) + else return (Left (GpgmeError ret)) + c'gpgme_data_release dat + free dataPtr + return result + where + cMode = foldl (\memo -> (memo .|.) . fromExportMode) 0 modes -- | Removes the 'Key' from @context@ removeKey :: Ctx -- ^ context to operate in diff --git a/src/Crypto/Gpgme/Types.hs b/src/Crypto/Gpgme/Types.hs --- a/src/Crypto/Gpgme/Types.hs +++ b/src/Crypto/Gpgme/Types.hs @@ -34,6 +34,17 @@ | KeyListingSigNotations | KeyListingValidate +-- | Modes for exporting keys. Multiple modes can be combined, +-- e.g. @[ExportSecret, ExportPKCS12]@. +data ExportMode + = ExportMinimal -- ^ Strip all signatures except the most recent self-signatures + | ExportSecret -- ^ Export the secret keys instead of the public keys + | ExportRaw -- ^ Only with 'ExportSecret' and 'CMS': export in raw format + | ExportPKCS12 -- ^ Only with 'ExportSecret' and 'CMS': export in PKCS#12 format + | ExportSSH -- ^ Export the public key in SSH format + | ExportSecretSubkey -- ^ Export the secret subkeys instead of the public keys + deriving (Show, Eq, Ord) + -- | Modes for signing with GPG data SignMode = Normal | Detach | Clear deriving Show @@ -103,10 +114,10 @@ withKeyPtr :: Key -> (Ptr C'gpgme_key_t -> IO a) -> IO a withKeyPtr (Key fPtr) = withForeignPtr fPtr --- | Whether to include secret keys when searching +-- | Whether to restrict an operation to secret keys data IncludeSecret = - WithSecret -- ^ do not include secret keys - | NoSecret -- ^ include secret keys + WithSecret -- ^ only consider secret keys + | NoSecret -- ^ do not consider secret keys deriving (Show, Eq, Ord) data Flag = diff --git a/test/CryptoTest.hs b/test/CryptoTest.hs --- a/test/CryptoTest.hs +++ b/test/CryptoTest.hs @@ -176,14 +176,14 @@ resVerify <- withCtx "test/bob/" "C" OpenPGP $ \ctx -> do key <- getKey ctx bobPubFpr NoSecret resSign <- sign ctx [fromJust key] Clear "Clear text message from bob specifying signing key" - verifyPlain ctx (fromRight resSign) "" + verify ctx (fromRight resSign) assertBool "Could not verify bob's signature was correct" $ isVerifyValid resVerify bobClearSignAndVerifyDefaultKeyPrompt :: Assertion bobClearSignAndVerifyDefaultKeyPrompt = do resVerify <- withCtx "test/bob/" "C" OpenPGP $ \ctx -> do resSign <- sign ctx [] Clear "Clear text message from bob with default key" - verifyPlain ctx (fromRight resSign) "" + verify ctx (fromRight resSign) assertBool "Could not verify bob's signature was correct" $ isVerifyValid resVerify bobNormalSignAndVerifySpecifyKeyPrompt :: Assertion diff --git a/test/KeyGenTest.hs b/test/KeyGenTest.hs --- a/test/KeyGenTest.hs +++ b/test/KeyGenTest.hs @@ -18,6 +18,7 @@ import Data.Time.Clock import Data.Default import Data.List ( isPrefixOf ) +import Data.Maybe ( fromJust ) import Data.ByteString.Char8 ( unpack ) import Crypto.Gpgme @@ -118,7 +119,7 @@ -- Other ExpireDate to string possibilities expireDateDays :: Assertion expireDateDays = - let (Just p) = G.toPositive 10 + let p = fromJust $ G.toPositive 10 params = (def :: G.GenKeyParams) { G.expireDate = Just $ G.ExpireD p } @@ -130,7 +131,7 @@ expireDateWeeks :: Assertion expireDateWeeks = - let (Just p) = G.toPositive 10 + let p = fromJust $ G.toPositive 10 params = (def :: G.GenKeyParams) { G.expireDate = Just $ G.ExpireW p } @@ -142,7 +143,7 @@ expireDateMonths :: Assertion expireDateMonths = - let (Just p) = G.toPositive 10 + let p = fromJust $ G.toPositive 10 params = (def :: G.GenKeyParams) { G.expireDate = Just $ G.ExpireM p } @@ -154,7 +155,7 @@ expireDateYears :: Assertion expireDateYears = - let (Just p) = G.toPositive 10 + let p = fromJust $ G.toPositive 10 params = (def :: G.GenKeyParams) { G.expireDate = Just $ G.ExpireY p } @@ -166,7 +167,7 @@ expireDateSeconds :: Assertion expireDateSeconds = - let (Just p) = G.toPositive 123456 + let p = fromJust $ G.toPositive 123456 params = (def :: G.GenKeyParams) { G.expireDate = Just $ G.ExpireS p } @@ -178,7 +179,7 @@ creationDateSeconds :: Assertion creationDateSeconds = - let (Just p) = G.toPositive 123456 + let p = fromJust $ G.toPositive 123456 params = (def :: G.GenKeyParams) { G.creationDate = Just $ G.CreationS p } diff --git a/test/KeyTest.hs b/test/KeyTest.hs --- a/test/KeyTest.hs +++ b/test/KeyTest.hs @@ -1,18 +1,20 @@ {-# LANGUAGE OverloadedStrings #-} -module KeyTest (tests) where +module KeyTest (tests, cbTests) where +import qualified Data.ByteString as BS import Data.Maybe -import Data.List -import Test.Tasty (TestTree) +import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (testCase) import Test.HUnit +import Control.Monad (filterM) import System.FilePath (()) import System.Directory ( removeDirectoryRecursive , createDirectory , listDirectory , copyFile ) +import System.Posix.Files (getFileStatus, isRegularFile) import Crypto.Gpgme import TestUtil @@ -29,8 +31,23 @@ , testCase "removeAliceKey" removeAliceKey , testCase "readFromFileWorks" readFromFileWorks , testCase "readFromFileDoesn'tExist" readFromFileDoesn'tExist + , testCase "readFromBytesWorks" readFromBytesWorks + , testCase "exportAlicePubArmored" exportAlicePubArmored + , testCase "exportImportRoundtrip" exportImportRoundtrip + , testCase "exportInexistentIsEmpty" exportInexistentIsEmpty + , testCase "exportAllKeys" exportAllKeys + , testCase "exportMinimal" exportMinimal ] +cbTests :: IO TestTree +cbTests = do + supported <- withCtx "test/alice" "C" OpenPGP $ \ctx -> + return $ isPassphraseCbSupported ctx + if supported + then return $ testGroup "key-passphrase-cb" + [ testCase "exportAliceSecretArmored" exportAliceSecretArmored ] + else return $ testGroup "key-passphrase-cb" [] + getAlicePubFromAlice :: Assertion getAlicePubFromAlice = do withCtx "test/alice" "C" OpenPGP $ \ctx -> @@ -77,27 +94,29 @@ checkAlicePubUserIds = do withCtx "test/alice" "C" OpenPGP $ \ctx -> do Just key <- getKey ctx alicePubFpr NoSecret - let uids = keyUserIds key - length uids @?= 1 - let kuid = head uids - uid = keyuserId kuid - keyuserValidity kuid @?= ValidityUltimate - userId uid @?= "Alice (Test User A) " - userName uid @?= "Alice" - userEmail uid @?= "alice@email.com" - userComment uid @?= "Test User A" + case keyUserIds key of + [kuid] -> do + let uid = keyuserId kuid + keyuserValidity kuid @?= ValidityUltimate + userId uid @?= "Alice (Test User A) " + userName uid @?= "Alice" + userEmail uid @?= "alice@email.com" + userComment uid @?= "Test User A" + uids -> assertFailure $ + "expected exactly one user id, got " ++ show (length uids) checkAlicePubSubkeys :: Assertion checkAlicePubSubkeys = do withCtx "test/alice" "C" OpenPGP $ \ctx -> do Just key <- getKey ctx alicePubFpr NoSecret - let subs = keySubKeys key - length subs @?= 2 - let sub = head subs - subkeyAlgorithm sub @?= Rsa - subkeyLength sub @?= 2048 - subkeyKeyId sub @?= "6B9809775CF91391" - subkeyFpr sub @?= "3F10159E56ECB494ED42EFA36B9809775CF91391" + case keySubKeys key of + [sub, _] -> do + subkeyAlgorithm sub @?= Rsa + subkeyLength sub @?= 2048 + subkeyKeyId sub @?= "6B9809775CF91391" + subkeyFpr sub @?= "3F10159E56ECB494ED42EFA36B9809775CF91391" + subs -> assertFailure $ + "expected exactly two subkeys, got " ++ show (length subs) removeAliceKey :: Assertion removeAliceKey = do @@ -106,11 +125,13 @@ -- Copy alice's key into temporary directory so we can safely remove it let aliceTmpDir = tmpDir "alice" createDirectory aliceTmpDir + -- Where GnuPG has no /run/user to fall back on (macOS, some containers) it + -- puts its agent sockets straight into the homedir, so skip anything that is + -- not a regular file rather than listing socket names one by one. aliceFiles <- listDirectory "test/alice" + >>= filterM (fmap isRegularFile . getFileStatus . ("test/alice" )) mapM_ (\f -> copyFile ("test/alice" f) (tmpDir "alice" f)) - $ filter (\f -> not ("S.gpg-agent" `isPrefixOf` f) - && f /= "private-keys-v1.d" - && f /= ".gpg-v21-migrated" + $ filter (\f -> f /= ".gpg-v21-migrated" && f /= "randomSeed" ) aliceFiles @@ -137,3 +158,68 @@ withCtx "test/real-person" "C" OpenPGP $ \ctx -> do mRet <- importKeyFromFile ctx "this-file-doesn't-exist" isJust mRet @? "shouldn't be able to read this file" + +exportAlicePubArmored :: Assertion +exportAlicePubArmored = + withCtx "test/alice" "C" OpenPGP $ \ctx -> do + setArmor True ctx + key <- fromRight <$> exportKey ctx alicePubFpr + ("-----BEGIN PGP PUBLIC KEY BLOCK-----" `BS.isPrefixOf` key) + @? "exported key must be armored" + +exportImportRoundtrip :: Assertion +exportImportRoundtrip = do + key <- withCtx "test/alice" "C" OpenPGP $ \ctx -> + fromRight <$> exportKey ctx alicePubFpr + tmpDir <- createTemporaryTestDir "exportImportRoundtrip" + withCtx tmpDir "C" OpenPGP $ \ctx -> do + mErr <- importKeyFromBytes ctx key + mErr @?= Nothing + imported <- getKey ctx alicePubFpr NoSecret + isJust imported @? "imported key should be present" + removeDirectoryRecursive tmpDir + +exportInexistentIsEmpty :: Assertion +exportInexistentIsEmpty = + withCtx "test/alice" "C" OpenPGP $ \ctx -> do + key <- fromRight <$> exportKey ctx "ABCDEF" + key @?= BS.empty + +exportAllKeys :: Assertion +exportAllKeys = + withCtx "test/alice" "C" OpenPGP $ \ctx -> do + single <- fromRight <$> exportKeys ctx [] [alicePubFpr] + all' <- fromRight <$> exportKeys ctx [] [] + (BS.length all' > BS.length single) + @? "exporting all keys must yield more than a single key" + +exportMinimal :: Assertion +exportMinimal = + withCtx "test/bob" "C" OpenPGP $ \ctx -> do + full <- fromRight <$> exportKeys ctx [] [alicePubFpr] + minimal <- fromRight <$> exportKeys ctx [ExportMinimal] [alicePubFpr] + not (BS.null minimal) @? "minimal export must not be empty" + (BS.length minimal <= BS.length full) + @? "minimal export must not be larger than the full export" + +exportAliceSecretArmored :: Assertion +exportAliceSecretArmored = + withCtx "test/alice" "C" OpenPGP $ \ctx -> do + setPassphraseCallback ctx (Just (\_ _ _ -> return (Just "alice123"))) + setArmor True ctx + key <- fromRight <$> exportSecretKey ctx alicePubFpr + ("-----BEGIN PGP PRIVATE KEY BLOCK-----" `BS.isPrefixOf` key) + @? "exported secret key must be armored" + +readFromBytesWorks :: Assertion +readFromBytesWorks = do + key <- BS.readFile "test/real-person/real-person.key" + tmpDir <- createTemporaryTestDir "readFromBytesWorks" + withCtx tmpDir "C" OpenPGP $ \ctx -> do + before <- getKey ctx realPersonPubFpr NoSecret + isNothing before @? "key shouldn't be present before import" + mRet <- importKeyFromBytes ctx key + mRet @?= Nothing + after <- getKey ctx realPersonPubFpr NoSecret + isJust after @? "key should be present after import" + removeDirectoryRecursive tmpDir diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -10,8 +10,10 @@ main :: IO () main = do passphraseCbTests <- CryptoTest.cbTests + keyCbTests <- KeyTest.cbTests defaultMain $ testGroup "tests" [ testGroup "key" KeyTest.tests + , keyCbTests , testGroup "keyGen" KeyGenTest.tests , testGroup "ctx" CtxTest.tests , CryptoTest.tests diff --git a/test/TestUtil.hs b/test/TestUtil.hs --- a/test/TestUtil.hs +++ b/test/TestUtil.hs @@ -20,6 +20,9 @@ bobPubFpr :: BS.ByteString bobPubFpr = "6C4FB8F2" +realPersonPubFpr :: BS.ByteString +realPersonPubFpr = "2DA4C89E28F515B4" + -- Orphan instance here! Because this is only a test, orphans are probably OK. -- http://stackoverflow.com/a/3081367/350221 instance Arbitrary BS.ByteString where