h-gpgme 0.3.0.0 → 0.4.0.0
raw patch · 5 files changed
+147/−9 lines, 5 files
Files
- h-gpgme.cabal +5/−5
- src/Crypto/Gpgme.hs +7/−3
- src/Crypto/Gpgme/Crypto.hs +81/−0
- src/Crypto/Gpgme/Internal.hs +16/−1
- src/Crypto/Gpgme/Types.hs +38/−0
h-gpgme.cabal view
@@ -1,15 +1,16 @@ Name: h-gpgme-Version: 0.3.0.0+Version: 0.4.0.0 Description: High Level Binding for GnuPG Made Easy (gpgme)+Synopsis: High Level Binding for GnuPG Made Easy (gpgme) License: MIT License-file: LICENSE Author: Reto Habluetzel Maintainer: rethab@rethab.ch-Copyright: (c) Reto Habluetzel 2015-Author: Reto Habluetzel 2015+Copyright: (c) Reto Habluetzel 2016+Author: Reto Habluetzel 2016 Homepage: https://github.com/rethab/h-gpgme Bug-reports: https://github.com/rethab/h-gpgme/issues-Tested-With: GHC==7.8.3+Tested-With: GHC==7.10.3 Category: Cryptography Build-Type: Simple Cabal-Version: >=1.10@@ -21,7 +22,6 @@ library hs-source-dirs: src ghc-options: -Wall- -O2 -fno-warn-orphans exposed-modules: Crypto.Gpgme other-modules: Crypto.Gpgme.Key
src/Crypto/Gpgme.hs view
@@ -43,9 +43,6 @@ , PassphraseCb , setPassphraseCallback - -- currently not exported as it does not work as expected:- -- , withPWCtx- -- * Keys , Key , getKey@@ -61,6 +58,9 @@ , keySubKeys -- * Encryption+ , Signature+ , SignatureSummary(..)+ , VerificationResult , encrypt , encryptSign , encrypt'@@ -69,6 +69,10 @@ , decrypt' , decryptVerify , decryptVerify'+ , verifyDetached+ , verifyDetached'+ , verifyPlain+ , verifyPlain' -- * Error handling , GpgmeError
src/Crypto/Gpgme/Crypto.hs view
@@ -8,6 +8,10 @@ , decrypt' , decryptVerify , decryptVerify'+ , verifyDetached+ , verifyDetached'+ , verifyPlain+ , verifyPlain' ) where @@ -174,6 +178,83 @@ free resultBufPtr return res++-- | Verify a payload with a detached signature+verifyDetached :: Ctx -> Signature -> BS.ByteString -> IO (Either GpgmeError VerificationResult)+verifyDetached ctx sig dat = do+ res <- verifyInternal go ctx sig dat+ return $ fmap fst res+ where+ go ctx' sig' dat' = do+ errcode <- c'gpgme_op_verify ctx' sig' dat' 0+ return (errcode, ())++-- | Convenience wrapper around 'withCtx' to+-- verify a single detached signature with its homedirectory.+verifyDetached' :: String -> Signature -> BS.ByteString -> IO (Either GpgmeError VerificationResult)+verifyDetached' gpgDir sig dat =+ withCtx gpgDir locale OpenPGP $ \ctx ->+ verifyDetached ctx sig dat++-- | Verify a payload with a plain signature+verifyPlain :: Ctx -> Signature -> BS.ByteString -> IO (Either GpgmeError (VerificationResult, BS.ByteString))+verifyPlain = verifyInternal go+ where+ go ctx sig dat = do+ -- init buffer for result+ resultBufPtr <- newDataBuffer+ resultBuf <- peek resultBufPtr++ errcode <- c'gpgme_op_verify ctx sig dat resultBuf++ let res = if errcode /= noError+ then mempty+ else collectResult resultBuf++ free resultBufPtr++ return (errcode, res)++-- | Convenience wrapper around 'withCtx' to+-- verify a single plain signature with its homedirectory.+verifyPlain' :: String -> Signature -> BS.ByteString -> IO (Either GpgmeError (VerificationResult, BS.ByteString))+verifyPlain' gpgDir sig dat =+ withCtx gpgDir locale OpenPGP $ \ctx ->+ verifyPlain ctx sig dat++verifyInternal :: (C'gpgme_ctx_t -> C'gpgme_data_t -> C'gpgme_data_t -> IO (C'gpgme_error_t, a))-> Ctx -> Signature -> BS.ByteString -> IO (Either GpgmeError (VerificationResult, a))+verifyInternal ver_op (Ctx {_ctx=ctxPtr}) sig dat = do+ -- init buffer with signature+ sigBufPtr <- malloc+ BS.useAsCString sig $ \bs -> do+ let copyData = 1 -- gpgme shall copy data, as bytestring will free it+ let siglen = fromIntegral (BS.length sig)+ ret <- c'gpgme_data_new_from_mem sigBufPtr bs siglen copyData+ checkError "data_new_from_mem" ret+ sigBuf <- peek sigBufPtr++ -- init buffer with data+ datBufPtr <- malloc+ BS.useAsCString dat $ \bs -> do+ let copyData = 1 -- gpgme shall copy data, as bytestring will free it+ let datlen = fromIntegral (BS.length dat)+ ret <- c'gpgme_data_new_from_mem datBufPtr bs datlen copyData+ checkError "data_new_from_mem" ret+ datBuf <- peek datBufPtr++ ctx <- peek ctxPtr++ -- verify+ (errcode, res) <- ver_op ctx sigBuf datBuf++ let res' = if errcode /= noError+ then Left (GpgmeError errcode)+ else Right (collectSignatures ctx, res)++ free sigBufPtr+ free datBufPtr++ return res' newDataBuffer :: IO (Ptr C'gpgme_data_t) newDataBuffer = do
src/Crypto/Gpgme/Internal.hs view
@@ -3,7 +3,7 @@ import Bindings.Gpgme import Control.Monad (unless) import qualified Data.ByteString as BS-import Foreign (allocaBytes, castPtr, peek)+import Foreign (allocaBytes, castPtr, nullPtr, peek) import Foreign.C.String (peekCString) import Foreign.C.Types (CUInt, CInt) import System.IO.Unsafe (unsafePerformIO)@@ -33,6 +33,21 @@ return (byte `BS.cons` rest) else return BS.empty seekSet = 0++collectSignatures :: C'gpgme_ctx_t -> VerificationResult+collectSignatures ctx = unsafePerformIO $ do+ verify_res <- c'gpgme_op_verify_result ctx+ sigs <- peek $ p'_gpgme_op_verify_result'signatures verify_res+ go sigs+ where+ go sig | sig == nullPtr = return []+ go sig = do+ status <- peek $ p'_gpgme_signature'status sig+ summary <- peek $ p'_gpgme_signature'summary sig+ fpr <- peek (p'_gpgme_signature'fpr sig) >>= BS.packCString+ next <- peek $ p'_gpgme_signature'next sig+ xs <- go next+ return $ (GpgmeError status, toSignatureSummaries summary, fpr) : xs checkError :: String -> C'gpgme_error_t -> IO () checkError fun gpgme_err =
src/Crypto/Gpgme/Types.hs view
@@ -2,6 +2,7 @@ import Bindings.Gpgme import qualified Data.ByteString as BS+import Data.Maybe(catMaybes) import Foreign import qualified Foreign.Concurrent as FC import Foreign.C.String (peekCString)@@ -32,6 +33,43 @@ -- | an ciphertext type Encrypted = BS.ByteString++-- | a signature+type Signature = BS.ByteString++-- | the summary of a signature status+data SignatureSummary =+ 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+ deriving (Show, Eq, Ord)++-- | Translate the gpgme_sigsum_t bit vector to a list of SignatureSummary+toSignatureSummaries :: C'gpgme_sigsum_t -> [SignatureSummary]+toSignatureSummaries x = catMaybes $ map (\(mask, val) -> if mask .&. x == 0 then Nothing else Just val)+ [ (c'GPGME_SIGSUM_BAD_POLICY , BadPolicy)+ , (c'GPGME_SIGSUM_CRL_MISSING, CrlMissing)+ , (c'GPGME_SIGSUM_CRL_TOO_OLD, CrlTooOld)+ , (c'GPGME_SIGSUM_GREEN , Green)+ , (c'GPGME_SIGSUM_KEY_EXPIRED, KeyExpired)+ , (c'GPGME_SIGSUM_KEY_MISSING, KeyMissing)+ , (c'GPGME_SIGSUM_KEY_REVOKED, KeyRevoked)+ , (c'GPGME_SIGSUM_RED , Red)+ , (c'GPGME_SIGSUM_SIG_EXPIRED, SigExpired)+ , (c'GPGME_SIGSUM_SYS_ERROR , SysError)+ , (c'GPGME_SIGSUM_VALID , Valid)+ ]++type VerificationResult = [(GpgmeError, [SignatureSummary], Fpr)] -- | The fingerprint and an error code type InvalidKey = (String, Int)