module Crypto.Gpgme.Internal where

import Bindings.Gpgme
import Control.Monad (unless)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Internal as BS (createAndTrim)
import qualified Data.ByteString.Lazy as LBS
import qualified Data.ByteString.Lazy.Internal as LBS (defaultChunkSize)
import Foreign (castPtr, nullPtr, peek, Ptr, malloc)
import Foreign.C.String (peekCString)
import Foreign.C.Types (CUInt, CInt)
import System.IO.Unsafe (unsafePerformIO)

import Crypto.Gpgme.Types

collectFprs :: C'gpgme_invalid_key_t -> [InvalidKey]
collectFprs :: C'gpgme_invalid_key_t -> [InvalidKey]
collectFprs C'gpgme_invalid_key_t
result = IO [InvalidKey] -> [InvalidKey]
forall a. IO a -> a
unsafePerformIO (IO [InvalidKey] -> [InvalidKey])
-> IO [InvalidKey] -> [InvalidKey]
forall a b. (a -> b) -> a -> b
$ C'gpgme_invalid_key_t -> IO C'_gpgme_invalid_key
forall a. Storable a => Ptr a -> IO a
peek C'gpgme_invalid_key_t
result IO C'_gpgme_invalid_key
-> (C'_gpgme_invalid_key -> IO [InvalidKey]) -> IO [InvalidKey]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= C'_gpgme_invalid_key -> IO [InvalidKey]
go
    where go :: C'_gpgme_invalid_key -> IO [InvalidKey]
          go :: C'_gpgme_invalid_key -> IO [InvalidKey]
go C'_gpgme_invalid_key
invalid = do
            String
fpr <- CString -> IO String
peekCString (C'_gpgme_invalid_key -> CString
c'_gpgme_invalid_key'fpr C'_gpgme_invalid_key
invalid)
            let reason :: Int
reason = C'gpgme_error_t -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (C'_gpgme_invalid_key -> C'gpgme_error_t
c'_gpgme_invalid_key'reason C'_gpgme_invalid_key
invalid)
            [InvalidKey]
rest <- C'_gpgme_invalid_key -> IO [InvalidKey]
go (C'_gpgme_invalid_key -> C'_gpgme_invalid_key
c'_gpgme_invalid_key'next C'_gpgme_invalid_key
invalid)
            [InvalidKey] -> IO [InvalidKey]
forall (m :: * -> *) a. Monad m => a -> m a
return ((String
fpr, Int
reason) InvalidKey -> [InvalidKey] -> [InvalidKey]
forall a. a -> [a] -> [a]
: [InvalidKey]
rest)

-- | Read the buffer into a ByteString.
--
-- Chunks of Data.ByteString.Lazy.Internal.defaultChunkSize are allocated and
-- copied, until the gpgme_data_readbuffer read returns less than this.
-- Then the list of chunks are copied into a strict ByteString by way of a lazy
-- ByteString.
collectResult :: C'gpgme_data_t -> BS.ByteString
collectResult :: C'gpgme_data_t -> ByteString
collectResult C'gpgme_data_t
dat' = IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ do
    -- make sure we start at the beginning
    C'off_t
_ <- C'gpgme_data_t -> C'off_t -> CInt -> IO C'off_t
c'gpgme_data_seek C'gpgme_data_t
dat' C'off_t
0 CInt
seekSet
    [ByteString]
chunks <- C'gpgme_data_t -> IO [ByteString]
go C'gpgme_data_t
dat'
    ByteString -> IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LBS.toStrict ([ByteString] -> ByteString
LBS.fromChunks [ByteString]
chunks)
  where makeChunk :: C'gpgme_data_t -> IO BS.ByteString
        makeChunk :: C'gpgme_data_t -> IO ByteString
makeChunk C'gpgme_data_t
dat = Int -> (Ptr Word8 -> IO Int) -> IO ByteString
BS.createAndTrim Int
chunkSize ((Ptr Word8 -> IO Int) -> IO ByteString)
-> (Ptr Word8 -> IO Int) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
buf -> do
          -- createAndTrim gives a Ptr Word8 but the gpgme functions wants a Ptr ()
          C'off_t
read_bytes <- C'gpgme_data_t -> Ptr () -> CSize -> IO C'off_t
c'gpgme_data_read C'gpgme_data_t
dat (Ptr Word8 -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
buf) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
chunkSize)
          Int -> IO Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ C'off_t -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral C'off_t
read_bytes

        go :: C'gpgme_data_t -> IO [BS.ByteString]
        go :: C'gpgme_data_t -> IO [ByteString]
go C'gpgme_data_t
dat = do
          ByteString
