Copyright | (c) Reto Hablützel 2015 |
---|---|
License | MIT |
Maintainer | rethab@rethab.ch |
Stability | experimental |
Portability | untested |
Safe Haskell | None |
Language | Haskell2010 |
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
Synopsis
- data Ctx
- newCtx :: String -> String -> Protocol -> IO Ctx
- freeCtx :: Ctx -> IO ()
- withCtx :: String -> String -> Protocol -> (Ctx -> IO a) -> IO a
- setArmor :: Bool -> Ctx -> IO ()
- setKeyListingMode :: [KeyListingMode] -> 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
- importKeyFromFile :: Ctx -> FilePath -> IO (Maybe GpgmeError)
- getKey :: Ctx -> Fpr -> IncludeSecret -> IO (Maybe Key)
- listKeys :: Ctx -> IncludeSecret -> IO [Key]
- removeKey :: Ctx -> Key -> RemoveKeyFlags -> IO (Maybe GpgmeError)
- data RemoveKeyFlags = RemoveKeyFlags {
- allowSecret :: Bool
- force :: Bool
- searchKeys :: Ctx -> IncludeSecret -> String -> IO [Key]
- 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 KeyListingMode
- 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.
setKeyListingMode :: [KeyListingMode] -> Ctx -> IO () Source #
Sets the key listing mode on ctx
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 #
= 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 #
:: 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
:: Ctx | context to operate in |
-> FilePath | file path to read from |
-> IO (Maybe GpgmeError) |
Import a key from a file, this happens in two steps: populate a
gpgme_data_t
with the contents of the file, import the gpgme_data_t
:: Ctx | context to operate in |
-> IncludeSecret | whether to include the secrets |
-> IO [Key] |
Returns a list of all known Key
s from the context
.
:: Ctx | context to operate in |
-> Key | key to delete |
-> RemoveKeyFlags | flags for remove operation |
-> IO (Maybe GpgmeError) |
Removes the Key
from context
data RemoveKeyFlags Source #
Flags for removeKey function
RemoveKeyFlags | |
|
Instances
Eq RemoveKeyFlags Source # | |
Defined in Crypto.Gpgme.Types (==) :: RemoveKeyFlags -> RemoveKeyFlags -> Bool # (/=) :: RemoveKeyFlags -> RemoveKeyFlags -> Bool # | |
Ord RemoveKeyFlags Source # | |
Defined in Crypto.Gpgme.Types compare :: RemoveKeyFlags -> RemoveKeyFlags -> Ordering # (<) :: RemoveKeyFlags -> RemoveKeyFlags -> Bool # (<=) :: RemoveKeyFlags -> RemoveKeyFlags -> Bool # (>) :: RemoveKeyFlags -> RemoveKeyFlags -> Bool # (>=) :: RemoveKeyFlags -> RemoveKeyFlags -> Bool # max :: RemoveKeyFlags -> RemoveKeyFlags -> RemoveKeyFlags # min :: RemoveKeyFlags -> RemoveKeyFlags -> RemoveKeyFlags # | |
Show RemoveKeyFlags Source # | |
Defined in Crypto.Gpgme.Types showsPrec :: Int -> RemoveKeyFlags -> ShowS # show :: RemoveKeyFlags -> String # showList :: [RemoveKeyFlags] -> ShowS # |
:: Ctx | context to operate in |
-> IncludeSecret | whether to include the secrets |
-> String | The pattern to look for; It is typically matched against the user ids of a key. |
-> IO [Key] |
Returns a list of known Key
s from the context
that match a given pattern.
Information about keys
The validity of a user identity
data PubKeyAlgo Source #
A public-key encryption algorithm
Instances
Eq PubKeyAlgo Source # | |
Defined in Crypto.Gpgme.Types (==) :: PubKeyAlgo -> PubKeyAlgo -> Bool # (/=) :: PubKeyAlgo -> PubKeyAlgo -> Bool # | |
Ord PubKeyAlgo Source # | |
Defined in Crypto.Gpgme.Types compare :: PubKeyAlgo -> PubKeyAlgo -> Ordering # (<) :: PubKeyAlgo -> PubKeyAlgo -> Bool # (<=) :: PubKeyAlgo -> PubKeyAlgo -> Bool # (>) :: PubKeyAlgo -> PubKeyAlgo -> Bool # (>=) :: PubKeyAlgo -> PubKeyAlgo -> Bool # max :: PubKeyAlgo -> PubKeyAlgo -> PubKeyAlgo # min :: PubKeyAlgo -> PubKeyAlgo -> PubKeyAlgo # | |
Show PubKeyAlgo Source # | |
Defined in Crypto.Gpgme.Types showsPrec :: Int -> PubKeyAlgo -> ShowS # show :: PubKeyAlgo -> String # showList :: [PubKeyAlgo] -> ShowS # |
data KeySignature Source #
A key signature
A user ID consisting of a name, comment, and email address.
A user ID
keyUserIds :: Key -> [KeyUserId] Source #
Extract KeyUserId
s from Key
. Uses unsafePerformIO
to bypass IO
monad!
Use keyUserIds
instead if possible.
keySubKeys :: Key -> [SubKey] Source #
Extract SubKey
s 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
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
Eq SignatureSummary Source # | |
Defined in Crypto.Gpgme.Types (==) :: SignatureSummary -> SignatureSummary -> Bool # (/=) :: SignatureSummary -> SignatureSummary -> Bool # | |
Ord SignatureSummary Source # | |
Defined in Crypto.Gpgme.Types compare :: SignatureSummary -> SignatureSummary -> Ordering # (<) :: SignatureSummary -> SignatureSummary -> Bool # (<=) :: SignatureSummary -> SignatureSummary -> Bool # (>) :: SignatureSummary -> SignatureSummary -> Bool # (>=) :: SignatureSummary -> SignatureSummary -> Bool # max :: SignatureSummary -> SignatureSummary -> SignatureSummary # min :: SignatureSummary -> SignatureSummary -> SignatureSummary # | |
Show SignatureSummary Source # | |
Defined in Crypto.Gpgme.Types showsPrec :: Int -> SignatureSummary -> ShowS # show :: SignatureSummary -> String # showList :: [SignatureSummary] -> ShowS # |
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.
:: Ctx | GPG context |
-> Signature | Detached signature |
-> ByteString | Signed text |
-> IO (Either GpgmeError VerificationResult) |
Verify a payload with a detached signature
:: 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'
:: 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
Eq GpgmeError Source # | |
Defined in Crypto.Gpgme.Types (==) :: GpgmeError -> GpgmeError -> Bool # (/=) :: GpgmeError -> GpgmeError -> Bool # | |
Ord GpgmeError Source # | |
Defined in Crypto.Gpgme.Types compare :: GpgmeError -> GpgmeError -> Ordering # (<) :: GpgmeError -> GpgmeError -> Bool # (<=) :: GpgmeError -> GpgmeError -> Bool # (>) :: GpgmeError -> GpgmeError -> Bool # (>=) :: GpgmeError -> GpgmeError -> Bool # max :: GpgmeError -> GpgmeError -> GpgmeError # min :: GpgmeError -> GpgmeError -> GpgmeError # | |
Show GpgmeError Source # | |
Defined in Crypto.Gpgme.Types showsPrec :: Int -> GpgmeError -> ShowS # show :: GpgmeError -> String # showList :: [GpgmeError] -> ShowS # |
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
data KeyListingMode Source #
Modes for key listings
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
WithSecret | do not include secret keys |
NoSecret | include secret keys |
Instances
Eq IncludeSecret Source # | |
Defined in Crypto.Gpgme.Types (==) :: IncludeSecret -> IncludeSecret -> Bool # (/=) :: IncludeSecret -> IncludeSecret -> Bool # | |
Ord IncludeSecret Source # | |
Defined in Crypto.Gpgme.Types compare :: IncludeSecret -> IncludeSecret -> Ordering # (<) :: IncludeSecret -> IncludeSecret -> Bool # (<=) :: IncludeSecret -> IncludeSecret -> Bool # (>) :: IncludeSecret -> IncludeSecret -> Bool # (>=) :: IncludeSecret -> IncludeSecret -> Bool # max :: IncludeSecret -> IncludeSecret -> IncludeSecret # min :: IncludeSecret -> IncludeSecret -> IncludeSecret # | |
Show IncludeSecret Source # | |
Defined in Crypto.Gpgme.Types showsPrec :: Int -> IncludeSecret -> ShowS # show :: IncludeSecret -> String # showList :: [IncludeSecret] -> ShowS # |
data DecryptError Source #
error indicating what went wrong in decryption
NoData | no data to decrypt |
Failed | not a valid cipher |
BadPass | passphrase for secret was wrong |
Unknown GpgmeError | something else went wrong |
Instances
Eq DecryptError Source # | |
Defined in Crypto.Gpgme.Types (==) :: DecryptError -> DecryptError -> Bool # (/=) :: DecryptError -> DecryptError -> Bool # | |
Ord DecryptError Source # | |
Defined in Crypto.Gpgme.Types compare :: DecryptError -> DecryptError -> Ordering # (<) :: DecryptError -> DecryptError -> Bool # (<=) :: DecryptError -> DecryptError -> Bool # (>) :: DecryptError -> DecryptError -> Bool # (>=) :: DecryptError -> DecryptError -> Bool # max :: DecryptError -> DecryptError -> DecryptError # min :: DecryptError -> DecryptError -> DecryptError # | |
Show DecryptError Source # | |
Defined in Crypto.Gpgme.Types showsPrec :: Int -> DecryptError -> ShowS # show :: DecryptError -> String # showList :: [DecryptError] -> ShowS # |
newtype HgpgmeException Source #
h-gpgme exception for wrapping exception which occur outside of the control of h-gpgme
Instances
Show HgpgmeException Source # | |
Defined in Crypto.Gpgme.Types showsPrec :: Int -> HgpgmeException -> ShowS # show :: HgpgmeException -> String # showList :: [HgpgmeException] -> ShowS # | |
Exception HgpgmeException Source # | |
Defined in Crypto.Gpgme.Types |