-- | Maintainer: Félix Sipma <felix+propellor@gueux.org>

module Propellor.Property.Openssl where

import Propellor.Base
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.File as File
import Utility.SafeCommand

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

dhparamsLength :: Int
dhparamsLength :: Int
dhparamsLength = Int
2048

dhparams :: FilePath
dhparams :: Package
dhparams = Package
"/etc/ssl/private/dhparams.pem"

safeDhparams :: Property DebianLike
safeDhparams :: Property DebianLike
safeDhparams = forall {k} (metatypes :: k).
SingI metatypes =>
Package
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
propertyList Package
"safe dhparams" forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
	forall {a} p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
 CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& Package -> Property UnixLike
File.dirExists (Package -> Package
takeDirectory Package
dhparams)
	forall {a} p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
 CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& Property DebianLike
installed
	forall {a} p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
 CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Package -> IO Bool
doesFileExist Package
dhparams) (Package -> Int -> Property UnixLike
createDhparams Package
dhparams Int
dhparamsLength)

createDhparams :: FilePath -> Int -> Property UnixLike
createDhparams :: Package -> Int -> Property UnixLike
createDhparams Package
f Int
l = forall {k} (metatypes :: k).
SingI metatypes =>
Package -> Propellor Result -> Property (MetaTypes metatypes)
property (Package
"generate new dhparams: " forall a. [a] -> [a] -> [a]
++ Package
f) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
FileMode -> m a -> m a
withUmask FileMode
0o0177 forall a b. (a -> b) -> a -> b
$ forall r. Package -> IOMode -> (Handle -> IO r) -> IO r
withFile Package
f IOMode
WriteMode forall a b. (a -> b) -> a -> b
$ \Handle
h ->
	Bool -> Result
cmdResult forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Package
-> [CommandParam] -> (CreateProcess -> CreateProcess) -> IO Bool
boolSystem' Package
"openssl" [Package -> CommandParam
Param Package
"dhparam", Package -> CommandParam
Param (forall a. Show a => a -> Package
show Int
l)] (\CreateProcess
p -> CreateProcess
p { std_out :: StdStream
std_out = Handle -> StdStream
UseHandle Handle
h })