bs <- C'gpgme_data_t -> IO ByteString
makeChunk C'gpgme_data_t
dat
          if ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
chunkSize
          then [ByteString] -> IO [ByteString]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ByteString
bs]
          else do
            [ByteString]
bss <- C'gpgme_data_t -> IO [ByteString]
go C'gpgme_data_t
dat
            [ByteString] -> IO [ByteString]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString
bs ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
bss)

        seekSet :: CInt
seekSet = CInt
0
        chunkSize :: Int
chunkSize = Int
LBS.defaultChunkSize

-- ^ Unsafe IO version of `collectSignatures`. Try to use `collectSignatures'` instead.
collectSignatures :: C'gpgme_ctx_t -> VerificationResult
collectSignatures :: C'gpgme_data_t -> VerificationResult
collectSignatures C'gpgme_data_t
ctx = IO VerificationResult -> VerificationResult
forall a. IO a -> a
unsafePerformIO (IO VerificationResult -> VerificationResult)
-> IO VerificationResult -> VerificationResult
forall a b. (a -> b) -> a -> b
$ C'gpgme_data_t -> IO VerificationResult
collectSignatures' C'gpgme_data_t
ctx

-- ^ Return signatures a GPG verify action.
collectSignatures' :: C'gpgme_ctx_t -> IO VerificationResult
collectSignatures' :: C'gpgme_data_t -> IO VerificationResult
collectSignatures' C'gpgme_data_t
ctx = do
    C'gpgme_verify_result_t
verify_res <- C'gpgme_data_t -> IO C'gpgme_verify_result_t
c'gpgme_op_verify_result C'gpgme_data_t
ctx
    C'gpgme_signature_t
sigs <- Ptr C'gpgme_signature_t -> IO C'gpgme_signature_t
forall a. Storable a => Ptr a -> IO a
peek (Ptr C'gpgme_signature_t -> IO C'gpgme_signature_t)
-> Ptr C'gpgme_signature_t -> IO C'gpgme_signature_t
forall a b. (a -> b) -> a -> b
$ C'gpgme_verify_result_t -> Ptr C'gpgme_signature_t
p'_gpgme_op_verify_result'signatures C'gpgme_verify_result_t
verify_res
    C'gpgme_signature_t -> IO VerificationResult
go C'gpgme_signature_t
sigs
    where
        go :: C'gpgme_signature_t -> IO VerificationResult
go C'gpgme_signature_t
sig | C'gpgme_signature_t
sig C'gpgme_signature_t -> C'gpgme_signature_t -> Bool
forall a. Eq a => a -> a -> Bool
== C'gpgme_signature_t
forall a. Ptr a
nullPtr = VerificationResult -> IO VerificationResult
forall (m :: * -> *) a. Monad m => a -> m a
return []
        go C'gpgme_signature_t
sig = do
            C'gpgme_error_t
status <- Ptr C'gpgme_error_t -> IO C'gpgme_error_t
forall a. Storable a => Ptr a -> IO a
peek (Ptr C'gpgme_error_t -> IO C'gpgme_error_t)
-> Ptr C'gpgme_error_t -> IO C'gpgme_error_t
forall a b. (a -> b) -> a -> b
$ C'gpgme_signature_t -> Ptr C'gpgme_error_t
p'_gpgme_signature'status C'gpgme_signature_t
sig
            C'gpgme_error_t
summary <- Ptr C'gpgme_error_t -> IO C'gpgme_error_t
forall a. Storable a => Ptr a -> IO a
peek (Ptr C'gpgme_error_t -> IO C'gpgme_error_t)
-> Ptr C'gpgme_error_t -> IO C'gpgme_error_t
forall a b. (a -> b) -> a -> b
$ C'gpgme_signature_t -> Ptr C'gpgme_error_t
p'_gpgme_signature'summary C'gpgme_signature_t
sig
            ByteString
fpr <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (C'gpgme_signature_t -> Ptr CString
p'_gpgme_signature'fpr C'gpgme_signature_t
sig) IO CString -> (CString -> IO ByteString) -> IO ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO ByteString
BS.packCString
            C'gpgme_signature_t
next <- Ptr C'gpgme_signature_t -> IO C'gpgme_signature_t
forall a. Storable a => Ptr a -> IO a
peek (Ptr C'gpgme_signature_t -> IO C'gpgme_signature_t)
-> Ptr C'gpgme_signature_t -> IO C'gpgme_signature_t
forall a b. (a -> b) -> a -> b
$ C'gpgme_signature_t -> Ptr C'gpgme_signature_t
p'_gpgme_signature'next C'gpgme_signature_t
sig
            VerificationResult
