h-gpgme 0.1.0.0 → 0.2.0.0
raw patch · 8 files changed
+84/−80 lines, 8 files
Files
- h-gpgme.cabal +3/−1
- src/Crypto/Gpgme.hs +8/−8
- src/Crypto/Gpgme/Crypto.hs +18/−13
- src/Crypto/Gpgme/Ctx.hs +19/−32
- src/Crypto/Gpgme/Internal.hs +17/−2
- src/Crypto/Gpgme/Key.hs +2/−2
- src/Crypto/Gpgme/Types.hs +16/−22
- test/Main.hs +1/−0
h-gpgme.cabal view
@@ -1,5 +1,5 @@ Name: h-gpgme-Version: 0.1.0.0+Version: 0.2.0.0 Description: High Level Binding for GnuPG Made Easy (gpgme) License: MIT License-file: LICENSE@@ -38,6 +38,8 @@ test-suite tests type: exitcode-stdio-1.0 default-language: Haskell2010+ ghc-options: -Wall+ -fhpc hs-source-dirs: src, test main-is: Main.hs build-depends: base == 4.*
src/Crypto/Gpgme.hs view
@@ -37,6 +37,7 @@ , newCtx , freeCtx , withCtx+ , withArmor -- currently not exported as it does not work as expected: -- , withPWCtx@@ -58,18 +59,17 @@ , decryptVerify' -- * Other Types- , Protocol- , openPGP+ , Fpr+ , Encrypted+ , Plain + , Protocol(..)+ , InvalidKey - , IncludeSecret- , noSecret- , secret+ , IncludeSecret(..) - , Flag- , alwaysTrust- , noFlag+ , Flag(..) , DecryptError(..)
src/Crypto/Gpgme/Crypto.hs view
@@ -39,10 +39,10 @@ encryptIntern' :: (Ctx -> [Key] -> Flag -> Plain -> IO (Either [InvalidKey] Encrypted) ) -> String -> Fpr -> Plain -> IO (Either String Encrypted)-encryptIntern' encrFun gpgDir recFpr plain = do- withCtx gpgDir locale openPGP $ \ctx ->- do mbRes <- withKey ctx recFpr noSecret $ \pubKey ->- encrFun ctx [pubKey] noFlag plain+encryptIntern' encrFun gpgDir recFpr plain =+ withCtx gpgDir locale OpenPGP $ \ctx ->+ do mbRes <- withKey ctx recFpr NoSecret $ \pubKey ->+ encrFun ctx [pubKey] NoFlag plain return $ mapErr mbRes where mapErr Nothing = Left $ "no such key: " ++ show recFpr mapErr (Just (Left err)) = Left (show err)@@ -68,19 +68,18 @@ -> Flag -> Plain -> IO (Either [InvalidKey] Encrypted) -encryptIntern enc_op (Ctx ctxPtr _) recPtrs (Flag flag) plain = do+encryptIntern enc_op (Ctx ctxPtr _) recPtrs flag plain = do -- init buffer with plaintext plainBufPtr <- malloc BS.useAsCString plain $ \bs -> do let copyData = 1 -- gpgme shall copy data, as bytestring will free it let plainlen = fromIntegral (BS.length plain) ret <- c'gpgme_data_new_from_mem plainBufPtr bs plainlen copyData- check_error "data_new_from_mem" ret+ checkError "data_new_from_mem" ret plainBuf <- peek plainBufPtr -- init buffer for result- resultBufPtr <- malloc- check_error "data_new" =<< c'gpgme_data_new resultBufPtr+ resultBufPtr <- newDataBuffer resultBuf <- peek resultBufPtr -- null terminated array of recipients@@ -92,7 +91,8 @@ ctx <- peek ctxPtr -- encrypt- check_error "op_encrypt" =<< enc_op ctx recArray flag plainBuf resultBuf+ checkError "op_encrypt" =<< enc_op ctx recArray (fromFlag flag)+ plainBuf resultBuf free plainBufPtr -- check whether all keys could be used for encryption@@ -123,7 +123,7 @@ -> Encrypted -> IO (Either DecryptError Plain) decryptInternal' decrFun gpgDir cipher =- withCtx gpgDir locale openPGP $ \ctx ->+ withCtx gpgDir locale OpenPGP $ \ctx -> decrFun ctx cipher -- | Decrypts a ciphertext@@ -150,12 +150,11 @@ let copyData = 1 -- gpgme shall copy data, as bytestring will free it let cipherlen = fromIntegral (BS.length cipher) ret <- c'gpgme_data_new_from_mem cipherBufPtr bs cipherlen copyData- check_error "data_new_from_mem" ret+ checkError "data_new_from_mem" ret cipherBuf <- peek cipherBufPtr -- init buffer for result- resultBufPtr <- malloc- check_error "data_new" =<< c'gpgme_data_new resultBufPtr+ resultBufPtr <- newDataBuffer resultBuf <- peek resultBufPtr ctx <- peek ctxPtr@@ -171,3 +170,9 @@ free resultBufPtr return res++newDataBuffer :: IO (Ptr C'gpgme_data_t)+newDataBuffer = do+ resultBufPtr <- malloc+ checkError "data_new" =<< c'gpgme_data_new resultBufPtr+ return resultBufPtr
src/Crypto/Gpgme/Ctx.hs view
@@ -4,7 +4,6 @@ import Foreign import Foreign.C.String import Foreign.C.Types-import System.Posix.IO (fdWrite) import Crypto.Gpgme.Types import Crypto.Gpgme.Internal@@ -16,7 +15,7 @@ -> String -- ^ locale -> Protocol -- ^ protocol -> IO Ctx-newCtx homedir localeStr (Protocol protocol) =+newCtx homedir localeStr protocol = do homedirPtr <- newCString homedir -- check version: necessary for initialization!!@@ -24,20 +23,21 @@ -- create context ctxPtr <- malloc - check_error "gpgme_new" =<< c'gpgme_new ctxPtr+ checkError "gpgme_new" =<< c'gpgme_new ctxPtr ctx <- peek ctxPtr -- set locale locale <- newCString localeStr- check_error "set_locale" =<< c'gpgme_set_locale ctx lcCtype locale+ checkError "set_locale" =<< c'gpgme_set_locale ctx lcCtype locale -- set protocol in ctx- check_error "set_protocol" =<< c'gpgme_set_protocol ctx (fromIntegral protocol)+ checkError "set_protocol" =<< c'gpgme_set_protocol ctx+ (fromProtocol protocol) -- set homedir in ctx- check_error "set_engine_info" =<< c'gpgme_ctx_set_engine_info ctx- (fromIntegral protocol) nullPtr homedirPtr+ checkError "set_engine_info" =<< c'gpgme_ctx_set_engine_info ctx+ (fromProtocol protocol) nullPtr homedirPtr return (Ctx ctxPtr version) where lcCtype :: CInt@@ -64,29 +64,16 @@ freeCtx ctx return res -withPWCtx :: String -> String -> String -> Protocol -> (Ctx -> IO a) -> IO a-withPWCtx pw homedir localeStr prot f = do- ctx <- newCtx homedir localeStr prot- setPassphrase ctx pw- res <- f ctx- freeCtx ctx- return res--setPassphrase :: Ctx -> String -> IO ()-setPassphrase (Ctx ctxPtr _) passphrase =- do ctx <- peek ctxPtr- passcb <- wrap (passphrase_cb passphrase)- c'gpgme_set_passphrase_cb ctx passcb nullPtr--passphrase_cb :: String -> Ptr () -> CString -> CString -> CInt -> CInt -> IO C'gpgme_error_t-passphrase_cb passphrase _ uid_hint passphrase_info prev_was_bad fd =- do peekCString uid_hint >>= putStrLn- peekCString passphrase_info >>= putStrLn- putStrLn ("Prev was bad: " ++ show prev_was_bad)- _ <- fdWrite (fromIntegral fd) (passphrase ++ "\n")- return 0+-- | Sets the produced output to be ASCII armored+--+-- Inject between `withCtx' and your 'IO a' like+--+-- > withCtx homedir locale OpenPGP $ withArmor $ \ctx ->+-- > withKey ctx fpr NoSecret $ \pubkey ->+-- > encrypt ctx [pubkey] NoFlag plaintext --- from: http://www.haskell.org/haskellwiki/GHC/Using_the_FFI#Callbacks_into_Haskell_from_foreign_code-foreign import ccall "wrapper"- wrap :: (Ptr () -> CString -> CString -> CInt -> CInt -> IO C'gpgme_error_t)- -> IO (FunPtr (Ptr () -> CString -> CString -> CInt -> CInt -> IO C'gpgme_error_t))+withArmor :: (Ctx -> IO a) -> Ctx -> IO a+withArmor f ctx = do+ cctx <- peek $ _ctx ctx+ c'gpgme_set_armor cctx 1+ f ctx
src/Crypto/Gpgme/Internal.hs view
@@ -5,6 +5,7 @@ import qualified Data.ByteString as BS import Foreign (allocaBytes, castPtr, peek) import Foreign.C.String (peekCString)+import Foreign.C.Types (CUInt, CInt) import System.IO.Unsafe (unsafePerformIO) import Crypto.Gpgme.Types@@ -33,8 +34,8 @@ else return BS.empty seekSet = 0 -check_error :: String -> C'gpgme_error_t -> IO ()-check_error fun gpgme_err =+checkError :: String -> C'gpgme_error_t -> IO ()+checkError fun gpgme_err = unless (gpgme_err == noError) $ do errstr <- c'gpgme_strerror gpgme_err str <- peekCString errstr@@ -46,3 +47,17 @@ noError :: Num a => a noError = 0++fromProtocol :: (Num a) => Protocol -> a+fromProtocol CMS = c'GPGME_PROTOCOL_CMS+fromProtocol GPGCONF = c'GPGME_PROTOCOL_GPGCONF+fromProtocol OpenPGP = c'GPGME_PROTOCOL_OpenPGP+fromProtocol UNKNOWN = c'GPGME_PROTOCOL_UNKNOWN++fromSecret :: IncludeSecret -> CInt+fromSecret WithSecret = 1+fromSecret NoSecret = 0++fromFlag :: Flag -> CUInt+fromFlag AlwaysTrust = c'GPGME_ENCRYPT_ALWAYS_TRUST+fromFlag NoFlag = 0
src/Crypto/Gpgme/Key.hs view
@@ -19,11 +19,11 @@ -> Fpr -- ^ fingerprint -> IncludeSecret -- ^ whether to include secrets when searching for the key -> IO (Maybe Key)-getKey (Ctx ctxPtr _) fpr (IncludeSecret is) = do+getKey (Ctx ctxPtr _) fpr secret = do keyPtr <- malloc ret <- BS.useAsCString fpr $ \cFpr -> peek ctxPtr >>= \ctx ->- c'gpgme_get_key ctx cFpr keyPtr is+ c'gpgme_get_key ctx cFpr keyPtr (fromSecret secret) if ret == noError then return . Just . Key $ keyPtr else free keyPtr >> return Nothing
src/Crypto/Gpgme/Types.hs view
@@ -2,15 +2,14 @@ import Bindings.Gpgme import qualified Data.ByteString as BS-import Foreign.C.Types (CInt, CUInt) import Foreign -- | the protocol to be used in the crypto engine-newtype Protocol = Protocol Int--openPGP :: Protocol -openPGP = Protocol c'GPGME_PROTOCOL_OpenPGP--- TODO other protocols+data Protocol =+ CMS+ | GPGCONF+ | OpenPGP+ | UNKNOWN -- | Context to be passed around with operations. Use 'newCtx' or -- 'withCtx' in order to obtain an instance.@@ -19,8 +18,13 @@ , _version :: String } +-- | a fingerprint type Fpr = BS.ByteString++-- | a plaintext type Plain = BS.ByteString++-- | an ciphertext type Encrypted = BS.ByteString -- | The fingerprint and an error code@@ -31,23 +35,13 @@ newtype Key = Key { unKey :: Ptr C'gpgme_key_t } -- | Whether to include secret keys when searching-newtype IncludeSecret = IncludeSecret CInt---- | do not consider secret keys when searching-noSecret :: IncludeSecret-noSecret = IncludeSecret 0---- | consider secret keys when searching-secret :: IncludeSecret-secret = IncludeSecret 1--newtype Flag = Flag CUInt--alwaysTrust :: Flag-alwaysTrust = Flag c'GPGME_ENCRYPT_ALWAYS_TRUST+data IncludeSecret =+ WithSecret -- ^ do not include secret keys+ | NoSecret -- ^ include secret keys -noFlag :: Flag-noFlag = Flag 0+data Flag =+ AlwaysTrust+ | NoFlag -- | error indicating what went wrong in decryption data DecryptError =
test/Main.hs view
@@ -6,6 +6,7 @@ import CtxTest import CryptoTest +main :: IO () main = defaultMain [ testGroup "key" KeyTest.tests , testGroup "ctx" CtxTest.tests