module Crypto.Gpgme.Key (
      getKey
    , importKeyFromFile
    , listKeys
    , removeKey
    , searchKeys
      -- * Information about keys
    , Validity (..)
    , PubKeyAlgo (..)
    , KeySignature (..)
    , UserId (..)
    , KeyUserId (..)
    , keyUserIds
    , keyUserIds'
    , SubKey (..)
    , keySubKeys
    , keySubKeys'
    ) where

import Bindings.Gpgme
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC8
import Data.Time.Clock
import Data.Time.Clock.POSIX
import Foreign
import Foreign.C
import System.IO.Unsafe

import Crypto.Gpgme.Types
import Crypto.Gpgme.Internal

-- | Returns a list of all known 'Key's from the @context@.
listKeys :: Ctx            -- ^ context to operate in
         -> IncludeSecret  -- ^ whether to include the secrets
         -> IO [Key]
listKeys :: Ctx -> IncludeSecret -> IO [Key]
listKeys Ctx
ctx IncludeSecret
secret = Ctx -> IncludeSecret -> CString -> IO [Key]
listKeys' Ctx
ctx IncludeSecret
secret CString
forall a. Ptr a
nullPtr

-- | Returns a list of known 'Key's from the @context@ that match a given pattern.
searchKeys :: 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]
searchKeys :: Ctx -> IncludeSecret -> String -> IO [Key]
searchKeys Ctx
ctx IncludeSecret
secret String
pat = ByteString -> (CString -> IO [Key]) -> IO [Key]
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString (String -> ByteString
BSC8.pack String
pat) (Ctx -> IncludeSecret -> CString -> IO [Key]
listKeys' Ctx
ctx IncludeSecret
secret)

-- | Internal helper function used by both `listKeys` and `searchKeys`.
listKeys' :: Ctx            -- ^ context to operate in
          -> IncludeSecret  -- ^ whether to include the secrets
          -> CString        -- ^ The pattern to look for; It is typically
                            -- matched against the user ids of a key.
          -> IO [Key]
listKeys' :: Ctx -> IncludeSecret -> CString -> IO [Key]
listKeys' Ctx {_ctx :: Ctx -> Ptr C'gpgme_ctx_t
_ctx=Ptr C'gpgme_ctx_t
ctxPtr} IncludeSecret
secret CString
pat = do
    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 IO C'gpgme_ctx_t -> (C'gpgme_ctx_t -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \C'gpgme_ctx_t
ctx ->
        C'gpgme_ctx_t -> CString -> CInt -> IO C'gpgme_error_t
c'gpgme_op_keylist_start C'gpgme_ctx_t
ctx CString
pat (IncludeSecret -> CInt
fromSecret IncludeSecret
secret) IO C'gpgme_error_t -> (C'gpgme_error_t -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> C'gpgme_error_t -> IO ()
checkError String
"listKeys"
    let eof :: C'gpgme_error_t
eof = C'gpgme_error_t
16383
        go :: [Key] -> IO [Key]
go [Key]
accum = do
            Key
key <- IO Key
allocKey
            C'gpgme_error_t
ret <- 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 IO C'gpgme_ctx_t
-> (C'gpgme_ctx_t -> IO C'gpgme_error_t) -> IO C'gpgme_error_t
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \C'gpgme_ctx_t
ctx ->
                Key