xs <- C'gpgme_signature_t -> IO VerificationResult
go C'gpgme_signature_t
next
            VerificationResult -> IO VerificationResult
forall (m :: * -> *) a. Monad m => a -> m a
return (VerificationResult -> IO VerificationResult)
-> VerificationResult -> IO VerificationResult
forall a b. (a -> b) -> a -> b
$ (C'gpgme_error_t -> GpgmeError
GpgmeError C'gpgme_error_t
status, C'gpgme_error_t -> [SignatureSummary]
toSignatureSummaries C'gpgme_error_t
summary, ByteString
fpr) (GpgmeError, [SignatureSummary], ByteString)
-> VerificationResult -> VerificationResult
forall a. a -> [a] -> [a]
: VerificationResult
xs

checkError :: String -> C'gpgme_error_t -> IO ()
checkError :: String -> C'gpgme_error_t -> IO ()
checkError String
fun C'gpgme_error_t
gpgme_err =
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (C'gpgme_error_t
gpgme_err C'gpgme_error_t -> C'gpgme_error_t -> Bool
forall a. Eq a => a -> a -> Bool
== C'gpgme_error_t
forall a. Num a => a
noError) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
           do CString
errstr <- C'gpgme_error_t -> IO CString
c'gpgme_strerror C'gpgme_error_t
gpgme_err
              String
str <- CString -> IO String
peekCString CString
errstr
              CString
srcstr <- C'gpgme_error_t -> IO CString
c'gpgme_strsource C'gpgme_error_t
gpgme_err
              String
src <- CString -> IO String
peekCString CString
srcstr
              String -> IO ()
forall a. HasCallStack => String -> a
error (String
"Fun: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fun String -> String -> String
forall a. [a] -> [a] -> [a]
++
                     String
", Error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str String -> String -> String
forall a. [a] -> [a] -> [a]
++
                     String
", Source: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
src)

noError :: Num a => a
noError :: a
noError = a
0

fromKeyListingMode :: KeyListingMode -> C'gpgme_keylist_mode_t
fromKeyListingMode :: KeyListingMode -> C'gpgme_error_t
fromKeyListingMode KeyListingMode
KeyListingLocal        = C'gpgme_error_t
forall a. Num a => a
c'GPGME_KEYLIST_MODE_LOCAL
fromKeyListingMode KeyListingMode
KeyListingExtern       = C'gpgme_error_t
forall a. Num a => a
c'GPGME_KEYLIST_MODE_EXTERN
fromKeyListingMode KeyListingMode
KeyListingSigs         = C'gpgme_error_t
forall a. Num a => a
c'GPGME_KEYLIST_MODE_SIGS
fromKeyListingMode KeyListingMode
KeyListingSigNotations = C'gpgme_error_t
forall a. Num a => a
c'GPGME_KEYLIST_MODE_SIG_NOTATIONS
fromKeyListingMode KeyListingMode
KeyListingValidate     = C'gpgme_error_t
forall a. Num a => a
c'GPGME_KEYLIST_MODE_VALIDATE


fromProtocol :: (Num a) => Protocol -> a
fromProtocol :: Protocol -> a
fromProtocol Protocol
CMS     =  a
forall a. Num a => a
c'GPGME_PROTOCOL_CMS
fromProtocol Protocol
GPGCONF =  a
forall a. Num a => a
c'GPGME_PROTOCOL_GPGCONF
fromProtocol Protocol
OpenPGP =  a
forall a. Num a => a
c'GPGME_PROTOCOL_OpenPGP
fromProtocol Protocol
UNKNOWN =  a
forall a. Num a => a
c'GPGME_PROTOCOL_UNKNOWN

fromSecret :: IncludeSecret -> CInt
fromSecret :: IncludeSecret -> CInt
fromSecret IncludeSecret
WithSecret = CInt
1
fromSecret IncludeSecret
NoSecret   = CInt
0

fromFlag :: Flag -> CUInt
fromFlag :: Flag -> C'gpgme_error_t
fromFlag Flag
AlwaysTrust = C'gpgme_error_t
forall a. Num a => a
c'GPGME_ENCRYPT_ALWAYS_TRUST
fromFlag Flag
NoFlag      = C'gpgme_error_t
0

toValidity :: C'gpgme_validity_t -> Validity
toValidity :: C'gpgme_error_t -> Validity
toValidity C'gpgme_error_t
n
  | C'gpgme_error_t
n C'gpgme_error_t -> C'gpgme_error_t -> Bool
forall a. Eq a => a -> a -> Bool
== C'gpgme_error_t
forall a. Num a => a
c'GPGME_VALIDITY_UNKNOWN   = Validity
ValidityUnknown
  | C'gpgme_error_t
