module Crypto.Gpgme.Crypto (

      encrypt
    , encryptSign
    , encryptFd
    , encryptSignFd
    , encrypt'
    , encryptSign'
    , decrypt
    , decryptFd
    , decryptVerifyFd
    , decrypt'
    , decryptVerify
    , decryptVerify'
    , verify
    , verify'
    , verifyDetached
    , verifyDetached'
    , verifyPlain
    , verifyPlain'
    , sign

) where

import System.Posix.Types (Fd(Fd))
import Bindings.Gpgme
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as C8
import Control.Monad.Trans.Except (ExceptT(ExceptT), runExceptT, mapExceptT)
import Foreign
import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
import GHC.Ptr

import Crypto.Gpgme.Ctx
import Crypto.Gpgme.Internal
import Crypto.Gpgme.Key
import Crypto.Gpgme.Types

locale :: String
locale :: String
locale = String
"C"

-- | Convenience wrapper around 'withCtx' and 'withKey' to
--   encrypt a single plaintext for a single recipient with
--   its homedirectory.
encrypt' :: String -> Fpr -> Plain -> IO (Either String Encrypted)
encrypt' :: String -> Fpr -> Fpr -> IO (Either String Fpr)
encrypt' = (Ctx -> [Key] -> Flag -> Fpr -> IO (Either [InvalidKey] Fpr))
-> String -> Fpr -> Fpr -> IO (Either String Fpr)
encryptIntern' Ctx -> [Key] -> Flag -> Fpr -> IO (Either [InvalidKey] Fpr)
encrypt

-- | Convenience wrapper around 'withCtx' and 'withKey' to
--   encrypt and sign a single plaintext for a single recipient
--   with its homedirectory.
encryptSign' :: String -> Fpr -> Plain -> IO (Either String Encrypted)
encryptSign' :: String -> Fpr -> Fpr -> IO (Either String Fpr)
encryptSign' = (Ctx -> [Key] -> Flag -> Fpr -> IO (Either [InvalidKey] Fpr))
-> String -> Fpr -> Fpr -> IO (Either String Fpr)
encryptIntern' Ctx -> [Key] -> Flag -> Fpr -> IO (Either [InvalidKey] Fpr)
encryptSign

