module Propellor.Property.OpenId where

import Propellor.Base
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Apache as Apache

import Data.List

-- | Openid provider, using the simpleid PHP CGI, with apache.
--
-- Runs on usual port by default. When a nonstandard port is specified,
-- apache is limited to listening only on that port. Warning: Specifying
-- a port won't compose well with other apache properties on the same
-- host.
--
-- It's probably a good idea to put this property inside a docker or
-- systemd-nspawn container.
providerFor :: [User] -> HostName -> Maybe Port -> Property (HasInfo + DebianLike)
providerFor :: [User] -> HostName -> Maybe Port -> Property (HasInfo + DebianLike)
providerFor [User]
users HostName
hn Maybe Port
mp = HostName
-> Props
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
forall k (metatypes :: k).
SingI metatypes =>
HostName
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
propertyList HostName
desc (Props
   (MetaTypes
      '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
 -> Property
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
-> Props
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
	Props UnixLike
-> 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))
& HostName -> Property DebianLike
Apt.serviceInstalledRunning HostName
"apache2"
	Props DebianLike
-> Property DebianLike
-> Props
     (MetaTypes
        (Combine
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
           '[ '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
apacheconfigured
	Props DebianLike
-> Property DebianLike
-> Props
     (MetaTypes
        (Combine
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
           '[ '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))
& [HostName] -> Property DebianLike
Apt.installed [HostName
"simpleid"]
		Property DebianLike
-> Property DebianLike
-> CombinedType (Property DebianLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property DebianLike
Apache.restarted
	Props DebianLike
-> Property UnixLike
-> 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))
& HostName
-> ([HostName] -> [HostName]) -> HostName -> Property UnixLike
forall c.
(FileContent c, Eq c) =>
HostName -> (c -> c) -> HostName -> Property UnixLike
File.fileProperty (HostName
desc HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ HostName
" configured")
		((HostName -> HostName) -> [HostName] -> [HostName]
forall a b. (a -> b) -> [a] -> [b]
map HostName -> HostName
setbaseurl) HostName
"/etc/simpleid/config.inc"
	Props DebianLike
-> Property
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Props
     (MetaTypes
        (Combine
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
           '[ 'WithInfo, '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))
& HostName
-> Props
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall k (metatypes :: k).
SingI metatypes =>
HostName
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
propertyList HostName
desc ([Property
   (MetaTypes
      '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])]
-> Props
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall k (metatypes :: k).
[Property (MetaTypes metatypes)] -> Props (MetaTypes metatypes)
toProps ([Property
    (MetaTypes
       '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
          'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])]
 -> Props
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> [Property
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])]
-> Props
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall a b. (a -> b) -> a -> b
$ (User
 -> Property
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> [User]
-> [Property
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])]
forall a b. (a -> b) -> [a] -> [b]
map User
-> Property
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
identfile [User]
users)
  where
	baseurl :: HostName
baseurl = HostName
hn HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ case Maybe Port
mp of
		Maybe Port
Nothing -> HostName
""
		Just Port
p -> Char
':' Char -> HostName -> HostName
forall a. a -> [a] -> [a]
: Port -> HostName
forall t. ConfigurableValue t => t -> HostName
val Port
p
	url :: HostName
url = HostName
"http://"HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++HostName
baseurlHostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++HostName
"/simpleid"
	desc :: HostName
desc = HostName
"openid provider " HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ HostName
url
	setbaseurl :: HostName -> HostName
setbaseurl HostName
l
		| HostName
"SIMPLEID_BASE_URL" HostName -> HostName -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` HostName
l =
			HostName
"define('SIMPLEID_BASE_URL', '"HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++HostName
urlHostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++HostName
"');"
		| Bool
otherwise = HostName
l

	apacheconfigured :: Property DebianLike
apacheconfigured = case Maybe Port
mp of
		Maybe Port
Nothing -> RevertableProperty DebianLike DebianLike -> Property DebianLike
forall setupmetatypes undometatypes.
RevertableProperty setupmetatypes undometatypes
-> Property setupmetatypes
setupRevertableProperty (RevertableProperty DebianLike DebianLike -> Property DebianLike)
-> RevertableProperty DebianLike DebianLike -> Property DebianLike
forall a b. (a -> b) -> a -> b
$
			HostName
-> Port -> HostName -> RevertableProperty DebianLike DebianLike
Apache.virtualHost HostName
hn (Int -> Port
Port Int
80) HostName
"/var/www/html"
		Just Port
p -> HostName -> Props DebianLike -> Property DebianLike
forall k (metatypes :: k).
SingI metatypes =>
HostName
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
propertyList HostName
desc (Props DebianLike -> Property DebianLike)
-> Props DebianLike -> Property DebianLike
forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
			Props UnixLike
-> 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))
& [Port] -> Property DebianLike
Apache.listenPorts [Port
p]
			Props DebianLike
-> RevertableProperty DebianLike DebianLike
-> Props
     (MetaTypes
        (Combine
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
           '[ '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))
& HostName
-> Port -> HostName -> RevertableProperty DebianLike DebianLike
Apache.virtualHost HostName
hn Port
p HostName
"/var/www/html"

	-- the identities directory controls access, so open up
	-- file mode
	identfile :: User -> Property (HasInfo + UnixLike)
identfile (User HostName
u) = HostName -> Context -> Property (HasInfo + UnixLike)
forall c.
IsContext c =>
HostName -> c -> Property (HasInfo + UnixLike)
File.hasPrivContentExposed
		([HostName] -> HostName
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ HostName
"/var/lib/simpleid/identities/", HostName
u, HostName
".identity" ])
		(HostName -> Context
Context HostName
baseurl)