module Propellor.Property.LetsEncrypt where
import Propellor.Base
import qualified Propellor.Property.Apt as Apt
import System.Posix.Files
installed :: Property DebianLike
installed :: Property DebianLike
installed = [Package] -> Property DebianLike
Apt.installed [Package
"certbot"]
data AgreeTOS = AgreeTOS (Maybe Email)
type Email = String
type WebRoot = FilePath
letsEncrypt :: AgreeTOS -> Domain -> WebRoot -> Property DebianLike
letsEncrypt :: AgreeTOS -> Package -> Package -> Property DebianLike
letsEncrypt AgreeTOS
tos Package
domain = AgreeTOS -> Package -> [Package] -> Package -> Property DebianLike
letsEncrypt' AgreeTOS
tos Package
domain []
letsEncrypt' :: AgreeTOS -> Domain -> [Domain] -> WebRoot -> Property DebianLike
letsEncrypt' :: AgreeTOS -> Package -> [Package] -> Package -> Property DebianLike
letsEncrypt' (AgreeTOS Maybe Package
memail) Package
domain [Package]
domains Package
webroot =
Property UnixLike
prop Property UnixLike
-> Property DebianLike
-> CombinedType (Property UnixLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
installed
where
prop :: Property UnixLike
prop :: Property UnixLike
prop = Package -> Propellor Result -> Property UnixLike
forall k (metatypes :: k).
SingI metatypes =>
Package -> Propellor Result -> Property (MetaTypes metatypes)
property Package
desc (Propellor Result -> Property UnixLike)
-> Propellor Result -> Property UnixLike
forall a b. (a -> b) -> a -> b
$ do
[[Maybe (FileID, DeviceID, FileMode, FileOffset, EpochTime)]]
startstats <- IO [[Maybe (FileID, DeviceID, FileMode, FileOffset, EpochTime)]]
-> Propellor
[[Maybe (FileID, DeviceID, FileMode, FileOffset, EpochTime)]]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [[Maybe (FileID, DeviceID, FileMode, FileOffset, EpochTime)]]
getstats
(Package
transcript, Bool
ok) <- IO (Package, Bool) -> Propellor (Package, Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Package, Bool) -> Propellor (Package, Bool))
-> IO (Package, Bool) -> Propellor (Package, Bool)
forall a b. (a -> b) -> a -> b
$
Package -> [Package] -> Maybe Package -> IO (Package, Bool)
processTranscript Package
"letsencrypt" [Package]
params Maybe Package
forall a. Maybe a
Nothing
if Bool
ok
then do
[[Maybe (FileID, DeviceID, FileMode, FileOffset, EpochTime)]]
endstats <- IO [[Maybe (FileID, DeviceID, FileMode, FileOffset, EpochTime)]]
-> Propellor
[[Maybe (FileID, DeviceID, FileMode, FileOffset, EpochTime)]]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [[Maybe (FileID, DeviceID, FileMode, FileOffset, EpochTime)]]
getstats
if [[Maybe (FileID, DeviceID, FileMode, FileOffset, EpochTime)]]
startstats [[Maybe (FileID, DeviceID, FileMode, FileOffset, EpochTime)]]
-> [[Maybe (FileID, DeviceID, FileMode, FileOffset, EpochTime)]]
-> Bool
forall a. Eq a => a -> a -> Bool
/= [[Maybe (FileID, DeviceID, FileMode, FileOffset, EpochTime)]]
endstats
then Result -> Propellor Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
MadeChange
else Result -> Propellor Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
NoChange
else do
IO () -> Propellor ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Propellor ()) -> IO () -> Propellor ()
forall a b. (a -> b) -> a -> b
$ Handle -> Package -> IO ()
hPutStr Handle
stderr Package
transcript
Result -> Propellor Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
FailedChange
desc :: Package
desc = Package
"letsencrypt " Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ [Package] -> Package
unwords [Package]
alldomains
alldomains :: [Package]
alldomains = Package
domain Package -> [Package] -> [Package]
forall a. a -> [a] -> [a]
: [Package]
domains
params :: [Package]
params =
[ Package
"certonly"
, Package
"--agree-tos"
, case Maybe Package
memail of
Just Package
email -> Package
"--email="Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++Package
email
Maybe Package
Nothing -> Package
"--register-unsafely-without-email"
, Package
"--webroot"
, Package
"--webroot-path", Package
webroot
, Package
"--text"
, Package
"--noninteractive"
, Package
"--keep-until-expiring"
, Package
"--expand"
] [Package] -> [Package] -> [Package]
forall a. [a] -> [a] -> [a]
++ (Package -> Package) -> [Package] -> [Package]
forall a b. (a -> b) -> [a] -> [b]
map (\Package
d -> Package
"--domain="Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++Package
d) [Package]
alldomains
getstats :: IO [[Maybe (FileID, DeviceID, FileMode, FileOffset, EpochTime)]]
getstats = (Package
-> IO [Maybe (FileID, DeviceID, FileMode, FileOffset, EpochTime)])
-> [Package]
-> IO [[Maybe (FileID, DeviceID, FileMode, FileOffset, EpochTime)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Package
-> IO [Maybe (FileID, DeviceID, FileMode, FileOffset, EpochTime)]
statcertfiles [Package]
alldomains
statcertfiles :: Package
-> IO [Maybe (FileID, DeviceID, FileMode, FileOffset, EpochTime)]
statcertfiles Package
d = (Package
-> IO (Maybe (FileID, DeviceID, FileMode, FileOffset, EpochTime)))
-> [Package]
-> IO [Maybe (FileID, DeviceID, FileMode, FileOffset, EpochTime)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Package
-> IO (Maybe (FileID, DeviceID, FileMode, FileOffset, EpochTime))
statfile
[ Package -> Package
certFile Package
d
, Package -> Package
privKeyFile Package
d
, Package -> Package
chainFile Package
d
, Package -> Package
fullChainFile Package
d
]
statfile :: Package
-> IO (Maybe (FileID, DeviceID, FileMode, FileOffset, EpochTime))
statfile Package
f = IO (FileID, DeviceID, FileMode, FileOffset, EpochTime)
-> IO (Maybe (FileID, DeviceID, FileMode, FileOffset, EpochTime))
forall (m :: * -> *) a. MonadCatch m => m a -> m (Maybe a)
catchMaybeIO (IO (FileID, DeviceID, FileMode, FileOffset, EpochTime)
-> IO (Maybe (FileID, DeviceID, FileMode, FileOffset, EpochTime)))
-> IO (FileID, DeviceID, FileMode, FileOffset, EpochTime)
-> IO (Maybe (FileID, DeviceID, FileMode, FileOffset, EpochTime))
forall a b. (a -> b) -> a -> b
$ do
FileStatus
s <- Package -> IO FileStatus
getFileStatus Package
f
(FileID, DeviceID, FileMode, FileOffset, EpochTime)
-> IO (FileID, DeviceID, FileMode, FileOffset, EpochTime)
forall (m :: * -> *) a. Monad m => a -> m a
return (FileStatus -> FileID
fileID FileStatus
s, FileStatus -> DeviceID
deviceID FileStatus
s, FileStatus -> FileMode
fileMode FileStatus
s, FileStatus -> FileOffset
fileSize FileStatus
s, FileStatus -> EpochTime
modificationTime FileStatus
s)
liveCertDir :: Domain -> FilePath
liveCertDir :: Package -> Package
liveCertDir Package
d = Package
"/etc/letsencrypt/live" Package -> Package -> Package
</> Package
d
certFile :: Domain -> FilePath
certFile :: Package -> Package
certFile Package
d = Package -> Package
liveCertDir Package
d Package -> Package -> Package
</> Package
"cert.pem"
privKeyFile :: Domain -> FilePath
privKeyFile :: Package -> Package
privKeyFile Package
d = Package -> Package
liveCertDir Package
d Package -> Package -> Package
</> Package
"privkey.pem"
chainFile :: Domain -> FilePath
chainFile :: Package -> Package
chainFile Package
d = Package -> Package
liveCertDir Package
d Package -> Package -> Package
</> Package
"chain.pem"
fullChainFile :: Domain -> FilePath
fullChainFile :: Package -> Package
fullChainFile Package
d = Package -> Package
liveCertDir Package
d Package -> Package -> Package
</> Package
"fullchain.pem"