-- | 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 = Package -> Props DebianLike -> Property DebianLike
forall k (metatypes :: k).
SingI metatypes =>
Package
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
propertyList Package
"safe dhparams" (Props DebianLike -> Property DebianLike)
-> Props DebianLike -> Property DebianLike
forall a b. (a -> b) -> a -> b
$ Props
  (Sing
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
props
	Props
  (Sing
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Props
     (MetaTypes
        (Combine
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
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
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
File.dirExists (Package -> Package
takeDirectory Package
dhparams)
	Props
  (Sing
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property DebianLike
-> Props
     (MetaTypes
        (Combine
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
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
	Props DebianLike
-> Property
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Props
     (MetaTypes
        (Combine
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
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))
& IO Bool
-> Property
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Bool -> Bool
not (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Package -> IO Bool
doesFileExist Package
dhparams) (Package
-> Int
-> Property
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
createDhparams Package
dhparams Int
dhparamsLength)

createDhparams :: FilePath -> Int -> Property UnixLike
createDhparams :: Package
-> Int
-> Property
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
createDhparams Package
f Int
l = Package
-> Propellor Result
-> Property
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall k (metatypes :: k).
SingI metatypes =>
Package -> Propellor Result -> Property (MetaTypes metatypes)
property (Package
"generate new dhparams: " Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Package
f) (Propellor Result
 -> Property
      (Sing
         '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> Propellor Result
-> Property
     (Sing
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall a b. (a -> b) -> a -> b
$ IO Result -> Propellor Result
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Result -> Propellor Result) -> IO Result -> Propellor Result
forall a b. (a -> b) -> a -> b
$ FileMode -> IO Result -> IO Result
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
FileMode -> m a -> m a
withUmask FileMode
0o0177 (IO Result -> IO Result) -> IO Result -> IO Result
forall a b. (a -> b) -> a -> b
$ Package -> IOMode -> (Handle -> IO Result) -> IO Result
forall r. Package -> IOMode -> (Handle -> IO r) -> IO r
withFile Package
f IOMode
WriteMode ((Handle -> IO Result) -> IO Result)
-> (Handle -> IO Result) -> IO Result
forall a b. (a -> b) -> a -> b
$ \Handle
h ->
	Bool -> Result
cmdResult (Bool -> Result) -> IO Bool -> IO Result
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 (Int -> Package
forall a. Show a => a -> Package
show Int
l)] (\CreateProcess
p -> CreateProcess
p { std_out :: StdStream
std_out = Handle -> StdStream
UseHandle Handle
h })