| Copyright | (c) Reto Hablützel 2015 |
|---|---|
| License | MIT |
| Maintainer | rethab@rethab.ch |
| Stability | experimental |
| Portability | untested |
| Safe Haskell | None |
| Language | Haskell2010 |
Crypto.Gpgme
Contents
Description
High Level Binding for GnuPG Made Easy (gpgme)
Most of these functions are a one-to-one translation from GnuPG API with some Haskell idiomatics to make the API more convenient.
See the GnuPG manual for more information: https://www.gnupg.org/documentation/manuals/gpgme.pdf
Example (from the tests):
let alice_pub_fpr = "EAACEB8A"
Just enc <- withCtx "test/bob" "C" OpenPGP $ \bCtx -> runMaybeT $ do
aPubKey <- MaybeT $ getKey bCtx alice_pub_fpr NoSecret
fromRight $ encrypt bCtx [aPubKey] NoFlag plain
-- decrypt
dec <- withCtx "test/alice" "C" OpenPGP $ \aCtx ->
decrypt aCtx enc
- data Ctx
- newCtx :: String -> String -> Protocol -> IO Ctx
- freeCtx :: Ctx -> IO ()
- withCtx :: String -> String -> Protocol -> (Ctx -> IO a) -> IO a
- setArmor :: Bool -> Ctx -> IO ()
- isPassphraseCbSupported :: Ctx -> Bool
- type PassphraseCb = String -> String -> Bool -> IO (Maybe String)
- setPassphraseCallback :: Ctx -> Maybe PassphraseCb -> IO ()
- progressCb :: ProgressCb -> IO C'gpgme_progress_cb_t
- setProgressCallback :: Ctx -> Maybe ProgressCb -> IO ()
- data Key
- getKey :: Ctx -> Fpr -> IncludeSecret -> IO (Maybe Key)
- listKeys :: Ctx -> IncludeSecret -> IO [Key]
- removeKey :: Ctx -> Key -> IncludeSecret -> IO (Maybe GpgmeError)
- data Validity
- data PubKeyAlgo
- data KeySignature = KeySig {}
- data UserId = UserId {}
- data KeyUserId = KeyUserId {}
- keyUserIds :: Key -> [KeyUserId]
- keyUserIds' :: Key -> IO [KeyUserId]
- data SubKey = SubKey {}
- keySubKeys :: Key -> [SubKey]
- keySubKeys' :: Key -> IO [SubKey]
- type Signature = ByteString
- data SignatureSummary
- type VerificationResult = [(GpgmeError, [SignatureSummary], Fpr)]
- encrypt :: Ctx -> [Key] -> Flag -> Plain -> IO (Either [InvalidKey] Encrypted)
- encryptSign :: Ctx -> [Key] -> Flag -> Plain -> IO (Either [InvalidKey] Encrypted)
- encryptFd :: Ctx -> [Key] -> Flag -> Fd -> Fd -> IO (Either [InvalidKey] ())
- encryptSignFd :: Ctx -> [Key] -> Flag -> Fd -> Fd -> IO (Either [InvalidKey] ())
- encrypt' :: String -> Fpr -> Plain -> IO (Either String Encrypted)
- encryptSign' :: String -> Fpr -> Plain -> IO (Either String Encrypted)
- decrypt :: Ctx -> Encrypted -> IO (Either DecryptError Plain)
- decryptFd :: Ctx -> Fd -> Fd -> IO (Either DecryptError ())
- decryptVerifyFd :: Ctx -> Fd -> Fd -> IO (Either DecryptError ())
- decrypt' :: String -> Encrypted -> IO (Either DecryptError Plain)
- decryptVerify :: Ctx -> Encrypted -> IO (Either DecryptError Plain)
- decryptVerify' :: String -> Encrypted -> IO (Either DecryptError Plain)
- verify :: Ctx -> Signature -> IO (Either GpgmeError (VerificationResult, ByteString))
- verify' :: String -> Signature -> IO (Either GpgmeError (VerificationResult, ByteString))
- verifyDetached :: Ctx -> Signature -> ByteString -> IO (Either GpgmeError VerificationResult)
- verifyDetached' :: String -> Signature -> ByteString -> IO (Either GpgmeError VerificationResult)
- verifyPlain :: Ctx -> Signature -> ByteString -> IO (Either GpgmeError (VerificationResult, ByteString))
- verifyPlain' :: String -> Signature -> ByteString -> IO (Either GpgmeError (VerificationResult, ByteString))
- sign :: Ctx -> [Key] -> SignMode -> Plain -> IO (Either [InvalidKey] Plain)
- data GpgmeError
- errorString :: GpgmeError -> String
- sourceString :: GpgmeError -> String
- data SignMode
- type Fpr = ByteString
- type Encrypted = ByteString
- type Plain = ByteString
- data Protocol
- type InvalidKey = (String, Int)
- data IncludeSecret
- data Flag
- data DecryptError
- = NoData
- | Failed
- | BadPass
- | Unknown GpgmeError
- newtype HgpgmeException = HgpgmeException SomeException
Context
Context to be passed around with operations. Use newCtx or
withCtx in order to obtain an instance.
Passphrase callbacks
isPassphraseCbSupported :: Ctx -> Bool Source #
Are passphrase callbacks supported?
This functionality is known to be broken in some gpg versions,
see setPassphraseCb for details.
type PassphraseCb Source #
Arguments
| = String | user ID hint |
| -> String | passphrase info |
| -> Bool |
|
| -> IO (Maybe String) |
A callback invoked when the engine requires a passphrase to
proceed. The callback should return Just the requested passphrase,
or Nothing to cancel the operation.
setPassphraseCallback Source #
Arguments
| :: Ctx | context |
| -> Maybe PassphraseCb | a callback, or Nothing to disable |
| -> IO () |
Set the callback invoked when a passphrase is required from the user.
Note that the operation of this feature is a bit inconsistent between
GPG versions. GPG 1.4 using the use-agent option and GPG >= 2.1 require
that the gpg-agent for the session has the allow-loopback-pinentry
option enabled (this can be achieved by adding allow-loopback-pinentry
to gpg-agent.conf. GPG versions between 2.0 and 2.1 do not support the
--pinentry-mode option necessary for this support.
See http://lists.gnupg.org/pipermail/gnupg-devel/2013-February/027345.html
and the gpgme-tool example included in the gpgme tree for details.
Progress callbacks
progressCb :: ProgressCb -> IO C'gpgme_progress_cb_t Source #
Construct a progress callback
Set the callback invoked when a progress feedback is available.
Keys
Arguments
| :: Ctx | context to operate in |
| -> IncludeSecret | whether to include the secrets |
| -> IO [Key] |
Returns a list of known Keys from the context.
Arguments
| :: Ctx | context to operate in |
| -> Key | key to delete |
| -> IncludeSecret | include secret keys for deleting |
| -> IO (Maybe GpgmeError) |
Removes the Key from context
Information about keys
The validity of a user identity
A user ID consisting of a name, comment, and email address.
Constructors
| UserId | |
A user ID
Constructors
| KeyUserId | |
Fields | |
keyUserIds :: Key -> [KeyUserId] Source #
Extract KeyUserIds from Key. Uses unsafePerformIO to bypass IO monad!
Use keyUserIds instead if possible.
Constructors
| SubKey | |
Fields
| |
keySubKeys :: Key -> [SubKey] Source #
Extract SubKeys from Key. Uses unsafePerformIO to bypass IO monad!
Use keySubKeys instead if possible.
Encryption
type Signature = ByteString Source #
a signature
data SignatureSummary Source #
the summary of a signature status
Constructors
| BadPolicy | A policy requirement was not met |
| CrlMissing | The CRL is not available |
| CrlTooOld | Available CRL is too old |
| Green | The signature is good but one might want to display some extra information |
| KeyExpired | The key or one of the certificates has expired |
| KeyMissing | Can’t verify due to a missing key or certificate |
| KeyRevoked | The key or at least one certificate has been revoked |
| Red | The signature is bad |
| SigExpired | The signature has expired |
| SysError | A system error occured |
| UnknownSummary C'gpgme_sigsum_t | The summary is something else |
| Valid | The signature is fully valid |
Instances
type VerificationResult = [(GpgmeError, [SignatureSummary], Fpr)] Source #
encrypt :: Ctx -> [Key] -> Flag -> Plain -> IO (Either [InvalidKey] Encrypted) Source #
encrypt for a list of recipients
encryptSign :: Ctx -> [Key] -> Flag -> Plain -> IO (Either [InvalidKey] Encrypted) Source #
encrypt and sign for a list of recipients
encryptFd :: Ctx -> [Key] -> Flag -> Fd -> Fd -> IO (Either [InvalidKey] ()) Source #
Encrypt plaintext
encryptSignFd :: Ctx -> [Key] -> Flag -> Fd -> Fd -> IO (Either [InvalidKey] ()) Source #
Encrypt and sign plaintext
encrypt' :: String -> Fpr -> Plain -> IO (Either String Encrypted) Source #
Convenience wrapper around withCtx and withKey to
encrypt a single plaintext for a single recipient with
its homedirectory.
encryptSign' :: String -> Fpr -> Plain -> IO (Either String Encrypted) Source #
Convenience wrapper around withCtx and withKey to
encrypt and sign a single plaintext for a single recipient
with its homedirectory.
decryptVerifyFd :: Ctx -> Fd -> Fd -> IO (Either DecryptError ()) Source #
Decrypt and verify ciphertext
decrypt' :: String -> Encrypted -> IO (Either DecryptError Plain) Source #
Convenience wrapper around withCtx and withKey to
decrypt a single ciphertext with its homedirectory.
decryptVerify :: Ctx -> Encrypted -> IO (Either DecryptError Plain) Source #
Decrypts and verifies a ciphertext
decryptVerify' :: String -> Encrypted -> IO (Either DecryptError Plain) Source #
Convenience wrapper around withCtx and withKey to
decrypt and verify a single ciphertext with its homedirectory.
verify :: Ctx -> Signature -> IO (Either GpgmeError (VerificationResult, ByteString)) Source #
Verify a payload with a plain signature
verify' :: String -> Signature -> IO (Either GpgmeError (VerificationResult, ByteString)) Source #
Convenience wrapper around withCtx to
verify a single plain signature with its homedirectory.
Arguments
| :: Ctx | GPG context |
| -> Signature | Detached signature |
| -> ByteString | Signed text |
| -> IO (Either GpgmeError VerificationResult) |
Verify a payload with a detached signature
Arguments
| :: String | GPG context home directory |
| -> Signature | Detached signature |
| -> ByteString | Signed text |
| -> IO (Either GpgmeError VerificationResult) |
Convenience wrapper around withCtx to
verify a single detached signature with its homedirectory.
verifyPlain :: Ctx -> Signature -> ByteString -> IO (Either GpgmeError (VerificationResult, ByteString)) Source #
Deprecated: Use verify
verifyPlain' :: String -> Signature -> ByteString -> IO (Either GpgmeError (VerificationResult, ByteString)) Source #
Deprecated: Use verify'
Arguments
| :: Ctx | Context to sign |
| -> [Key] | Keys to used for signing. An empty list will use context's default key. |
| -> SignMode | Signing mode |
| -> Plain | Plain text to sign |
| -> IO (Either [InvalidKey] Plain) |
Sign plaintext for a list of signers
Error handling
data GpgmeError Source #
A GPGME error.
Errors in GPGME consist of two parts: a code indicating the nature of the fault, and a source indicating from which subsystem the error originated.
Instances
errorString :: GpgmeError -> String Source #
An explanatory string for a GPGME error.
sourceString :: GpgmeError -> String Source #
An explanatory string describing the source of a GPGME error
Other Types
Modes for signing with GPG
type Fpr = ByteString Source #
a fingerprint
type Encrypted = ByteString Source #
an ciphertext
type Plain = ByteString Source #
a plaintext
the protocol to be used in the crypto engine
type InvalidKey = (String, Int) Source #
The fingerprint and an error code
data IncludeSecret Source #
Whether to include secret keys when searching
Constructors
| WithSecret | do not include secret keys |
| NoSecret | include secret keys |
Instances
Constructors
| AlwaysTrust | |
| NoFlag |
data DecryptError Source #
error indicating what went wrong in decryption
Constructors
| NoData | no data to decrypt |
| Failed | not a valid cipher |
| BadPass | passphrase for secret was wrong |
| Unknown GpgmeError | something else went wrong |
Instances
newtype HgpgmeException Source #
h-gpgme exception for wrapping exception which occur outside of the control of h-gpgme
Constructors
| HgpgmeException SomeException |
Instances