    -- | This module gets LetsEncrypt <https://letsencrypt.org/> certificates
    -- using CertBot <https://certbot.eff.org/>

    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"]

    -- | Tell the letsencrypt client that you agree with the Let's Encrypt
    -- Subscriber Agreement. Providing an email address is recommended,
    -- so that letcencrypt can contact you about problems.
    data AgreeTOS = AgreeTOS (Maybe Email)

    type Email = String

    type WebRoot = FilePath

    -- | Uses letsencrypt to obtain a certificate for a domain.
    --
    -- This should work with any web server, as long as letsencrypt can
    -- write its temp files to the web root. The letsencrypt client does
    -- not modify the web server's configuration in any way; this only obtains
    -- the certificate it does not make the web server use it.
    --
    -- This also handles renewing the certificate.
    -- For renewel to work well, propellor needs to be
    -- run periodically (at least a couple times per month).
    --
    -- This property returns `MadeChange` when the certificate is initially
    -- obtained, and when it's renewed. So, it can be combined with a property
    -- to make the webserver (or other server) use the certificate:
    --
    -- > letsEncrypt (AgreeTOS (Just "me@example.com")) "example.com" "/var/www"
    -- > 	`onChange` Apache.reload
    --
    -- See `Propellor.Property.Apache.httpsVirtualHost` for a more complete
    -- integration of apache with letsencrypt, that's built on top of this.
    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 []

    -- | Like `letsEncrypt`, but the certificate can be obtained for multiple
    -- domains.
    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 a. IO a -> Propellor a
    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 a. IO a -> Propellor a
    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 a. IO a -> Propellor a
    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 a. a -> Propellor a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Result
    MadeChange
    					else Result -> Propellor Result
    forall a. a -> Propellor a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Result
    NoChange
    			else do
    				IO () -> Propellor ()
    forall a. IO a -> Propellor a
    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 a. a -> Propellor a
    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"
    		-- The list of domains may be changed, adding more, so
    		-- always request expansion.
    		, 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)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 a. a -> IO a
    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)

    -- | The cerificate files that letsencrypt will make available for a domain.
    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"