module Propellor.Property.Gpg where

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

import System.PosixCompat

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 (HasInfo + DebianLike)
prop
	forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
installed
  where
	desc :: Package
desc = Package
u forall a. [a] -> [a] -> [a]
++ Package
" has gpg key " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> Package
show Package
keyid
	prop :: Property (HasInfo + DebianLike)
	prop :: Property (HasInfo + DebianLike)
prop = 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) forall a b. (a -> b) -> a -> b
$ \(PrivData -> Propellor Result) -> Propellor Result
getkey ->
		forall {k} (metatypes :: k).
SingI metatypes =>
Package -> Propellor Result -> Property (MetaTypes metatypes)
property Package
desc forall a b. (a -> b) -> a -> b
$ (PrivData -> Propellor Result) -> Propellor Result
getkey forall a b. (a -> b) -> a -> b
$ \PrivData
key' -> do
			let keylines :: [Package]
keylines = PrivData -> [Package]
privDataLines PrivData
key'
			forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Maybe GpgKeyType -> IO Bool
hasGpgKey ([Package] -> Maybe GpgKeyType
parse [Package]
keylines))
				( forall (m :: * -> *) a. Monad m => a -> m a
return Result
NoChange
				, IO () -> Propellor Result
makeChange forall a b. (a -> b) -> a -> b
$ forall a.
StdHandle
-> CreateProcessRunner -> CreateProcess -> (Handle -> IO a) -> IO a
withHandle StdHandle
StdinHandle CreateProcessRunner
createProcessSuccess
					(Package -> [Package] -> CreateProcess
proc Package
"su" [Package
"--login", Package
"-c", Package
"gpg --import", Package
u]) 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]
_) = forall a. a -> Maybe a
Just GpgKeyType
GpgPubKey
	parse (Package
"-----BEGIN PGP PRIVATE KEY BLOCK-----":[Package]
_) = forall a. a -> Maybe a
Just GpgKeyType
GpgPrivKey
	parse [Package]
_ = forall a. Maybe a
Nothing

	hasGpgKey :: Maybe GpgKeyType -> IO Bool
hasGpgKey Maybe GpgKeyType
Nothing = forall a. HasCallStack => Package -> a
error forall a b. (a -> b) -> a -> b
$ Package
"Failed to run gpg parser on armored key " 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) = forall (m :: * -> *). MonadCatch m => m Bool -> m Bool
catchBoolIO forall a b. (a -> b) -> a -> b
$
	forall a b. (a, b) -> b
snd 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 " forall a. [a] -> [a] -> [a]
++ Package -> Package
shellEscape Package
keyid, Package
u] forall a. Maybe a
Nothing

hasPubKey :: GpgKeyId -> User -> IO Bool
hasPubKey :: GpgKeyId -> User -> IO Bool
hasPubKey (GpgKeyId Package
keyid) (User Package
u) = forall (m :: * -> *). MonadCatch m => m Bool -> m Bool
catchBoolIO forall a b. (a -> b) -> a -> b
$
	forall a b. (a, b) -> b
snd 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 " forall a. [a] -> [a] -> [a]
++ Package -> Package
shellEscape Package
keyid, Package
u] forall a. Maybe a
Nothing

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