-> (Ptr C'gpgme_key_t -> IO C'gpgme_error_t) -> IO C'gpgme_error_t
forall a. Key -> (Ptr C'gpgme_key_t -> IO a) -> IO a
withKeyPtr Key
key ((Ptr C'gpgme_key_t -> IO C'gpgme_error_t) -> IO C'gpgme_error_t)
-> (Ptr C'gpgme_key_t -> IO C'gpgme_error_t) -> IO C'gpgme_error_t
forall a b. (a -> b) -> a -> b
$ C'gpgme_ctx_t -> Ptr C'gpgme_key_t -> IO C'gpgme_error_t
c'gpgme_op_keylist_next C'gpgme_ctx_t
ctx
            C'gpgme_error_t
code <- C'gpgme_error_t -> IO C'gpgme_error_t
c'gpgme_err_code C'gpgme_error_t
ret
            case C'gpgme_error_t
ret of
                C'gpgme_error_t
_ | C'gpgme_error_t
ret 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 -> [Key] -> IO [Key]
go (Key
key Key -> [Key] -> [Key]
forall a. a -> [a] -> [a]
: [Key]
accum)
                  | C'gpgme_error_t
code C'gpgme_error_t -> C'gpgme_error_t -> Bool
forall a. Eq a => a -> a -> Bool
== C'gpgme_error_t
eof    -> [Key] -> IO [Key]
forall (m :: * -> *) a. Monad m => a -> m a
return [Key]
accum
                  | Bool
otherwise      -> String -> C'gpgme_error_t -> IO ()
checkError String
"listKeys" C'gpgme_error_t
ret IO () -> IO [Key] -> IO [Key]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Key] -> IO [Key]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    [Key] -> IO [Key]
go []

-- | Returns a 'Key' from the @context@ based on its @fingerprint@.
--   Returns 'Nothing' if no 'Key' with this 'Fpr' exists.
getKey :: Ctx           -- ^ context to operate in
       -> Fpr           -- ^ fingerprint
       -> IncludeSecret -- ^ whether to include secrets when searching for the key
       -> IO (Maybe Key)
getKey :: Ctx -> ByteString -> IncludeSecret -> IO (Maybe Key)
getKey Ctx {_ctx :: Ctx -> Ptr C'gpgme_ctx_t
_ctx=Ptr C'gpgme_ctx_t
ctxPtr} ByteString
fpr IncludeSecret
secret = do
    Key
key <- IO Key
allocKey
    C'gpgme_error_t
ret <- ByteString -> (CString -> IO C'gpgme_error_t) -> IO C'gpgme_error_t
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
fpr ((CString -> IO C'gpgme_error_t) -> IO C'gpgme_error_t)
-> (CString -> IO C'gpgme_error_t) -> IO C'gpgme_error_t
forall a b. (a -> b) -> a -> b
$ \CString
cFpr ->
        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 IO C'gpgme_ctx_t
-> (C'gpgme_ctx_t -> IO C'gpgme_error_t) -> IO C'gpgme_error_t
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \C'gpgme_ctx_t
ctx ->
            Key
-> (Ptr C'gpgme_key_t -> IO C'gpgme_error_t) -> IO C'gpgme_error_t
forall a. Key -> (Ptr C'gpgme_key_t -> IO a) -> IO a
withKeyPtr Key
key ((Ptr C'gpgme_key_t -> IO C'gpgme_error_t) -> IO C'gpgme_error_t)
-> (Ptr C'gpgme_key_t -> IO C'gpgme_error_t) -> IO C'gpgme_error_t
forall a b. (a -> b) -> a -> b
$ \Ptr C'gpgme_key_t
keyPtr ->
                C'gpgme_ctx_t
-> CString -> Ptr C'gpgme_key_t -> CInt -> IO C'gpgme_error_t
c'gpgme_get_key C'gpgme_ctx_t
ctx CString
cFpr Ptr C'gpgme_key_t
keyPtr (IncludeSecret -> CInt
fromSecret IncludeSecret
secret)
    if C'gpgme_error_t
ret 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
        then Maybe Key -> IO (Maybe Key)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Key -> IO (Maybe Key))
-> (Key -> Maybe Key) -> Key -> IO (Maybe Key)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Maybe Key
forall a. a -> Maybe a
Just (Key -> IO (Maybe Key)) -> Key -> IO (Maybe Key)
forall a b. (a -> b) -> a -> b
$ Key
key
        else Maybe Key -> IO (Maybe Key)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Key
forall a. Maybe a
Nothing

-- | 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@
importKeyFromFile :: Ctx -- ^ context to operate in
                  -> FilePath -- ^ file path to read from
                  -> IO (Maybe GpgmeError)
importKeyFromFile :: Ctx -> String -> IO (Maybe GpgmeError)
importKeyFromFile Ctx {_ctx :: Ctx -> Ptr C'gpgme_ctx_t
_ctx=Ptr C'gpgme_ctx_t
ctxPtr} String
fp = do
  Ptr C'gpgme_ctx_t
dataPtr <- IO (Ptr C'gpgme_ctx_t)
newDataBuffer
  C'gpgme_error_t
ret <-
    ByteString -> (CString -> IO C'gpgme_error_t) -> IO C'gpgme_error_t
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString (String -> ByteString
BSC8.pack String
fp) ((CString -> IO C'gpgme_error_t) -> IO C'gpgme_error_t)
-> (CString -> IO C'gpgme_error_t) -> IO C'gpgme_error_t
forall a b. (a -> b) -> a -> b
$ \CString
cFp ->
      Ptr C'gpgme_ctx_t -> CString -> CInt -> IO C'gpgme_error_t
c'gpgme_data_new_from_file Ptr C'gpgme_ctx_t
dataPtr CString
cFp CInt
1
  Maybe GpgmeError
mGpgErr <-
    case C'gpgme_error_t
ret of
      C'gpgme_error_t
x | C'gpgme_error_t
x 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 -> do
        C'gpgme_error_t
retIn <- do
          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
          C'gpgme_ctx_t
dat <- Ptr C'gpgme_ctx_t -> IO C'gpgme_ctx_t
forall a. Storable a => Ptr a -> IO a
peek Ptr C'gpgme_ctx_t
dataPtr
          C'gpgme_ctx_t -> C'gpgme_ctx_t -> IO C'gpgme_error_t
c'gpgme_op_import C'gpgme_ctx_t
ctx C'gpgme_ctx_t
dat
        Maybe GpgmeError -> IO (Maybe GpgmeError)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe GpgmeError -> IO (Maybe GpgmeError))
-> Maybe GpgmeError -> IO (Maybe GpgmeError)
forall a b. (a -> b) -> a -> b
$ if C'gpgme_error_t
retIn 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
          then Maybe GpgmeError
forall a. Maybe a
Nothing
          else GpgmeError -> Maybe GpgmeError
forall a. a -> Maybe a
Just (GpgmeError -> Maybe GpgmeError) -> GpgmeError -> Maybe GpgmeError
forall a b. (a -> b) -> a -> b
$ C'gpgme_error_t -> GpgmeError
GpgmeError C'gpgme_error_t
ret
      C'gpgme_error_t
err -> Maybe GpgmeError -> IO (Maybe GpgmeError)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe GpgmeError -> IO (Maybe GpgmeError))
-> Maybe GpgmeError -> IO (Maybe GpgmeError)
forall a b. (a -> b) -> a -> b
$ GpgmeError -> Maybe GpgmeError
forall a. a -> Maybe a
Just (GpgmeError -> Maybe GpgmeError) -> GpgmeError -> Maybe GpgmeError
forall a b. (a -> b) -> a -> b
$ C'gpgme_error_t -> GpgmeError
GpgmeError C'gpgme_error_t
err
  Ptr C'gpgme_ctx_t -> IO ()
forall a. Ptr a -> IO ()
free Ptr C'gpgme_ctx_t
dataPtr
  Maybe GpgmeError -> IO (Maybe GpgmeError)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe GpgmeError
mGpgErr

-- | Removes the 'Key' from @context@
removeKey :: Ctx                    -- ^ context to operate in
          -> Key                    -- ^ key to delete
          -> RemoveKeyFlags         -- ^ flags for remove operation
          -> IO (Maybe GpgmeError)
removeKey :: Ctx -> Key -> RemoveKeyFlags -> IO (Maybe GpgmeError)
removeKey Ctx {_ctx :: Ctx -> Ptr C'gpgme_ctx_t
_ctx=Ptr C'gpgme_ctx_t
ctxPtr} Key
key RemoveKeyFlags
flags = do
  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
  C'gpgme_error_t
ret <- Key
-> (Ptr C'gpgme_key_t -> IO C'gpgme_error_t) -> IO C'gpgme_error_t
forall a. Key -> (Ptr C'gpgme_key_t -> IO a) -> IO a
withKeyPtr Key
key (\Ptr C'gpgme_key_t
keyPtr -> 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
keyPtr
    C'gpgme_ctx_t
-> C'gpgme_key_t -> C'gpgme_error_t -> IO C'gpgme_error_t
c'gpgme_op_delete_ext C'gpgme_ctx_t
ctx C'gpgme_key_t
k C'gpgme_error_t
cFlags)
  if C'gpgme_error_t
ret C'gpgme_error_t -> C'gpgme_error_t -> Bool
forall a. Eq a => a -> a -> Bool
== C'gpgme_error_t
0
    then Maybe GpgmeError -> IO (Maybe GpgmeError)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GpgmeError
forall a. Maybe a
Nothing
    else Maybe GpgmeError -> IO (Maybe GpgmeError)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe GpgmeError -> IO (Maybe GpgmeError))
-> Maybe GpgmeError -> IO (Maybe GpgmeError)
forall a b. (a -> b) -> a -> b
$ GpgmeError -> Maybe GpgmeError
forall a. a -> Maybe a
Just (GpgmeError -> Maybe GpgmeError) -> GpgmeError -> Maybe GpgmeError
forall a b. (a -> b) -> a -> b
$ C'gpgme_error_t -> GpgmeError
GpgmeError C'gpgme_error_t
ret
  where
    cFlags :: C'gpgme_error_t
cFlags = (if RemoveKeyFlags -> Bool
allowSecret RemoveKeyFlags
flags then C'gpgme_error_t
1 else C'gpgme_error_t
0) C'gpgme_error_t -> C'gpgme_error_t -> C'gpgme_error_t
forall a. Bits a => a -> a -> a
.|. (if RemoveKeyFlags -> Bool
force RemoveKeyFlags
flags then C'gpgme_error_t
2 else C'gpgme_error_t
0)


-- | A key signature
data KeySignature = KeySig { KeySignature -> PubKeyAlgo
keysigAlgorithm :: PubKeyAlgo
                           , KeySignature -> String
keysigKeyId     :: String
                           , KeySignature -> Maybe UTCTime
keysigTimestamp :: Maybe UTCTime
                           , KeySignature -> Maybe UTCTime
keysigExpires   :: Maybe UTCTime
                           , KeySignature -> UserId
keysigUserId    :: UserId
                             -- TODO: Notations
                           }

readTime :: CLong -> Maybe UTCTime
readTime :: CLong -> Maybe UTCTime
readTime (-1) = Maybe UTCTime
forall a. Maybe a
Nothing
readTime CLong
0    = Maybe UTCTime
forall a. Maybe a
Nothing
readTime CLong
t    = UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just (UTCTime -> Maybe UTCTime) -> UTCTime -> Maybe UTCTime
forall a b. (a -> b) -> a -> b
$ POSIXTime -> UTCTime
posixSecondsToUTCTime (POSIXTime -> UTCTime) -> POSIXTime -> UTCTime
forall a b. (a -> b) -> a -> b
$ CLong -> POSIXTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac CLong
t

readKeySignatures :: C'gpgme_key_sig_t -> IO [KeySignature]
readKeySignatures :: C'gpgme_key_sig_t -> IO [KeySignature]
readKeySignatures C'gpgme_key_sig_t
p0 = (C'_gpgme_key_sig -> C'gpgme_key_sig_t)
-> C'gpgme_key_sig_t -> IO [C'_gpgme_key_sig]
forall a. Storable a => (a -> Ptr a) -> Ptr a -> IO [a]
peekList C'_gpgme_key_sig -> C'gpgme_key_sig_t
c'_gpgme_key_sig'next C'gpgme_key_sig_t
p0 IO [C'_gpgme_key_sig]
-> ([C'_gpgme_key_sig] -> IO [KeySignature]) -> IO [KeySignature]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (C'_gpgme_key_sig -> IO KeySignature)
-> [C'_gpgme_key_sig] -> IO [KeySignature]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM C'_gpgme_key_sig -> IO KeySignature
readSig
  where
    readSig :: C'_gpgme_key_sig -> IO KeySignature
readSig C'_gpgme_key_sig
sig =
        (PubKeyAlgo
-> String
-> Maybe UTCTime
-> Maybe UTCTime
-> UserId
-> KeySignature
KeySig (C'gpgme_error_t -> PubKeyAlgo
toPubKeyAlgo (C'gpgme_error_t -> PubKeyAlgo) -> C'gpgme_error_t -> PubKeyAlgo
forall a b. (a -> b) -> a -> b
$ C'_gpgme_key_sig -> C'gpgme_error_t
c'_gpgme_key_sig'pubkey_algo C'_gpgme_key_sig
sig)
               (String
 -> Maybe UTCTime -> Maybe UTCTime -> UserId -> KeySignature)
-> IO String
-> IO (Maybe UTCTime -> Maybe UTCTime -> UserId -> KeySignature)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO String
peekCString (C'_gpgme_key_sig -> CString
c'_gpgme_key_sig'keyid C'_gpgme_key_sig
sig))
               IO (Maybe UTCTime -> Maybe UTCTime -> UserId -> KeySignature)
-> IO (Maybe UTCTime)
-> IO (Maybe UTCTime -> UserId -> KeySignature)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe UTCTime -> IO (Maybe UTCTime)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CLong -> Maybe UTCTime
readTime (CLong -> Maybe UTCTime) -> CLong -> Maybe UTCTime
forall a b. (a -> b) -> a -> b
$ C'_gpgme_key_sig -> CLong
c'_gpgme_key_sig'timestamp C'_gpgme_key_sig
sig)
               IO (Maybe UTCTime -> UserId -> KeySignature)
-> IO (Maybe UTCTime) -> IO (UserId -> KeySignature)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe UTCTime -> IO (Maybe UTCTime)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CLong -> Maybe UTCTime
readTime (CLong -> Maybe UTCTime) -> CLong -> Maybe UTCTime
forall a b. (a -> b) -> a -> b
$ C'_gpgme_key_sig -> CLong
c'_gpgme_key_sig'expires C'_gpgme_key_sig
sig)
               IO (UserId -> KeySignature) -> IO UserId -> IO KeySignature
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO UserId
signerId
      where
        signerId :: IO UserId
        signerId :: IO UserId
signerId =
            String -> String -> String -> String -> UserId
UserId (String -> String -> String -> String -> UserId)
-> IO String -> IO (String -> String -> String -> UserId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO String
peekCString (C'_gpgme_key_sig -> CString
c'_gpgme_key_sig'uid C'_gpgme_key_sig
sig)
                   IO (String -> String -> String -> UserId)
-> IO String -> IO (String -> String -> UserId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CString -> IO String
peekCString (C'_gpgme_key_sig -> CString
c'_gpgme_key_sig'name C'_gpgme_key_sig
sig)
                   IO (String -> String -> UserId)
-> IO String -> IO (String -> UserId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CString -> IO String
peekCString (C'_gpgme_key_sig -> CString
c'_gpgme_key_sig'email C'_gpgme_key_sig
sig)
                   IO (String -> UserId) -> IO String -> IO UserId
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CString -> IO String
peekCString (C'_gpgme_key_sig -> CString
c'_gpgme_key_sig'comment C'_gpgme_key_sig
sig)

-- | A user ID consisting of a name, comment, and email address.
data UserId = UserId { UserId -> String
userId         :: String
                     , UserId -> String
userName       :: String
                     , UserId -> String
userEmail      :: String
                     , UserId -> String
userComment    :: String
                     }
            deriving (Eq UserId
Eq UserId
-> (UserId -> UserId -> Ordering)
-> (UserId -> UserId -> Bool)
-> (UserId -> UserId -> Bool)
-> (UserId -> UserId -> Bool)
-> (UserId -> UserId -> Bool)
-> (UserId -> UserId -> UserId)
-> (UserId -> UserId -> UserId)
-> Ord UserId
UserId -> UserId -> Bool
UserId -> UserId -> Ordering
UserId -> UserId -> UserId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: UserId -> UserId -> UserId
$cmin :: UserId -> UserId -> UserId
max :: UserId -> UserId -> UserId
$cmax :: UserId -> UserId -> UserId
>= :: UserId -> UserId -> Bool
$c>= :: UserId -> UserId -> Bool
> :: UserId -> UserId -> Bool
$c> :: UserId -> UserId -> Bool
<= :: UserId -> UserId -> Bool
$c<= :: UserId -> UserId -> Bool
< :: UserId -> UserId -> Bool
$c< :: UserId -> UserId -> Bool
compare :: UserId -> UserId -> Ordering
$ccompare :: UserId -> UserId -> Ordering
$cp1Ord :: Eq UserId
Ord, UserId -> UserId -> Bool
(UserId -> UserId -> Bool)
-> (UserId -> UserId -> Bool) -> Eq UserId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserId -> UserId -> Bool
$c/= :: UserId -> UserId -> Bool
== :: UserId -> UserId -> Bool
$c== :: UserId -> UserId -> Bool
Eq, Int -> UserId -> ShowS
[UserId] -> ShowS
UserId -> String
(Int -> UserId -> ShowS)
-> (UserId -> String) -> ([UserId] -> ShowS) -> Show UserId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserId] -> ShowS
$cshowList :: [UserId] -> ShowS
show :: UserId -> String
$cshow :: UserId -> String
showsPrec :: Int -> UserId -> ShowS
$cshowsPrec :: Int -> UserId -> ShowS
Show)

-- | A user ID
data KeyUserId = KeyUserId { KeyUserId -> Validity
keyuserValidity   :: Validity
                           , KeyUserId -> UserId
keyuserId         :: UserId
                           , KeyUserId -> [KeySignature]
keyuserSignatures :: [KeySignature]
                           }

peekList :: Storable a => (a -> Ptr a) -> Ptr a -> IO [a]
peekList :: (a -> Ptr a) -> Ptr a -> IO [a]
peekList a -> Ptr a
nextFunc = [a] -> Ptr a -> IO [a]
go []
  where
    go :: [a] -> Ptr a -> IO [a]
go [a]
accum Ptr a
p
      | Ptr a
p Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
forall a. Ptr a
nullPtr  = [a] -> IO [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
accum
      | Bool
otherwise     = do a
v <- Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
p
                           [a] -> Ptr a -> IO [a]
go (a
v a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
accum) (a -> Ptr a
nextFunc a
v)

-- | Extract 'KeyUserId's from 'Key'.
keyUserIds' :: Key -> IO [KeyUserId]
keyUserIds' :: Key -> IO [KeyUserId]
keyUserIds' Key
key = ForeignPtr C'gpgme_key_t
-> (Ptr C'gpgme_key_t -> IO [KeyUserId]) -> IO [KeyUserId]
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (Key -> ForeignPtr C'gpgme_key_t
unKey Key
key) ((Ptr C'gpgme_key_t -> IO [KeyUserId]) -> IO [KeyUserId])
-> (Ptr C'gpgme_key_t -> IO [KeyUserId]) -> IO [KeyUserId]
forall a b. (a -> b) -> a -> b
$ \Ptr C'gpgme_key_t
keyPtr -> do
    C'_gpgme_key
key' <- Ptr C'gpgme_key_t -> IO C'gpgme_key_t
forall a. Storable a => Ptr a -> IO a
peek Ptr C'gpgme_key_t
keyPtr IO C'gpgme_key_t
-> (C'gpgme_key_t -> IO C'_gpgme_key) -> IO C'_gpgme_key
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= C'gpgme_key_t -> IO C'_gpgme_key
forall a. Storable a => Ptr a -> IO a
peek
    (C'_gpgme_user_id -> Ptr C'_gpgme_user_id)
-> Ptr C'_gpgme_user_id -> IO [C'_gpgme_user_id]
forall a. Storable a => (a -> Ptr a) -> Ptr a -> IO [a]
peekList C'_gpgme_user_id -> Ptr C'_gpgme_user_id
c'_gpgme_user_id'next (C'_gpgme_key -> Ptr C'_gpgme_user_id
c'_gpgme_key'uids C'_gpgme_key
key') IO [C'_gpgme_user_id]
-> ([C'_gpgme_user_id] -> IO [KeyUserId]) -> IO [KeyUserId]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (C'_gpgme_user_id -> IO KeyUserId)
-> [C'_gpgme_user_id] -> IO [KeyUserId]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM C'_gpgme_user_id -> IO KeyUserId
readKeyUserId
  where
    readKeyUserId :: C'_gpgme_user_id -> IO KeyUserId
    readKeyUserId :: C'_gpgme_user_id -> IO KeyUserId
readKeyUserId C'_gpgme_user_id
uid =
        (Validity -> UserId -> [KeySignature] -> KeyUserId
KeyUserId (C'gpgme_error_t -> Validity
toValidity (C'gpgme_error_t -> Validity) -> C'gpgme_error_t -> Validity
forall a b. (a -> b) -> a -> b
$ C'_gpgme_user_id -> C'gpgme_error_t
c'_gpgme_user_id'validity C'_gpgme_user_id
uid)
          (UserId -> [KeySignature] -> KeyUserId)
-> IO UserId -> IO ([KeySignature] -> KeyUserId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UserId
userId')
          IO ([KeySignature] -> KeyUserId)
-> IO [KeySignature] -> IO KeyUserId
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> C'gpgme_key_sig_t -> IO [KeySignature]
readKeySignatures (C'_gpgme_user_id -> C'gpgme_key_sig_t
c'_gpgme_user_id'signatures C'_gpgme_user_id
uid)
      where
        userId' :: IO UserId
        userId' :: IO UserId
userId' =
            String -> String -> String -> String -> UserId
UserId (String -> String -> String -> String -> UserId)
-> IO String -> IO (String -> String -> String -> UserId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO String
peekCString (C'_gpgme_user_id -> CString
c'_gpgme_user_id'uid C'_gpgme_user_id
uid)
                   IO (String -> String -> String -> UserId)
-> IO String -> IO (String -> String -> UserId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CString -> IO String
peekCString (C'_gpgme_user_id -> CString
c'_gpgme_user_id'name C'_gpgme_user_id
uid)
                   IO (String -> String -> UserId)
-> IO String -> IO (String -> UserId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CString -> IO String
peekCString (C'_gpgme_user_id -> CString
c'_gpgme_user_id'email C'_gpgme_user_id
uid)
                   IO (String -> UserId) -> IO String -> IO UserId
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CString -> IO String
peekCString (C'_gpgme_user_id -> CString
c'_gpgme_user_id'comment C'_gpgme_user_id
uid)

-- | Extract 'KeyUserId's from 'Key'. Uses 'unsafePerformIO' to bypass @IO@ monad!
-- Use 'keyUserIds' instead if possible.
keyUserIds :: Key -> [KeyUserId]
keyUserIds :: Key -> [KeyUserId]
keyUserIds = IO [KeyUserId] -> [KeyUserId]
forall a. IO a -> a
unsafePerformIO (IO [KeyUserId] -> [KeyUserId])
-> (Key -> IO [KeyUserId]) -> Key -> [KeyUserId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> IO [KeyUserId]
keyUserIds'

data SubKey = SubKey { SubKey -> PubKeyAlgo
subkeyAlgorithm    :: PubKeyAlgo
                     , SubKey -> Int
subkeyLength       :: Int
                     , SubKey -> String
subkeyKeyId        :: String
                     , SubKey -> ByteString
subkeyFpr          :: Fpr
                     , SubKey -> Maybe UTCTime
subkeyTimestamp    :: Maybe UTCTime
                     , SubKey -> Maybe UTCTime
subkeyExpires      :: Maybe UTCTime
                     , SubKey -> Maybe String
subkeyCardNumber   :: Maybe String
                     }

-- | Extract 'SubKey's from 'Key'.
keySubKeys' :: Key -> IO [SubKey]
keySubKeys' :: Key -> IO [SubKey]
keySubKeys' Key
key = ForeignPtr C'gpgme_key_t
-> (Ptr C'gpgme_key_t -> IO [SubKey]) -> IO [SubKey]
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (Key -> ForeignPtr C'gpgme_key_t
unKey Key
key) ((Ptr C'gpgme_key_t -> IO [SubKey]) -> IO [SubKey])
-> (Ptr C'gpgme_key_t -> IO [SubKey]) -> IO [SubKey]
forall a b. (a -> b) -> a -> b
$ \Ptr C'gpgme_key_t
keyPtr -> do
    C'_gpgme_key
key' <- Ptr C'gpgme_key_t -> IO C'gpgme_key_t
forall a. Storable a => Ptr a -> IO a
peek Ptr C'gpgme_key_t
keyPtr IO C'gpgme_key_t
-> (C'gpgme_key_t -> IO C'_gpgme_key) -> IO C'_gpgme_key
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= C'gpgme_key_t -> IO C'_gpgme_key
forall a. Storable a => Ptr a -> IO a
peek
    (C'_gpgme_subkey -> Ptr C'_gpgme_subkey)
-> Ptr C'_gpgme_subkey -> IO [C'_gpgme_subkey]
forall a. Storable a => (a -> Ptr a) -> Ptr a -> IO [a]
peekList C'_gpgme_subkey -> Ptr C'_gpgme_subkey
c'_gpgme_subkey'next (C'_gpgme_key -> Ptr C'_gpgme_subkey
c'_gpgme_key'subkeys C'_gpgme_key
key') IO [C'_gpgme_subkey]
-> ([C'_gpgme_subkey] -> IO [SubKey]) -> IO [SubKey]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (C'_gpgme_subkey -> IO SubKey) -> [C'_gpgme_subkey] -> IO [SubKey]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM C'_gpgme_subkey -> IO SubKey
readSubKey
  where
    readSubKey :: C'_gpgme_subkey -> IO SubKey
    readSubKey :: C'_gpgme_subkey -> IO SubKey
readSubKey C'_gpgme_subkey
sub =
        (PubKeyAlgo
-> Int
-> String
-> ByteString
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe String
-> SubKey
SubKey
            (C'gpgme_error_t -> PubKeyAlgo
toPubKeyAlgo (C'gpgme_error_t -> PubKeyAlgo) -> C'gpgme_error_t -> PubKeyAlgo
forall a b. (a -> b) -> a -> b
$ C'_gpgme_subkey -> C'gpgme_error_t
c'_gpgme_subkey'pubkey_algo C'_gpgme_subkey
sub)
            (C'gpgme_error_t -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (C'gpgme_error_t -> Int) -> C'gpgme_error_t -> Int
forall a b. (a -> b) -> a -> b
$ C'_gpgme_subkey -> C'gpgme_error_t
c'_gpgme_subkey'length C'_gpgme_subkey
sub)
            (String
 -> ByteString
 -> Maybe UTCTime
 -> Maybe UTCTime
 -> Maybe String
 -> SubKey)
-> IO String
-> IO
     (ByteString
      -> Maybe UTCTime -> Maybe UTCTime -> Maybe String -> SubKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO String
peekCString (C'_gpgme_subkey -> CString
c'_gpgme_subkey'keyid C'_gpgme_subkey
sub))
        IO
  (ByteString
   -> Maybe UTCTime -> Maybe UTCTime -> Maybe String -> SubKey)
-> IO ByteString
-> IO (Maybe UTCTime -> Maybe UTCTime -> Maybe String -> SubKey)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CString -> IO ByteString
BS.packCString (C'_gpgme_subkey -> CString
c'_gpgme_subkey'fpr C'_gpgme_subkey
sub)
        IO (Maybe UTCTime -> Maybe UTCTime -> Maybe String -> SubKey)
-> IO (Maybe UTCTime)
-> IO (Maybe UTCTime -> Maybe String -> SubKey)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe UTCTime -> IO (Maybe UTCTime)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CLong -> Maybe UTCTime
readTime (CLong -> Maybe UTCTime) -> CLong -> Maybe UTCTime
forall a b. (a -> b) -> a -> b
$ C'_gpgme_subkey -> CLong
c'_gpgme_subkey'timestamp C'_gpgme_subkey
sub)
        IO (Maybe UTCTime -> Maybe String -> SubKey)
-> IO (Maybe UTCTime) -> IO (Maybe String -> SubKey)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe UTCTime -> IO (Maybe UTCTime)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CLong -> Maybe UTCTime
readTime (CLong -> Maybe UTCTime) -> CLong -> Maybe UTCTime
forall a b. (a -> b) -> a -> b
$ C'_gpgme_subkey -> CLong
c'_gpgme_subkey'expires C'_gpgme_subkey
sub)
        IO (Maybe String -> SubKey) -> IO (Maybe String) -> IO SubKey
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (CString -> IO String) -> CString -> IO (Maybe String)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
orNull CString -> IO String
peekCString (C'_gpgme_subkey -> CString
c'_gpgme_subkey'card_number C'_gpgme_subkey
sub)

orNull :: (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
orNull :: (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
orNull Ptr a -> IO b
f Ptr a
ptr
  | Ptr a
ptr Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
forall a. Ptr a
nullPtr = Maybe b -> IO (Maybe b)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe b
forall a. Maybe a
Nothing
  | Bool
otherwise      = b -> Maybe b
forall a. a -> Maybe a
Just (b -> Maybe b) -> IO b -> IO (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr a -> IO b
f Ptr a
ptr

-- | Extract 'SubKey's from 'Key'. Uses 'unsafePerformIO' to bypass @IO@ monad!
-- Use 'keySubKeys' instead if possible.
keySubKeys :: Key -> [SubKey]
keySubKeys :: Key -> [SubKey]
keySubKeys = IO [SubKey] -> [SubKey]
forall a. IO a -> a
unsafePerformIO (IO [SubKey] -> [SubKey])
-> (Key -> IO [SubKey]) -> Key -> [SubKey]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> IO [SubKey]
keySubKeys'