orElse :: Monad m => m (Maybe a) -> e -> ExceptT e m a
orElse :: m (Maybe a) -> e -> ExceptT e m a
orElse m (Maybe a)
action e
err = m (Either e a) -> ExceptT e m a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either e a) -> ExceptT e m a)
-> m (Either e a) -> ExceptT e m a
forall a b. (a -> b) -> a -> b
$ Either e a -> (a -> Either e a) -> Maybe a -> Either e a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (e -> Either e a
forall a b. a -> Either a b
Left e
err) a -> Either e a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> Either e a) -> m (Maybe a) -> m (Either e a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` m (Maybe a)
action

bimapExceptT :: Functor m => (x -> y) -> (a -> b) -> ExceptT x m a -> ExceptT y m b
bimapExceptT :: (x -> y) -> (a -> b) -> ExceptT x m a -> ExceptT y m b
bimapExceptT x -> y
f a -> b
g = (m (Either x a) -> m (Either y b))
-> ExceptT x m a -> ExceptT y m b
forall (m :: * -> *) e a (n :: * -> *) e' b.
(m (Either e a) -> n (Either e' b))
-> ExceptT e m a -> ExceptT e' n b
mapExceptT ((Either x a -> Either y b) -> m (Either x a) -> m (Either y b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either x a -> Either y b
h)
  where
    h :: Either x a -> Either y b
h (Left  x
e) = y -> Either y b
forall a b. a -> Either a b
Left  (x -> y
f x
e)
    h (Right a
a) = b -> Either y b
forall a b. b -> Either a b
Right (a -> b
g a
a)

encryptIntern' :: (Ctx -> [Key] -> Flag -> Plain
                        -> IO (Either [InvalidKey] Encrypted)
                    ) -> String -> Fpr -> Plain -> IO (Either String Encrypted)
encryptIntern' :: (Ctx -> [Key] -> Flag -> Fpr -> IO (Either [InvalidKey] Fpr))
-> String -> Fpr -> Fpr -> IO (Either String Fpr)
encryptIntern' Ctx -> [Key] -> Flag -> Fpr -> IO (Either [InvalidKey] Fpr)
encrFun String
gpgDir Fpr
recFpr Fpr
plain =
    String
-> String
-> Protocol
-> (Ctx -> IO (Either String Fpr))
-> IO (Either String Fpr)
forall a. String -> String -> Protocol -> (Ctx -> IO a) -> IO a
withCtx String
gpgDir String
locale Protocol
OpenPGP ((Ctx -> IO (Either String Fpr)) -> IO (Either String Fpr))
-> (Ctx -> IO (Either String Fpr)) -> IO (Either String Fpr)
forall a b. (a -> b) -> a -> b
$ \Ctx
ctx -> ExceptT String IO Fpr -> IO (Either String Fpr)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT String IO Fpr -> IO (Either String Fpr))
-> ExceptT String IO Fpr -> IO (Either String Fpr)
forall a b. (a -> b) -> a -> b
$
        do Key
pubKey <- Ctx -> Fpr -> IncludeSecret -> IO (Maybe Key)
getKey Ctx
ctx Fpr
recFpr IncludeSecret
NoSecret IO (Maybe Key) -> String -> ExceptT String IO Key
forall (m :: * -> *) a e.
Monad m =>
m (Maybe a) -> e -> ExceptT e m a
`orElse` (String
"no such key: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Fpr -> String
forall a. Show a => a -> String
show Fpr
recFpr)
           ([InvalidKey] -> String)
-> (Fpr -> Fpr)
-> ExceptT [InvalidKey] IO Fpr
-> ExceptT String IO Fpr
forall (m :: * -> *) x y a b.
Functor m =>
(x -> y) -> (a -> b) -> ExceptT x m a -> ExceptT y m b
bimapExceptT [InvalidKey] -> String
forall a. Show a => a -> String
show Fpr -> Fpr
forall a. a -> a
id (ExceptT [InvalidKey] IO Fpr -> ExceptT String IO Fpr)
-> ExceptT [InvalidKey] IO Fpr -> ExceptT String IO Fpr
forall a b. (a -> b) -> a -> b
$ IO (Either [InvalidKey] Fpr) -> ExceptT [InvalidKey] IO Fpr
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either [InvalidKey] Fpr) -> ExceptT [InvalidKey] IO Fpr)
-> IO (Either [InvalidKey] Fpr) -> ExceptT [InvalidKey] IO Fpr
forall a b. (a -> b) -> a -> b
$ Ctx -> [Key] -> Flag -> Fpr -> IO (Either [InvalidKey] Fpr)
encrFun Ctx
ctx [Key
pubKey] Flag
NoFlag Fpr
plain

-- | encrypt for a list of recipients
encrypt :: Ctx -> [Key] -> Flag -> Plain -> IO (Either [InvalidKey] Encrypted)
encrypt :: Ctx -> [Key] -> Flag -> Fpr -> IO (Either [InvalidKey] Fpr)
encrypt = (C'gpgme_ctx_t
 -> Ptr C'gpgme_key_t
 -> C'gpgme_encrypt_flags_t
 -> C'gpgme_ctx_t
 -> C'gpgme_ctx_t
 -> IO C'gpgme_encrypt_flags_t)
-> Ctx -> [Key] -> Flag -> Fpr -> IO (Either [InvalidKey] Fpr)
encryptIntern C'gpgme_ctx_t
-> Ptr C'gpgme_key_t
-> C'gpgme_encrypt_flags_t
-> C'gpgme_ctx_t
-> C'gpgme_ctx_t
-> IO C'gpgme_encrypt_flags_t
c'gpgme_op_encrypt

-- | encrypt and sign for a list of recipients
encryptSign :: Ctx -> [Key] -> Flag -> Plain -> IO (Either [InvalidKey] Encrypted) 
encryptSign :: Ctx -> [Key] -> Flag -> Fpr -> IO (Either [InvalidKey] Fpr)
encryptSign = (C'gpgme_ctx_t
 -> Ptr C'gpgme_key_t
 -> C'gpgme_encrypt_flags_t
 -> C'gpgme_ctx_t
 -> C'gpgme_ctx_t
 -> IO C'gpgme_encrypt_flags_t)
-> Ctx -> [Key] -> Flag -> Fpr -> IO (Either [InvalidKey] Fpr)
encryptIntern C'gpgme_ctx_t
-> Ptr C'gpgme_key_t
-> C'gpgme_encrypt_flags_t
-> C'gpgme_ctx_t
-> C'gpgme_ctx_t
-> IO C'gpgme_encrypt_flags_t
c'gpgme_op_encrypt_sign

encryptIntern :: (C'gpgme_ctx_t
                    -> GHC.Ptr.Ptr C'gpgme_key_t
                    -> C'gpgme_encrypt_flags_t
                    -> C'gpgme_data_t
                    -> C'gpgme_data_t
                    -> IO C'gpgme_error_t
                  )
                  -> Ctx
                  -> [Key]
                  -> Flag
                  -> Plain
                  -> IO (Either [InvalidKey] Encrypted) 
encryptIntern :: (C'gpgme_ctx_t
 -> Ptr C'gpgme_key_t
 -> C'gpgme_encrypt_flags_t
 -> C'gpgme_ctx_t
 -> C'gpgme_ctx_t
 -> IO C'gpgme_encrypt_flags_t)
-> Ctx -> [Key] -> Flag -> Fpr -> IO (Either [InvalidKey] Fpr)
encryptIntern C'gpgme_ctx_t
-> Ptr C'gpgme_key_t
-> C'gpgme_encrypt_flags_t
-> C'gpgme_ctx_t
-> C'gpgme_ctx_t
-> IO C'gpgme_encrypt_flags_t
enc_op Ctx {_ctx :: Ctx -> Ptr C'gpgme_ctx_t
_ctx=Ptr C'gpgme_ctx_t
ctxPtr} [Key]
recPtrs Flag
flag Fpr
plain = do
    -- init buffer with plaintext
    Ptr C'gpgme_ctx_t
plainBufPtr <- IO (Ptr C'gpgme_ctx_t)
forall a. Storable a => IO (Ptr a)
malloc
    Fpr -> (CString -> IO ()) -> IO ()
forall a. Fpr -> (CString -> IO a) -> IO a
BS.useAsCString Fpr
plain ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
bs -> do
        let copyData :: CInt
copyData = CInt
1 -- gpgme shall copy data, as bytestring will free it
        let plainlen :: CSize
plainlen = Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Fpr -> Int
BS.length Fpr
plain)
        C'gpgme_encrypt_flags_t
ret <- Ptr C'gpgme_ctx_t
-> CString -> CSize -> CInt -> IO C'gpgme_encrypt_flags_t
c'gpgme_data_new_from_mem Ptr C'gpgme_ctx_t
plainBufPtr CString
bs CSize
plainlen CInt
copyData
        String -> C'gpgme_encrypt_flags_t -> IO ()
checkError String
"data_new_from_mem" C'gpgme_encrypt_flags_t
ret
    C'gpgme_ctx_t
plainBuf <- Ptr C'gpgme_ctx_t -> IO C'gpgme_ctx_t
forall a. Storable a => Ptr a -> IO a
peek Ptr C'gpgme_ctx_t
plainBufPtr

    -- init buffer for result
    Ptr C'gpgme_ctx_t
resultBufPtr <- IO (Ptr C'gpgme_ctx_t)
newDataBuffer
    C'gpgme_ctx_t
resultBuf <- Ptr C'gpgme_ctx_t -> IO C'gpgme_ctx_t
forall a. Storable a => Ptr a -> IO a
peek Ptr C'gpgme_ctx_t
resultBufPtr

    C'gpgme_ctx_t
ctx <- Ptr C'gpgme_ctx_t -> IO C'gpgme_ctx_t
forall a. Storable a => Ptr a -> IO a
peek Ptr C'gpgme_ctx_t
ctxPtr

    -- encrypt
    [Key] -> (Ptr C'gpgme_key_t -> IO ()) -> IO ()
forall a. [Key] -> (Ptr C'gpgme_key_t -> IO a) -> IO a
withKeyPtrArray [Key]
recPtrs ((Ptr C'gpgme_key_t -> IO ()) -> IO ())
-> (Ptr C'gpgme_key_t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr C'gpgme_key_t
recArray -> 
        String -> C'gpgme_encrypt_flags_t -> IO ()
checkError String
"op_encrypt" (C'gpgme_encrypt_flags_t -> IO ())
-> IO C'gpgme_encrypt_flags_t -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< C'gpgme_ctx_t
-> Ptr C'gpgme_key_t
-> C'gpgme_encrypt_flags_t
-> C'gpgme_ctx_t
-> C'gpgme_ctx_t
-> IO C'gpgme_encrypt_flags_t
enc_op C'gpgme_ctx_t
ctx Ptr C'gpgme_key_t
recArray (Flag -> C'gpgme_encrypt_flags_t
fromFlag Flag
flag)
                                        C'gpgme_ctx_t
plainBuf C'gpgme_ctx_t
resultBuf
    Ptr C'gpgme_ctx_t -> IO ()
forall a. Ptr a -> IO ()
free Ptr C'gpgme_ctx_t
plainBufPtr

    -- check whether all keys could be used for encryption
    C'gpgme_encrypt_result_t
encResPtr <- C'gpgme_ctx_t -> IO C'gpgme_encrypt_result_t
c'gpgme_op_encrypt_result C'gpgme_ctx_t
ctx
    C'_gpgme_op_encrypt_result
encRes <- C'gpgme_encrypt_result_t -> IO C'_gpgme_op_encrypt_result
forall a. Storable a => Ptr a -> IO a
peek C'gpgme_encrypt_result_t
encResPtr
    let recPtr :: C'gpgme_invalid_key_t
recPtr = C'_gpgme_op_encrypt_result -> C'gpgme_invalid_key_t
c'_gpgme_op_encrypt_result'invalid_recipients C'_gpgme_op_encrypt_result
encRes

    let res :: Either [InvalidKey] Fpr
res = if C'gpgme_invalid_key_t
recPtr C'gpgme_invalid_key_t -> C'gpgme_invalid_key_t -> Bool
forall a. Eq a => a -> a -> Bool
/= C'gpgme_invalid_key_t
forall a. Ptr a
nullPtr
                then [InvalidKey] -> Either [InvalidKey] Fpr
forall a b. a -> Either a b
Left (C'gpgme_invalid_key_t -> [InvalidKey]
collectFprs C'gpgme_invalid_key_t
recPtr)
                else Fpr -> Either [InvalidKey] Fpr
forall a b. b -> Either a b
Right (C'gpgme_ctx_t -> Fpr
collectResult C'gpgme_ctx_t
resultBuf)

    Ptr C'gpgme_ctx_t -> IO ()
forall a. Ptr a -> IO ()
free Ptr C'gpgme_ctx_t
resultBufPtr

    Either [InvalidKey] Fpr -> IO (Either [InvalidKey] Fpr)
forall (m :: * -> *) a. Monad m => a -> m a
return Either [InvalidKey] Fpr
res

-- | Encrypt plaintext
encryptFd :: Ctx -> [Key] -> Flag -> Fd -> Fd -> IO (Either [InvalidKey] ())
encryptFd :: Ctx -> [Key] -> Flag -> Fd -> Fd -> IO (Either [InvalidKey] ())
encryptFd = (C'gpgme_ctx_t
 -> Ptr C'gpgme_key_t
 -> C'gpgme_encrypt_flags_t
 -> C'gpgme_ctx_t
 -> C'gpgme_ctx_t
 -> IO C'gpgme_encrypt_flags_t)
-> Ctx -> [Key] -> Flag -> Fd -> Fd -> IO (Either [InvalidKey] ())
encryptFdIntern C'gpgme_ctx_t
-> Ptr C'gpgme_key_t
-> C'gpgme_encrypt_flags_t
-> C'gpgme_ctx_t
-> C'gpgme_ctx_t
-> IO C'gpgme_encrypt_flags_t
c'gpgme_op_encrypt

-- | Encrypt and sign plaintext
encryptSignFd :: Ctx -> [Key] -> Flag -> Fd -> Fd -> IO (Either [InvalidKey] ())
encryptSignFd :: Ctx -> [Key] -> Flag -> Fd -> Fd -> IO (Either [InvalidKey] ())
encryptSignFd = (C'gpgme_ctx_t
 -> Ptr C'gpgme_key_t
 -> C'gpgme_encrypt_flags_t
 -> C'gpgme_ctx_t
 -> C'gpgme_ctx_t
 -> IO C'gpgme_encrypt_flags_t)
-> Ctx -> [Key] -> Flag -> Fd -> Fd -> IO (Either [InvalidKey] ())
encryptFdIntern C'gpgme_ctx_t
-> Ptr C'gpgme_key_t
-> C'gpgme_encrypt_flags_t
-> C'gpgme_ctx_t
-> C'gpgme_ctx_t
-> IO C'gpgme_encrypt_flags_t
c'gpgme_op_encrypt_sign

encryptFdIntern :: (C'gpgme_ctx_t
                 -> GHC.Ptr.Ptr C'gpgme_key_t
                 -> C'gpgme_encrypt_flags_t
                 -> C'gpgme_data_t
                 -> C'gpgme_data_t
                 -> IO C'gpgme_error_t
               )
               -> Ctx
               -> [Key]
               -> Flag
               -> Fd  -- ^ Plaintext data
               -> Fd  -- ^ Ciphertext data
               -> IO (Either [InvalidKey] ())
encryptFdIntern :: (C'gpgme_ctx_t
 -> Ptr C'gpgme_key_t
 -> C'gpgme_encrypt_flags_t
 -> C'gpgme_ctx_t
 -> C'gpgme_ctx_t
 -> IO C'gpgme_encrypt_flags_t)
-> Ctx -> [Key] -> Flag -> Fd -> Fd -> IO (Either [InvalidKey] ())
encryptFdIntern C'gpgme_ctx_t
-> Ptr C'gpgme_key_t
-> C'gpgme_encrypt_flags_t
-> C'gpgme_ctx_t
-> C'gpgme_ctx_t
-> IO C'gpgme_encrypt_flags_t
enc_op Ctx {_ctx :: Ctx -> Ptr C'gpgme_ctx_t
_ctx=Ptr C'gpgme_ctx_t
ctxPtr} [Key]
recPtrs Flag
flag (Fd CInt
plainCInt) (Fd CInt
cipherCInt) = do
  -- Initialize plaintext buffer
  Ptr C'gpgme_ctx_t
plainBufPtr <- IO (Ptr C'gpgme_ctx_t)
forall a. Storable a => IO (Ptr a)
malloc
  C'gpgme_encrypt_flags_t
_ <- Ptr C'gpgme_ctx_t -> CInt -> IO C'gpgme_encrypt_flags_t
c'gpgme_data_new_from_fd Ptr C'gpgme_ctx_t
plainBufPtr CInt
plainCInt
  C'gpgme_ctx_t
plainBuf <- Ptr C'gpgme_ctx_t -> IO C'gpgme_ctx_t
forall a. Storable a => Ptr a -> IO a
peek Ptr C'gpgme_ctx_t
plainBufPtr

  -- Initialize ciphertext buffer
  Ptr C'gpgme_ctx_t
cipherBufPtr <- IO (Ptr C'gpgme_ctx_t)
forall a. Storable a => IO (Ptr a)
malloc
  C'gpgme_encrypt_flags_t
_ <- Ptr C'gpgme_ctx_t -> CInt -> IO C'gpgme_encrypt_flags_t
c'gpgme_data_new_from_fd Ptr C'gpgme_ctx_t
cipherBufPtr CInt
cipherCInt
  C'gpgme_ctx_t
cipherBuf <- Ptr C'gpgme_ctx_t -> IO C'gpgme_ctx_t
forall a. Storable a => Ptr a -> IO a
peek Ptr C'gpgme_ctx_t
cipherBufPtr

  C'gpgme_ctx_t
ctx <- Ptr C'gpgme_ctx_t -> IO C'gpgme_ctx_t
forall a. Storable a => Ptr a -> IO a
peek Ptr C'gpgme_ctx_t
ctxPtr

  -- encrypt
  [Key] -> (Ptr C'gpgme_key_t -> IO ()) -> IO ()
forall a. [Key] -> (Ptr C'gpgme_key_t -> IO a) -> IO a
withKeyPtrArray [Key]
recPtrs ((Ptr C'gpgme_key_t -> IO ()) -> IO ())
-> (Ptr C'gpgme_key_t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr C'gpgme_key_t
recArray ->
      String -> C'gpgme_encrypt_flags_t -> IO ()
checkError String
"op_encrypt" (C'gpgme_encrypt_flags_t -> IO ())
-> IO C'gpgme_encrypt_flags_t -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< C'gpgme_ctx_t
-> Ptr C'gpgme_key_t
-> C'gpgme_encrypt_flags_t
-> C'gpgme_ctx_t
-> C'gpgme_ctx_t
-> IO C'gpgme_encrypt_flags_t
enc_op C'gpgme_ctx_t
ctx Ptr C'gpgme_key_t
recArray (Flag -> C'gpgme_encrypt_flags_t
fromFlag Flag
flag)
                                      C'gpgme_ctx_t
plainBuf C'gpgme_ctx_t
cipherBuf
  Ptr C'gpgme_ctx_t -> IO ()
forall a. Ptr a -> IO ()
free Ptr C'gpgme_ctx_t
plainBufPtr

  -- check whether all keys could be used for encryption
  C'gpgme_encrypt_result_t
encResPtr <- C'gpgme_ctx_t -> IO C'gpgme_encrypt_result_t
c'gpgme_op_encrypt_result C'gpgme_ctx_t
ctx
  C'_gpgme_op_encrypt_result
encRes <- C'gpgme_encrypt_result_t -> IO C'_gpgme_op_encrypt_result
forall a. Storable a => Ptr a -> IO a
peek C'gpgme_encrypt_result_t
encResPtr
  let recPtr :: C'gpgme_invalid_key_t
recPtr = C'_gpgme_op_encrypt_result -> C'gpgme_invalid_key_t
c'_gpgme_op_encrypt_result'invalid_recipients C'_gpgme_op_encrypt_result
encRes

  let res :: Either [InvalidKey] ()
res = if C'gpgme_invalid_key_t
recPtr C'gpgme_invalid_key_t -> C'gpgme_invalid_key_t -> Bool
forall a. Eq a => a -> a -> Bool
/= C'gpgme_invalid_key_t
forall a. Ptr a
nullPtr
              then [InvalidKey] -> Either [InvalidKey] ()
forall a b. a -> Either a b
Left (C'gpgme_invalid_key_t -> [InvalidKey]
collectFprs C'gpgme_invalid_key_t
recPtr)
              else () -> Either [InvalidKey] ()
forall a b. b -> Either a b
Right ()

  Ptr C'gpgme_ctx_t -> IO ()
forall a. Ptr a -> IO ()
free Ptr C'gpgme_ctx_t
cipherBufPtr

  Either [InvalidKey] () -> IO (Either [InvalidKey] ())
forall (m :: * -> *) a. Monad m => a -> m a
return Either [InvalidKey] ()
res

-- | Build a null-terminated array of pointers from a list of 'Key's
withKeyPtrArray :: [Key] -> (Ptr C'gpgme_key_t -> IO a) -> IO a
withKeyPtrArray :: [Key] -> (Ptr C'gpgme_key_t -> IO a) -> IO a
withKeyPtrArray [] Ptr C'gpgme_key_t -> IO a
f   = Ptr C'gpgme_key_t -> IO a
f Ptr C'gpgme_key_t
forall a. Ptr a
nullPtr
withKeyPtrArray [Key]
keys Ptr C'gpgme_key_t -> IO a
f = do
    Ptr C'gpgme_key_t
arr <- C'gpgme_key_t -> [C'gpgme_key_t] -> IO (Ptr C'gpgme_key_t)
forall a. Storable a => a -> [a] -> IO (Ptr a)
newArray0 C'gpgme_key_t
forall a. Ptr a
nullPtr ([C'gpgme_key_t] -> IO (Ptr C'gpgme_key_t))
-> IO [C'gpgme_key_t] -> IO (Ptr C'gpgme_key_t)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Key -> IO C'gpgme_key_t) -> [Key] -> IO [C'gpgme_key_t]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Ptr C'gpgme_key_t -> IO C'gpgme_key_t
forall a. Storable a => Ptr a -> IO a
peek (Ptr C'gpgme_key_t -> IO C'gpgme_key_t)
-> (Key -> Ptr C'gpgme_key_t) -> Key -> IO C'gpgme_key_t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignPtr C'gpgme_key_t -> Ptr C'gpgme_key_t
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr (ForeignPtr C'gpgme_key_t -> Ptr C'gpgme_key_t)
-> (Key -> ForeignPtr C'gpgme_key_t) -> Key -> Ptr C'gpgme_key_t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> ForeignPtr C'gpgme_key_t
unKey) [Key]
keys
    Ptr C'gpgme_key_t -> IO a
f Ptr C'gpgme_key_t
arr

-- | Convenience wrapper around 'withCtx' and 'withKey' to
--   decrypt a single ciphertext with its homedirectory.
decrypt' :: String -> Encrypted -> IO (Either DecryptError Plain)
decrypt' :: String -> Fpr -> IO (Either DecryptError Fpr)
decrypt' = (Ctx -> Fpr -> IO (Either DecryptError Fpr))
-> String -> Fpr -> IO (Either DecryptError Fpr)
decryptInternal' Ctx -> Fpr -> IO (Either DecryptError Fpr)
decrypt

-- | Convenience wrapper around 'withCtx' and 'withKey' to
--   decrypt and verify a single ciphertext with its homedirectory.
decryptVerify' :: String -> Encrypted -> IO (Either DecryptError Plain)
decryptVerify' :: String -> Fpr -> IO (Either DecryptError Fpr)
decryptVerify' = (Ctx -> Fpr -> IO (Either DecryptError Fpr))
-> String -> Fpr -> IO (Either DecryptError Fpr)
decryptInternal' Ctx -> Fpr -> IO (Either DecryptError Fpr)
decryptVerify

decryptInternal' :: (Ctx -> Encrypted -> IO (Either DecryptError Plain))
                  -> String
                  -> Encrypted
                  -> IO (Either DecryptError Plain)
decryptInternal' :: (Ctx -> Fpr -> IO (Either DecryptError Fpr))
-> String -> Fpr -> IO (Either DecryptError Fpr)
decryptInternal' Ctx -> Fpr -> IO (Either DecryptError Fpr)
decrFun String
gpgDir Fpr
cipher =
    String
-> String
-> Protocol
-> (Ctx -> IO (Either DecryptError Fpr))
-> IO (Either DecryptError Fpr)
forall a. String -> String -> Protocol -> (Ctx -> IO a) -> IO a
withCtx String
gpgDir String
locale Protocol
OpenPGP ((Ctx -> IO (Either DecryptError Fpr))
 -> IO (Either DecryptError Fpr))
-> (Ctx -> IO (Either DecryptError Fpr))
-> IO (Either DecryptError Fpr)
forall a b. (a -> b) -> a -> b
$ \Ctx
ctx ->
        Ctx -> Fpr -> IO (Either DecryptError Fpr)
decrFun Ctx
ctx Fpr
cipher

-- | Decrypts a ciphertext
decrypt :: Ctx -> Encrypted -> IO (Either DecryptError Plain)
decrypt :: Ctx -> Fpr -> IO (Either DecryptError Fpr)
decrypt = (C'gpgme_ctx_t
 -> C'gpgme_ctx_t -> C'gpgme_ctx_t -> IO C'gpgme_encrypt_flags_t)
-> Ctx -> Fpr -> IO (Either DecryptError Fpr)
decryptIntern C'gpgme_ctx_t
-> C'gpgme_ctx_t -> C'gpgme_ctx_t -> IO C'gpgme_encrypt_flags_t
c'gpgme_op_decrypt

-- | Decrypts and verifies a ciphertext
decryptVerify :: Ctx -> Encrypted -> IO (Either DecryptError Plain)
decryptVerify :: Ctx -> Fpr -> IO (Either DecryptError Fpr)
decryptVerify = (C'gpgme_ctx_t
 -> C'gpgme_ctx_t -> C'gpgme_ctx_t -> IO C'gpgme_encrypt_flags_t)
-> Ctx -> Fpr -> IO (Either DecryptError Fpr)
decryptIntern C'gpgme_ctx_t
-> C'gpgme_ctx_t -> C'gpgme_ctx_t -> IO C'gpgme_encrypt_flags_t
c'gpgme_op_decrypt_verify

decryptIntern :: (C'gpgme_ctx_t
                    -> C'gpgme_data_t
                    -> C'gpgme_data_t
                    -> IO C'gpgme_error_t
                  )
                  -> Ctx
                  -> Encrypted
                  -> IO (Either DecryptError Plain)
decryptIntern :: (C'gpgme_ctx_t
 -> C'gpgme_ctx_t -> C'gpgme_ctx_t -> IO C'gpgme_encrypt_flags_t)
-> Ctx -> Fpr -> IO (Either DecryptError Fpr)
decryptIntern C'gpgme_ctx_t
-> C'gpgme_ctx_t -> C'gpgme_ctx_t -> IO C'gpgme_encrypt_flags_t
dec_op Ctx {_ctx :: Ctx -> Ptr C'gpgme_ctx_t
_ctx=Ptr C'gpgme_ctx_t
ctxPtr} Fpr
cipher = do
    -- init buffer with cipher
    Ptr C'gpgme_ctx_t
cipherBufPtr <- IO (Ptr C'gpgme_ctx_t)
forall a. Storable a => IO (Ptr a)
malloc
    Fpr -> (CString -> IO ()) -> IO ()
forall a. Fpr -> (CString -> IO a) -> IO a
BS.useAsCString Fpr
cipher ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
bs -> do
        let copyData :: CInt
copyData = CInt
1 -- gpgme shall copy data, as bytestring will free it
        let cipherlen :: CSize
cipherlen = Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Fpr -> Int
BS.length Fpr
cipher)
        C'gpgme_encrypt_flags_t
ret <- Ptr C'gpgme_ctx_t
-> CString -> CSize -> CInt -> IO C'gpgme_encrypt_flags_t
c'gpgme_data_new_from_mem Ptr C'gpgme_ctx_t
cipherBufPtr CString
bs CSize
cipherlen CInt
copyData
        String -> C'gpgme_encrypt_flags_t -> IO ()
checkError String
"data_new_from_mem" C'gpgme_encrypt_flags_t
ret
    C'gpgme_ctx_t
cipherBuf <- Ptr C'gpgme_ctx_t -> IO C'gpgme_ctx_t
forall a. Storable a => Ptr a -> IO a
peek Ptr C'gpgme_ctx_t
cipherBufPtr

    -- init buffer for result
    Ptr C'gpgme_ctx_t
resultBufPtr <- IO (Ptr C'gpgme_ctx_t)
newDataBuffer
    C'gpgme_ctx_t
resultBuf <- Ptr C'gpgme_ctx_t -> IO C'gpgme_ctx_t
forall a. Storable a => Ptr a -> IO a
peek Ptr C'gpgme_ctx_t
resultBufPtr

    C'gpgme_ctx_t
ctx <- Ptr C'gpgme_ctx_t -> IO C'gpgme_ctx_t
forall a. Storable a => Ptr a -> IO a
peek Ptr C'gpgme_ctx_t
ctxPtr

    -- decrypt
    C'gpgme_encrypt_flags_t
errcode <- C'gpgme_ctx_t
-> C'gpgme_ctx_t -> C'gpgme_ctx_t -> IO C'gpgme_encrypt_flags_t
dec_op C'gpgme_ctx_t
ctx C'gpgme_ctx_t
cipherBuf C'gpgme_ctx_t
resultBuf

    let res :: Either DecryptError Fpr
res = if C'gpgme_encrypt_flags_t
errcode C'gpgme_encrypt_flags_t -> C'gpgme_encrypt_flags_t -> Bool
forall a. Eq a => a -> a -> Bool
/= C'gpgme_encrypt_flags_t
forall a. Num a => a
noError
                then DecryptError -> Either DecryptError Fpr
forall a b. a -> Either a b
Left  (C'gpgme_encrypt_flags_t -> DecryptError
toDecryptError C'gpgme_encrypt_flags_t
errcode)
                else Fpr -> Either DecryptError Fpr
forall a b. b -> Either a b
Right (C'gpgme_ctx_t -> Fpr
collectResult C'gpgme_ctx_t
resultBuf)

    Ptr C'gpgme_ctx_t -> IO ()
forall a. Ptr a -> IO ()
free Ptr C'gpgme_ctx_t
cipherBufPtr
    Ptr C'gpgme_ctx_t -> IO ()
forall a. Ptr a -> IO ()
free Ptr C'gpgme_ctx_t
resultBufPtr

    Either DecryptError Fpr -> IO (Either DecryptError Fpr)
forall (m :: * -> *) a. Monad m => a -> m a
return Either DecryptError Fpr
res

-- | Decrypt a ciphertext
decryptFd :: Ctx -> Fd -> Fd -> IO (Either DecryptError ())
decryptFd :: Ctx -> Fd -> Fd -> IO (Either DecryptError ())
decryptFd = (C'gpgme_ctx_t
 -> C'gpgme_ctx_t -> C'gpgme_ctx_t -> IO C'gpgme_encrypt_flags_t)
-> Ctx -> Fd -> Fd -> IO (Either DecryptError ())
decryptFdIntern C'gpgme_ctx_t
-> C'gpgme_ctx_t -> C'gpgme_ctx_t -> IO C'gpgme_encrypt_flags_t
c'gpgme_op_decrypt

-- | Decrypt and verify ciphertext
decryptVerifyFd :: Ctx -> Fd -> Fd -> IO (Either DecryptError ())
decryptVerifyFd :: Ctx -> Fd -> Fd -> IO (Either DecryptError ())
decryptVerifyFd = (C'gpgme_ctx_t
 -> C'gpgme_ctx_t -> C'gpgme_ctx_t -> IO C'gpgme_encrypt_flags_t)
-> Ctx -> Fd -> Fd -> IO (Either DecryptError ())
decryptFdIntern C'gpgme_ctx_t
-> C'gpgme_ctx_t -> C'gpgme_ctx_t -> IO C'gpgme_encrypt_flags_t
c'gpgme_op_decrypt_verify

decryptFdIntern :: (C'gpgme_ctx_t
                    -> C'gpgme_data_t
                    -> C'gpgme_data_t
                    -> IO C'gpgme_error_t
                  )
                  -> Ctx
                  -> Fd
                  -> Fd
                  -> IO (Either DecryptError ())
decryptFdIntern :: (C'gpgme_ctx_t
 -> C'gpgme_ctx_t -> C'gpgme_ctx_t -> IO C'gpgme_encrypt_flags_t)
-> Ctx -> Fd -> Fd -> IO (Either DecryptError ())
decryptFdIntern C'gpgme_ctx_t
-> C'gpgme_ctx_t -> C'gpgme_ctx_t -> IO C'gpgme_encrypt_flags_t
dec_op Ctx {_ctx :: Ctx -> Ptr C'gpgme_ctx_t
_ctx=Ptr C'gpgme_ctx_t
ctxPtr} (Fd CInt
cipherCInt) (Fd CInt
plainCInt)= do
  -- Initialize ciphertext buffer
  Ptr C'gpgme_ctx_t
cipherBufPtr <- IO (Ptr C'gpgme_ctx_t)
forall a. Storable a => IO (Ptr a)
malloc
  C'gpgme_encrypt_flags_t
_ <- Ptr C'gpgme_ctx_t -> CInt -> IO C'gpgme_encrypt_flags_t
c'gpgme_data_new_from_fd Ptr C'gpgme_ctx_t
cipherBufPtr CInt
cipherCInt
  C'gpgme_ctx_t
cipherBuf <- Ptr C'gpgme_ctx_t -> IO C'gpgme_ctx_t
forall a. Storable a => Ptr a -> IO a
peek Ptr C'gpgme_ctx_t
cipherBufPtr

  -- Initialize plaintext buffer
  Ptr C'gpgme_ctx_t
plainBufPtr <- IO (Ptr C'gpgme_ctx_t)
forall a. Storable a => IO (Ptr a)
malloc
  C'gpgme_encrypt_flags_t
_ <- Ptr C'gpgme_ctx_t -> CInt -> IO C'gpgme_encrypt_flags_t
c'gpgme_data_new_from_fd Ptr C'gpgme_ctx_t
plainBufPtr CInt
plainCInt
  C'gpgme_ctx_t
plainBuf <- Ptr C'gpgme_ctx_t -> IO C'gpgme_ctx_t
forall a. Storable a => Ptr a -> IO a
peek Ptr C'gpgme_ctx_t
plainBufPtr

  C'gpgme_ctx_t
ctx <- Ptr C'gpgme_ctx_t -> IO C'gpgme_ctx_t
forall a. Storable a => Ptr a -> IO a
peek Ptr C'gpgme_ctx_t
ctxPtr

  -- decrypt
  C'gpgme_encrypt_flags_t
errcode <- C'gpgme_ctx_t
-> C'gpgme_ctx_t -> C'gpgme_ctx_t -> IO C'gpgme_encrypt_flags_t
dec_op C'gpgme_ctx_t
ctx C'gpgme_ctx_t
cipherBuf C'gpgme_ctx_t
plainBuf

  let res :: Either DecryptError ()
res = if C'gpgme_encrypt_flags_t
errcode C'gpgme_encrypt_flags_t -> C'gpgme_encrypt_flags_t -> Bool
forall a. Eq a => a -> a -> Bool
/= C'gpgme_encrypt_flags_t
forall a. Num a => a
noError
              then DecryptError -> Either DecryptError ()
forall a b. a -> Either a b
Left  (C'gpgme_encrypt_flags_t -> DecryptError
toDecryptError C'gpgme_encrypt_flags_t
errcode)
              else () -> Either DecryptError ()
forall a b. b -> Either a b
Right ()

  Ptr C'gpgme_ctx_t -> IO ()
forall a. Ptr a -> IO ()
free Ptr C'gpgme_ctx_t
cipherBufPtr
  Ptr C'gpgme_ctx_t -> IO ()
forall a. Ptr a -> IO ()
free Ptr C'gpgme_ctx_t
plainBufPtr

  Either DecryptError () -> IO (Either DecryptError ())
forall (m :: * -> *) a. Monad m => a -> m a
return Either DecryptError ()
res

-- | Sign plaintext for a list of signers
sign :: 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 :: Ctx -> [Key] -> SignMode -> Fpr -> IO (Either [InvalidKey] Fpr)
sign = (C'gpgme_ctx_t
 -> C'gpgme_ctx_t
 -> C'gpgme_ctx_t
 -> C'gpgme_encrypt_flags_t
 -> IO C'gpgme_encrypt_flags_t)
-> Ctx -> [Key] -> SignMode -> Fpr -> IO (Either [InvalidKey] Fpr)
signIntern C'gpgme_ctx_t
-> C'gpgme_ctx_t
-> C'gpgme_ctx_t
-> C'gpgme_encrypt_flags_t
-> IO C'gpgme_encrypt_flags_t
c'gpgme_op_sign

signIntern :: (    C'gpgme_ctx_t
                -> C'gpgme_data_t
                -> C'gpgme_data_t
                -> C'gpgme_sig_mode_t
                -> IO C'gpgme_error_t
              ) -- ^ c'gpgme_op_sign type signature
              -> Ctx
              -> [Key]
              -> SignMode
              -> Plain
              -> IO (Either [InvalidKey] Encrypted)
signIntern :: (C'gpgme_ctx_t
 -> C'gpgme_ctx_t
 -> C'gpgme_ctx_t
 -> C'gpgme_encrypt_flags_t
 -> IO C'gpgme_encrypt_flags_t)
-> Ctx -> [Key] -> SignMode -> Fpr -> IO (Either [InvalidKey] Fpr)
signIntern C'gpgme_ctx_t
-> C'gpgme_ctx_t
-> C'gpgme_ctx_t
-> C'gpgme_encrypt_flags_t
-> IO C'gpgme_encrypt_flags_t
sign_op Ctx {_ctx :: Ctx -> Ptr C'gpgme_ctx_t
_ctx=Ptr C'gpgme_ctx_t
ctxPtr} [Key]
signPtrs SignMode
mode Fpr
plain = do
    -- init buffer with plaintext
    Ptr C'gpgme_ctx_t
plainBufPtr <- IO (Ptr C'gpgme_ctx_t)
forall a. Storable a => IO (Ptr a)
malloc
    Fpr -> (CString -> IO ()) -> IO ()
forall a. Fpr -> (CString -> IO a) -> IO a
BS.useAsCString Fpr
plain ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
bs -> do
        let copyData :: CInt
copyData = CInt
1 -- gpgme shall copy data, as bytestring will free it
        let plainlen :: CSize
plainlen = Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Fpr -> Int
BS.length Fpr
plain)
        C'gpgme_encrypt_flags_t
ret <- Ptr C'gpgme_ctx_t
-> CString -> CSize -> CInt -> IO C'gpgme_encrypt_flags_t
c'gpgme_data_new_from_mem Ptr C'gpgme_ctx_t
plainBufPtr CString
bs CSize
plainlen CInt
copyData
        String -> C'gpgme_encrypt_flags_t -> IO ()
checkError String
"data_new_from_mem" C'gpgme_encrypt_flags_t
ret
    C'gpgme_ctx_t
plainBuf <- Ptr C'gpgme_ctx_t -> IO C'gpgme_ctx_t
forall a. Storable a => Ptr a -> IO a
peek Ptr C'gpgme_ctx_t
plainBufPtr

    -- init buffer for result
    Ptr C'gpgme_ctx_t
resultBufPtr <- IO (Ptr C'gpgme_ctx_t)
newDataBuffer
    C'gpgme_ctx_t
resultBuf <- Ptr C'gpgme_ctx_t -> IO C'gpgme_ctx_t
forall a. Storable a => Ptr a -> IO a
peek Ptr C'gpgme_ctx_t
resultBufPtr

    C'gpgme_ctx_t
ctx <- Ptr C'gpgme_ctx_t -> IO C'gpgme_ctx_t
forall a. Storable a => Ptr a -> IO a
peek Ptr C'gpgme_ctx_t
ctxPtr

    -- add signing keys
    (Key -> IO C'gpgme_encrypt_flags_t) -> [Key] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ( \Key
kForPtr -> ForeignPtr C'gpgme_key_t
-> (Ptr C'gpgme_key_t -> IO C'gpgme_encrypt_flags_t)
-> IO C'gpgme_encrypt_flags_t
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (Key -> ForeignPtr C'gpgme_key_t
unKey Key
kForPtr)
           (\Ptr C'gpgme_key_t
kPtr -> do
             C'gpgme_key_t
k <- Ptr C'gpgme_key_t -> IO C'gpgme_key_t
forall a. Storable a => Ptr a -> IO a
peek Ptr C'gpgme_key_t
kPtr
             C'gpgme_ctx_t -> C'gpgme_key_t -> IO C'gpgme_encrypt_flags_t
c'gpgme_signers_add C'gpgme_ctx_t
ctx C'gpgme_key_t
k
           )
         ) [Key]
signPtrs

    -- sign
    let modeCode :: C'gpgme_encrypt_flags_t
modeCode = case SignMode
mode of
                     SignMode
Normal -> C'gpgme_encrypt_flags_t
forall a. Num a => a
c'GPGME_SIG_MODE_NORMAL
                     SignMode
Detach -> C'gpgme_encrypt_flags_t
forall a. Num a => a
c'GPGME_SIG_MODE_DETACH
                     SignMode
Clear  -> C'gpgme_encrypt_flags_t
forall a. Num a => a
c'GPGME_SIG_MODE_CLEAR

    String -> C'gpgme_encrypt_flags_t -> IO ()
checkError String
"op_sign" (C'gpgme_encrypt_flags_t -> IO ())
-> IO C'gpgme_encrypt_flags_t -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< C'gpgme_ctx_t
-> C'gpgme_ctx_t
-> C'gpgme_ctx_t
-> C'gpgme_encrypt_flags_t
-> IO C'gpgme_encrypt_flags_t
sign_op C'gpgme_ctx_t
ctx C'gpgme_ctx_t
plainBuf C'gpgme_ctx_t
resultBuf C'gpgme_encrypt_flags_t
modeCode
    Ptr C'gpgme_ctx_t -> IO ()
forall a. Ptr a -> IO ()
free Ptr C'gpgme_ctx_t
plainBufPtr

    -- check whether all keys could be used for signingi
    C'gpgme_sign_result_t
signResPtr <- C'gpgme_ctx_t -> IO C'gpgme_sign_result_t
c'gpgme_op_sign_result C'gpgme_ctx_t
ctx
    C'_gpgme_op_sign_result
signRes <- C'gpgme_sign_result_t -> IO C'_gpgme_op_sign_result
forall a. Storable a => Ptr a -> IO a
peek C'gpgme_sign_result_t
signResPtr
    let recPtr :: C'gpgme_invalid_key_t
recPtr = C'_gpgme_op_sign_result -> C'gpgme_invalid_key_t
c'_gpgme_op_sign_result'invalid_signers C'_gpgme_op_sign_result
signRes

    let res :: Either [InvalidKey] Fpr
res = if C'gpgme_invalid_key_t
recPtr C'gpgme_invalid_key_t -> C'gpgme_invalid_key_t -> Bool
forall a. Eq a => a -> a -> Bool
/= C'gpgme_invalid_key_t
forall a. Ptr a
nullPtr
                then [InvalidKey] -> Either [InvalidKey] Fpr
forall a b. a -> Either a b
Left (C'gpgme_invalid_key_t -> [InvalidKey]
collectFprs C'gpgme_invalid_key_t
recPtr)
                else Fpr -> Either [InvalidKey] Fpr
forall a b. b -> Either a b
Right (C'gpgme_ctx_t -> Fpr
collectResult C'gpgme_ctx_t
resultBuf)

    Ptr C'gpgme_ctx_t -> IO ()
forall a. Ptr a -> IO ()
free Ptr C'gpgme_ctx_t
resultBufPtr

    Either [InvalidKey] Fpr -> IO (Either [InvalidKey] Fpr)
forall (m :: * -> *) a. Monad m => a -> m a
return Either [InvalidKey] Fpr
res


-- | Verify a payload with a detached signature
verifyDetached :: Ctx           -- ^ GPG context
               -> Signature     -- ^ Detached signature
               -> BS.ByteString -- ^ Signed text
               -> IO (Either GpgmeError VerificationResult)
verifyDetached :: Ctx -> Fpr -> Fpr -> IO (Either GpgmeError VerificationResult)
verifyDetached Ctx
ctx Fpr
sig Fpr
dat = do
    Either GpgmeError (VerificationResult, ())
res <- (C'gpgme_ctx_t
 -> C'gpgme_ctx_t
 -> C'gpgme_ctx_t
 -> IO (C'gpgme_encrypt_flags_t, ()))
-> Ctx
-> Fpr
-> Fpr
-> IO (Either GpgmeError (VerificationResult, ()))
forall a.
(C'gpgme_ctx_t
 -> C'gpgme_ctx_t
 -> C'gpgme_ctx_t
 -> IO (C'gpgme_encrypt_flags_t, a))
-> Ctx
-> Fpr
-> Fpr
-> IO (Either GpgmeError (VerificationResult, a))
verifyInternal C'gpgme_ctx_t
-> C'gpgme_ctx_t
-> C'gpgme_ctx_t
-> IO (C'gpgme_encrypt_flags_t, ())
go Ctx
ctx Fpr
sig Fpr
dat
    Either GpgmeError VerificationResult
-> IO (Either GpgmeError VerificationResult)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either GpgmeError VerificationResult
 -> IO (Either GpgmeError VerificationResult))
-> Either GpgmeError VerificationResult
-> IO (Either GpgmeError VerificationResult)
forall a b. (a -> b) -> a -> b
$ ((VerificationResult, ()) -> VerificationResult)
-> Either GpgmeError (VerificationResult, ())
-> Either GpgmeError VerificationResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (VerificationResult, ()) -> VerificationResult
forall a b. (a, b) -> a
fst Either GpgmeError (VerificationResult, ())
res
    where
        go :: C'gpgme_ctx_t
-> C'gpgme_ctx_t
-> C'gpgme_ctx_t
-> IO (C'gpgme_encrypt_flags_t, ())
go C'gpgme_ctx_t
ctx' C'gpgme_ctx_t
sig' C'gpgme_ctx_t
dat' = do
            C'gpgme_encrypt_flags_t
errcode <- C'gpgme_ctx_t
-> C'gpgme_ctx_t
-> C'gpgme_ctx_t
-> C'gpgme_ctx_t
-> IO C'gpgme_encrypt_flags_t
c'gpgme_op_verify C'gpgme_ctx_t
ctx' C'gpgme_ctx_t
sig' C'gpgme_ctx_t
dat' C'gpgme_ctx_t
0
            (C'gpgme_encrypt_flags_t, ()) -> IO (C'gpgme_encrypt_flags_t, ())
forall (m :: * -> *) a. Monad m => a -> m a
return (C'gpgme_encrypt_flags_t
errcode, ())

-- | Convenience wrapper around 'withCtx' to
--   verify a single detached signature with its homedirectory.
verifyDetached' :: String        -- ^ GPG context home directory
                -> Signature     -- ^ Detached signature
                -> BS.ByteString -- ^ Signed text
                -> IO (Either GpgmeError VerificationResult)
verifyDetached' :: String -> Fpr -> Fpr -> IO (Either GpgmeError VerificationResult)
verifyDetached' String
gpgDir Fpr
sig Fpr
dat =
    String
-> String
-> Protocol
-> (Ctx -> IO (Either GpgmeError VerificationResult))
-> IO (Either GpgmeError VerificationResult)
forall a. String -> String -> Protocol -> (Ctx -> IO a) -> IO a
withCtx String
gpgDir String
locale Protocol
OpenPGP ((Ctx -> IO (Either GpgmeError VerificationResult))
 -> IO (Either GpgmeError VerificationResult))
-> (Ctx -> IO (Either GpgmeError VerificationResult))
-> IO (Either GpgmeError VerificationResult)
forall a b. (a -> b) -> a -> b
$ \Ctx
ctx ->
        Ctx -> Fpr -> Fpr -> IO (Either GpgmeError VerificationResult)
verifyDetached Ctx
ctx Fpr
sig Fpr
dat

{-# DEPRECATED verifyPlain "Use verify" #-}
verifyPlain :: Ctx -> Signature -> BS.ByteString -> IO (Either GpgmeError (VerificationResult, BS.ByteString))
verifyPlain :: Ctx
-> Fpr -> Fpr -> IO (Either GpgmeError (VerificationResult, Fpr))
verifyPlain Ctx
c Fpr
s Fpr
_ = Ctx -> Fpr -> IO (Either GpgmeError (VerificationResult, Fpr))
verify Ctx
c Fpr
s
{-# DEPRECATED verifyPlain' "Use verify'" #-}
verifyPlain' :: String -> Signature -> BS.ByteString -> IO (Either GpgmeError (VerificationResult, BS.ByteString))
verifyPlain' :: String
-> Fpr -> Fpr -> IO (Either GpgmeError (VerificationResult, Fpr))
verifyPlain' String
str Fpr
sig Fpr
_ = String -> Fpr -> IO (Either GpgmeError (VerificationResult, Fpr))
verify' String
str Fpr
sig

-- | Verify a payload with a plain signature
verify :: Ctx -> Signature -> IO (Either GpgmeError (VerificationResult, BS.ByteString))
verify :: Ctx -> Fpr -> IO (Either GpgmeError (VerificationResult, Fpr))
verify Ctx
c Fpr
s = (C'gpgme_ctx_t
 -> C'gpgme_ctx_t
 -> C'gpgme_ctx_t
 -> IO (C'gpgme_encrypt_flags_t, Fpr))
-> Ctx
-> Fpr
-> Fpr
-> IO (Either GpgmeError (VerificationResult, Fpr))
forall a.
(C'gpgme_ctx_t
 -> C'gpgme_ctx_t
 -> C'gpgme_ctx_t
 -> IO (C'gpgme_encrypt_flags_t, a))
-> Ctx
-> Fpr
-> Fpr
-> IO (Either GpgmeError (VerificationResult, a))
verifyInternal C'gpgme_ctx_t
-> C'gpgme_ctx_t
-> C'gpgme_ctx_t
-> IO (C'gpgme_encrypt_flags_t, Fpr)
forall p.
C'gpgme_ctx_t
-> C'gpgme_ctx_t -> p -> IO (C'gpgme_encrypt_flags_t, Fpr)
go Ctx
c Fpr
s (String -> Fpr
C8.pack String
"")
    where
        go :: C'gpgme_ctx_t
-> C'gpgme_ctx_t -> p -> IO (C'gpgme_encrypt_flags_t, Fpr)
go C'gpgme_ctx_t
ctx C'gpgme_ctx_t
sig p
_ = do
            -- init buffer for result
            Ptr C'gpgme_ctx_t
resultBufPtr <- IO (Ptr C'gpgme_ctx_t)
newDataBuffer
            C'gpgme_ctx_t
resultBuf <- Ptr C'gpgme_ctx_t -> IO C'gpgme_ctx_t
forall a. Storable a => Ptr a -> IO a
peek Ptr C'gpgme_ctx_t
resultBufPtr

            C'gpgme_encrypt_flags_t
errcode <- C'gpgme_ctx_t
-> C'gpgme_ctx_t
-> C'gpgme_ctx_t
-> C'gpgme_ctx_t
-> IO C'gpgme_encrypt_flags_t
c'gpgme_op_verify C'gpgme_ctx_t
ctx C'gpgme_ctx_t
sig C'gpgme_ctx_t
0 C'gpgme_ctx_t
resultBuf

            let res :: Fpr
res = if C'gpgme_encrypt_flags_t
errcode C'gpgme_encrypt_flags_t -> C'gpgme_encrypt_flags_t -> Bool
forall a. Eq a => a -> a -> Bool
/= C'gpgme_encrypt_flags_t
forall a. Num a => a
noError
                        then Fpr
forall a. Monoid a => a
mempty
                        else C'gpgme_ctx_t -> Fpr
collectResult C'gpgme_ctx_t
resultBuf

            Ptr C'gpgme_ctx_t -> IO ()
forall a. Ptr a -> IO ()
free Ptr C'gpgme_ctx_t
resultBufPtr

            (C'gpgme_encrypt_flags_t, Fpr) -> IO (C'gpgme_encrypt_flags_t, Fpr)
forall (m :: * -> *) a. Monad m => a -> m a
return (C'gpgme_encrypt_flags_t
errcode, Fpr
res)

-- | Convenience wrapper around 'withCtx' to
--   verify a single plain signature with its homedirectory.
verify' :: String -> Signature -> IO (Either GpgmeError (VerificationResult, BS.ByteString))
verify' :: String -> Fpr -> IO (Either GpgmeError (VerificationResult, Fpr))
verify' String
gpgDir Fpr
sig =
    String
-> String
-> Protocol
-> (Ctx -> IO (Either GpgmeError (VerificationResult, Fpr)))
-> IO (Either GpgmeError (VerificationResult, Fpr))
forall a. String -> String -> Protocol -> (Ctx -> IO a) -> IO a
withCtx String
gpgDir String
locale Protocol
OpenPGP ((Ctx -> IO (Either GpgmeError (VerificationResult, Fpr)))
 -> IO (Either GpgmeError (VerificationResult, Fpr)))
-> (Ctx -> IO (Either GpgmeError (VerificationResult, Fpr)))
-> IO (Either GpgmeError (VerificationResult, Fpr))
forall a b. (a -> b) -> a -> b
$ \Ctx
ctx ->
        Ctx -> Fpr -> IO (Either GpgmeError (VerificationResult, Fpr))
verify Ctx
ctx Fpr
sig

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 :: (C'gpgme_ctx_t
 -> C'gpgme_ctx_t
 -> C'gpgme_ctx_t
 -> IO (C'gpgme_encrypt_flags_t, a))
-> Ctx
-> Fpr
-> Fpr
-> IO (Either GpgmeError (VerificationResult, a))
verifyInternal C'gpgme_ctx_t
-> C'gpgme_ctx_t
-> C'gpgme_ctx_t
-> IO (C'gpgme_encrypt_flags_t, a)
ver_op Ctx {_ctx :: Ctx -> Ptr C'gpgme_ctx_t
_ctx=Ptr C'gpgme_ctx_t
ctxPtr} Fpr
sig Fpr
dat = do
    -- init buffer with signature
    Ptr C'gpgme_ctx_t
sigBufPtr <- IO (Ptr C'gpgme_ctx_t)
forall a. Storable a => IO (Ptr a)
malloc
    Fpr -> (CString -> IO ()) -> IO ()
forall a. Fpr -> (CString -> IO a) -> IO a
BS.useAsCString Fpr
sig ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
bs -> do
        let copyData :: CInt
copyData = CInt
1 -- gpgme shall copy data, as bytestring will free it
        let siglen :: CSize
siglen = Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Fpr -> Int
BS.length Fpr
sig)
        C'gpgme_encrypt_flags_t
ret <- Ptr C'gpgme_ctx_t
-> CString -> CSize -> CInt -> IO C'gpgme_encrypt_flags_t
c'gpgme_data_new_from_mem Ptr C'gpgme_ctx_t
sigBufPtr CString
bs CSize
siglen CInt
copyData
        String -> C'gpgme_encrypt_flags_t -> IO ()
checkError String
"data_new_from_mem" C'gpgme_encrypt_flags_t
ret
    C'gpgme_ctx_t
sigBuf <- Ptr C'gpgme_ctx_t -> IO C'gpgme_ctx_t
forall a. Storable a => Ptr a -> IO a
peek Ptr C'gpgme_ctx_t
sigBufPtr

    -- init buffer with data
    Ptr C'gpgme_ctx_t
datBufPtr <- IO (Ptr C'gpgme_ctx_t)
forall a. Storable a => IO (Ptr a)
malloc
    Fpr -> (CString -> IO ()) -> IO ()
forall a. Fpr -> (CString -> IO a) -> IO a
BS.useAsCString Fpr
dat ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
bs -> do
        let copyData :: CInt
copyData = CInt
1 -- gpgme shall copy data, as bytestring will free it
        let datlen :: CSize
datlen = Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Fpr -> Int
BS.length Fpr
dat)
        C'gpgme_encrypt_flags_t
ret <- Ptr C'gpgme_ctx_t
-> CString -> CSize -> CInt -> IO C'gpgme_encrypt_flags_t
c'gpgme_data_new_from_mem Ptr C'gpgme_ctx_t
datBufPtr CString
bs CSize
datlen CInt
copyData
        String -> C'gpgme_encrypt_flags_t -> IO ()
checkError String
"data_new_from_mem" C'gpgme_encrypt_flags_t
ret
    C'gpgme_ctx_t
datBuf <- Ptr C'gpgme_ctx_t -> IO C'gpgme_ctx_t
forall a. Storable a => Ptr a -> IO a
peek Ptr C'gpgme_ctx_t
datBufPtr

    C'gpgme_ctx_t
ctx <- Ptr C'gpgme_ctx_t -> IO C'gpgme_ctx_t
forall a. Storable a => Ptr a -> IO a
peek Ptr C'gpgme_ctx_t
ctxPtr

    -- verify
    (C'gpgme_encrypt_flags_t
errcode, a
res) <- C'gpgme_ctx_t
-> C'gpgme_ctx_t
-> C'gpgme_ctx_t
-> IO (C'gpgme_encrypt_flags_t, a)
ver_op C'gpgme_ctx_t
ctx C'gpgme_ctx_t
sigBuf C'gpgme_ctx_t
datBuf

    VerificationResult
sigs <- C'gpgme_ctx_t -> IO VerificationResult
collectSignatures' C'gpgme_ctx_t
ctx
    let res' :: Either GpgmeError (VerificationResult, a)
res' = if C'gpgme_encrypt_flags_t
errcode C'gpgme_encrypt_flags_t -> C'gpgme_encrypt_flags_t -> Bool
forall a. Eq a => a -> a -> Bool
/= C'gpgme_encrypt_flags_t
forall a. Num a => a
noError
                then GpgmeError -> Either GpgmeError (VerificationResult, a)
forall a b. a -> Either a b
Left  (C'gpgme_encrypt_flags_t -> GpgmeError
GpgmeError C'gpgme_encrypt_flags_t
errcode)
                else (VerificationResult, a)
-> Either GpgmeError (VerificationResult, a)
forall a b. b -> Either a b
Right (VerificationResult
sigs, a
res)

    Ptr C'gpgme_ctx_t -> IO ()
forall a. Ptr a -> IO ()
free Ptr C'gpgme_ctx_t
sigBufPtr
    Ptr C'gpgme_ctx_t -> IO ()
forall a. Ptr a -> IO ()
free Ptr C'gpgme_ctx_t
datBufPtr

    Either GpgmeError (VerificationResult, a)
-> IO (Either GpgmeError (VerificationResult, a))
forall (m :: * -> *) a. Monad m => a -> m a
return Either GpgmeError (VerificationResult, a)
res'