n C'gpgme_error_t -> C'gpgme_error_t -> Bool
forall a. Eq a => a -> a -> Bool
== C'gpgme_error_t
forall a. Num a => a
c'GPGME_VALIDITY_UNDEFINED = Validity
ValidityUndefined
  | C'gpgme_error_t
n C'gpgme_error_t -> C'gpgme_error_t -> Bool
forall a. Eq a => a -> a -> Bool
== C'gpgme_error_t
forall a. Num a => a
c'GPGME_VALIDITY_NEVER     = Validity
ValidityNever
  | C'gpgme_error_t
n C'gpgme_error_t -> C'gpgme_error_t -> Bool
forall a. Eq a => a -> a -> Bool
== C'gpgme_error_t
forall a. Num a => a
c'GPGME_VALIDITY_MARGINAL  = Validity
ValidityMarginal
  | C'gpgme_error_t
n C'gpgme_error_t -> C'gpgme_error_t -> Bool
forall a. Eq a => a -> a -> Bool
== C'gpgme_error_t
forall a. Num a => a
c'GPGME_VALIDITY_FULL      = Validity
ValidityFull
  | C'gpgme_error_t
n C'gpgme_error_t -> C'gpgme_error_t -> Bool
forall a. Eq a => a -> a -> Bool
== C'gpgme_error_t
forall a. Num a => a
c'GPGME_VALIDITY_ULTIMATE  = Validity
ValidityUltimate
  | Bool
otherwise                       = String -> Validity
forall a. HasCallStack => String -> a
error String
"validityFromInt: Unrecognized trust validity"

toPubKeyAlgo :: C'gpgme_pubkey_algo_t -> PubKeyAlgo
toPubKeyAlgo :: C'gpgme_error_t -> PubKeyAlgo
toPubKeyAlgo C'gpgme_error_t
n
  | C'gpgme_error_t
n C'gpgme_error_t -> C'gpgme_error_t -> Bool
forall a. Eq a => a -> a -> Bool
== C'gpgme_error_t
forall a. Num a => a
c'GPGME_PK_RSA   = PubKeyAlgo
Rsa
  | C'gpgme_error_t
n C'gpgme_error_t -> C'gpgme_error_t -> Bool
forall a. Eq a => a -> a -> Bool
== C'gpgme_error_t
forall a. Num a => a
c'GPGME_PK_RSA_E = PubKeyAlgo
RsaE
  | C'gpgme_error_t
n C'gpgme_error_t -> C'gpgme_error_t -> Bool
forall a. Eq a => a -> a -> Bool
== C'gpgme_error_t
forall a. Num a => a
c'GPGME_PK_RSA_S = PubKeyAlgo
RsaS
  | C'gpgme_error_t
n C'gpgme_error_t -> C'gpgme_error_t -> Bool
forall a. Eq a => a -> a -> Bool
== C'gpgme_error_t
forall a. Num a => a
c'GPGME_PK_ELG_E = PubKeyAlgo
ElgE
  | C'gpgme_error_t
n C'gpgme_error_t -> C'gpgme_error_t -> Bool
forall a. Eq a => a -> a -> Bool
== C'gpgme_error_t
forall a. Num a => a
c'GPGME_PK_DSA   = PubKeyAlgo
Dsa
  | C'gpgme_error_t
n C'gpgme_error_t -> C'gpgme_error_t -> Bool
forall a. Eq a => a -> a -> Bool
== C'gpgme_error_t
forall a. Num a => a
c'GPGME_PK_ELG   = PubKeyAlgo
Elg
  | Bool
otherwise             = String -> PubKeyAlgo
forall a. HasCallStack => String -> a
error String
"toPubKeyAlgo: Unrecognized public key algorithm"

newDataBuffer :: IO (Ptr C'gpgme_data_t)
newDataBuffer :: IO (Ptr C'gpgme_data_t)
newDataBuffer = do
    Ptr C'gpgme_data_t
resultBufPtr <- IO (Ptr C'gpgme_data_t)
forall a. Storable a => IO (Ptr a)
malloc
    String -> C'gpgme_error_t -> IO ()
checkError String
"data_new" (C'gpgme_error_t -> IO ()) -> IO C'gpgme_error_t -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr C'gpgme_data_t -> IO C'gpgme_error_t
c'gpgme_data_new Ptr C'gpgme_data_t
resultBufPtr
    Ptr C'gpgme_data_t -> IO (Ptr C'gpgme_data_t)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr C'gpgme_data_t
resultBufPtr