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
  (Sing '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
Property (HasInfo + DebianLike)
prop
	Property
  (Sing '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property DebianLike
-> CombinedType
     (Property
        (Sing '[ '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
         (Sing '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
-> Property
     (Sing '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
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
       (Sing '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
 -> Property
      (Sing '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
-> (((PrivData -> Propellor Result) -> Propellor Result)
    -> Property
         (Sing '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
-> Property
     (Sing '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
forall a b. (a -> b) -> a -> b
$ \(PrivData -> Propellor Result) -> Propellor Result
getkey ->
		Package
-> Propellor Result
-> Property
     (Sing '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
forall k (metatypes :: k).
SingI metatypes =>
Package -> Propellor Result -> Property (MetaTypes metatypes)
property Package
desc (Propellor Result
 -> Property
      (Sing '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
-> Propellor Result
-> Property
     (Sing '[ '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 (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 (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 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
	Package
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
	Package -> IO Package
forall (m :: * -> *) a. Monad m => a -> m a
return (Package -> IO Package) -> Package -> IO Package
forall a b. (a -> b) -> a -> b
$ Package
home Package -> Package -> Package
</> Package
".gnupg"