    module Propellor.Property.Gpg where

    import Propellor.Base
    import qualified Propellor.Property.Apt as Apt

    import System.Posix.User

    installed :: Property DebianLike
    installed :: Property DebianLike
    installed = [Package] -> Property DebianLike
    Apt.installed [Package
    "gnupg"]

    -- A numeric id, or a description of the key, in a form understood by gpg.
    newtype GpgKeyId = GpgKeyId { GpgKeyId -> Package
    getGpgKeyId :: String }

    data GpgKeyType = GpgPubKey | GpgPrivKey

    -- | Sets up a user with a gpg key from the privdata.
    --
    -- Note that if a secret key is exported using gpg -a --export-secret-key,
    -- the public key is also included. Or just a public key could be
    -- exported, and this would set it up just as well.
    --
    -- Recommend only using this for low-value dedicated role keys.
    -- No attempt has been made to scrub the key out of memory once it's used.
    keyImported :: GpgKeyId -> User -> Property (HasInfo + DebianLike)
    keyImported :: GpgKeyId -> User -> Property (HasInfo + DebianLike)
    keyImported key :: GpgKeyId
    key@(GpgKeyId Package
    keyid) user :: User
    user@(User Package
    u) = Property
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
    Property (HasInfo + DebianLike)
    prop
    	Property
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
    -> Property DebianLike
    -> CombinedType
         (Property
            (MetaTypes
               '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
         (Property DebianLike)
    forall x y. Combines x y => x -> y -> CombinedType x y
    `requires` Property DebianLike
    installed
      where
    	desc :: Package
    desc = Package
    u Package -> Package -> Package
    forall a. [a] -> [a] -> [a]
    ++ Package
    " has gpg key " Package -> Package -> Package
    forall a. [a] -> [a] -> [a]
    ++ Package -> Package
    forall a. Show a => a -> Package
    show Package
    keyid
    	prop :: Property (HasInfo + DebianLike)
    	prop :: Property (HasInfo + DebianLike)
    prop = PrivDataSource
    -> Context
    -> (((PrivData -> Propellor Result) -> Propellor Result)
        -> Property (HasInfo + DebianLike))
    -> Property (HasInfo + DebianLike)
    forall c s metatypes.
    (IsContext c, IsPrivDataSource s,
     IncludesInfo metatypes ~ 'True) =>
    s
    -> c
    -> (((PrivData -> Propellor Result) -> Propellor Result)
        -> Property metatypes)
    -> Property metatypes
    withPrivData PrivDataSource
    src (Package -> Context
    Context Package
    keyid) ((((PrivData -> Propellor Result) -> Propellor Result)
      -> Property (HasInfo + DebianLike))
     -> Property (HasInfo + DebianLike))
    -> (((PrivData -> Propellor Result) -> Propellor Result)
        -> Property (HasInfo + DebianLike))
    -> Property (HasInfo + DebianLike)
    forall a b. (a -> b) -> a -> b
    $ \(PrivData -> Propellor Result) -> Propellor Result
    getkey ->
    		Package
    -> Propellor Result
    -> Property
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
    forall {k} (metatypes :: k).
    SingI metatypes =>
    Package -> Propellor Result -> Property (MetaTypes metatypes)
    property Package
    desc (Propellor Result
     -> Property
          (MetaTypes
             '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
    -> Propellor Result
    -> Property
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
    forall a b. (a -> b) -> a -> b
    $ (PrivData -> Propellor Result) -> Propellor Result
    getkey ((PrivData -> Propellor Result) -> Propellor Result)
    -> (PrivData -> Propellor Result) -> Propellor Result
    forall a b. (a -> b) -> a -> b
    $ \PrivData
    key' -> do
    			let keylines :: [Package]
    keylines = PrivData -> [Package]
    privDataLines PrivData
    key'
    			Propellor Bool
    -> (Propellor Result, Propellor Result) -> Propellor Result
    forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
    ifM (IO Bool -> Propellor Bool
    forall a. IO a -> Propellor a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Bool -> Propellor Bool) -> IO Bool -> Propellor Bool
    forall a b. (a -> b) -> a -> b
    $ Maybe GpgKeyType -> IO Bool
    hasGpgKey ([Package] -> Maybe GpgKeyType
    parse [Package]
    keylines))
    				( Result -> Propellor Result
    forall a. a -> Propellor a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Result
    NoChange
    				, IO () -> Propellor Result
    makeChange (IO () -> Propellor Result) -> IO () -> Propellor Result
    forall a b. (a -> b) -> a -> b
    $ StdHandle
    -> CreateProcessRunner
    -> CreateProcess
    -> (Handle -> IO ())
    -> IO ()
    forall a.
    StdHandle
    -> CreateProcessRunner -> CreateProcess -> (Handle -> IO a) -> IO a
    withHandle StdHandle
    StdinHandle CreateProcess
    -> ((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
        -> IO a)
    -> IO a
    CreateProcessRunner
    createProcessSuccess
    					(Package -> [Package] -> CreateProcess
    proc Package
    "su" [Package
    "--login", Package
    "-c", Package
    "gpg --import", Package
    u]) ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Handle
    h -> do
    						Handle -> Package -> IO ()
    hPutStr Handle
    h ([Package] -> Package
    unlines [Package]
    keylines)
    						Handle -> IO ()
    hClose Handle
    h
    				)
    	src :: PrivDataSource
    src = PrivDataField -> Package -> PrivDataSource
    PrivDataSource PrivDataField
    GpgKey Package
    "Either a gpg public key, exported with gpg --export -a, or a gpg private key, exported with gpg --export-secret-key -a"

    	parse :: [Package] -> Maybe GpgKeyType
    parse (Package
    "-----BEGIN PGP PUBLIC KEY BLOCK-----":[Package]
    _) = GpgKeyType -> Maybe GpgKeyType
    forall a. a -> Maybe a
    Just GpgKeyType
    GpgPubKey
    	parse (Package
    "-----BEGIN PGP PRIVATE KEY BLOCK-----":[Package]
    _) = GpgKeyType -> Maybe GpgKeyType
    forall a. a -> Maybe a
    Just GpgKeyType
    GpgPrivKey
    	parse [Package]
    _ = Maybe GpgKeyType
    forall a. Maybe a
    Nothing

    	hasGpgKey :: Maybe GpgKeyType -> IO Bool
    hasGpgKey Maybe GpgKeyType
    Nothing = Package -> IO Bool
    forall a. HasCallStack => Package -> a
    error (Package -> IO Bool) -> Package -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ Package
    "Failed to run gpg parser on armored key " Package -> Package -> Package
    forall a. [a] -> [a] -> [a]
    ++ Package
    keyid
    	hasGpgKey (Just GpgKeyType
    GpgPubKey) = GpgKeyId -> User -> IO Bool
    hasPubKey GpgKeyId
    key User
    user
    	hasGpgKey (Just GpgKeyType
    GpgPrivKey) = GpgKeyId -> User -> IO Bool
    hasPrivKey GpgKeyId
    key User
    user

    hasPrivKey :: GpgKeyId -> User -> IO Bool
    hasPrivKey :: GpgKeyId -> User -> IO Bool
    hasPrivKey (GpgKeyId Package
    keyid) (User Package
    u) = IO Bool -> IO Bool
    forall (m :: * -> *). MonadCatch m => m Bool -> m Bool
    catchBoolIO (IO Bool -> IO Bool) -> IO Bool -> IO Bool
    forall a b. (a -> b) -> a -> b
    $
    	(Package, Bool) -> Bool
    forall a b. (a, b) -> b
    snd ((Package, Bool) -> Bool) -> IO (Package, Bool) -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Package -> [Package] -> Maybe Package -> IO (Package, Bool)
    processTranscript Package
    "su" [Package
    "--login", Package
    "-c", Package
    "gpg --list-secret-keys " Package -> Package -> Package
    forall a. [a] -> [a] -> [a]
    ++ Package -> Package
    shellEscape Package
    keyid, Package
    u] Maybe Package
    forall a. Maybe a
    Nothing

    hasPubKey :: GpgKeyId -> User -> IO Bool
    hasPubKey :: GpgKeyId -> User -> IO Bool
    hasPubKey (GpgKeyId Package
    keyid) (User Package
    u) = IO Bool -> IO Bool
    forall (m :: * -> *). MonadCatch m => m Bool -> m Bool
    catchBoolIO (IO Bool -> IO Bool) -> IO Bool -> IO Bool
    forall a b. (a -> b) -> a -> b
    $
    	(Package, Bool) -> Bool
    forall a b. (a, b) -> b
    snd ((Package, Bool) -> Bool) -> IO (Package, Bool) -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Package -> [Package] -> Maybe Package -> IO (Package, Bool)
    processTranscript Package
    "su" [Package
    "--login", Package
    "-c", Package
    "gpg --list-public-keys " Package -> Package -> Package
    forall a. [a] -> [a] -> [a]
    ++ Package -> Package
    shellEscape Package
    keyid, Package
    u] Maybe Package
    forall a. Maybe a
    Nothing

    dotDir :: User -> IO FilePath
    dotDir :: User -> IO Package
    dotDir (User Package
    u) = do
    	home <- UserEntry -> Package
    homeDirectory (UserEntry -> Package) -> IO UserEntry -> IO Package
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Package -> IO UserEntry
    getUserEntryForName Package
    u
    	return $ home </> ".gnupg"