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
providerFor :: [User] -> HostName -> Maybe Port -> Property (HasInfo + DebianLike)
providerFor :: [User]
-> [Char]
-> Maybe Port
-> Property
(HasInfo
+ MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
providerFor [User]
users [Char]
hn Maybe Port
mp = [Char]
-> Props
(MetaTypes
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property
(MetaTypes
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
forall {k} (metatypes :: k).
SingI metatypes =>
[Char]
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
propertyList [Char]
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
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> 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))
& [Char]
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
Apt.serviceInstalledRunning [Char]
"apache2"
Props (MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> 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
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
apacheconfigured
Props (MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> 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))
& [[Char]]
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
Apt.installed [[Char]
"simpleid"]
Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> CombinedType
(Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
(Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
Apache.restarted
Props (MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> 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))
& [Char] -> ([[Char]] -> [[Char]]) -> [Char] -> Property UnixLike
forall c.
(FileContent c, Eq c) =>
[Char] -> (c -> c) -> [Char] -> Property UnixLike
File.fileProperty ([Char]
desc [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" configured")
(([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [Char]
setbaseurl) [Char]
"/etc/simpleid/config.inc"
Props (MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> 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))
& [Char]
-> 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 =>
[Char]
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
propertyList [Char]
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 :: [Char]
baseurl = [Char]
hn [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ case Maybe Port
mp of
Maybe Port
Nothing -> [Char]
""
Just Port
p -> Char
':' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Port -> [Char]
forall t. ConfigurableValue t => t -> [Char]
val Port
p
url :: [Char]
url = [Char]
"http://"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
baseurl[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"/simpleid"
desc :: [Char]
desc = [Char]
"openid provider " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
url
setbaseurl :: [Char] -> [Char]
setbaseurl [Char]
l
| [Char]
"SIMPLEID_BASE_URL" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` [Char]
l =
[Char]
"define('SIMPLEID_BASE_URL', '"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
url[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"');"
| Bool
otherwise = [Char]
l
apacheconfigured :: Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
apacheconfigured = case Maybe Port
mp of
Maybe Port
Nothing -> RevertableProperty
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
forall setupmetatypes undometatypes.
RevertableProperty setupmetatypes undometatypes
-> Property setupmetatypes
setupRevertableProperty (RevertableProperty
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
-> RevertableProperty
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
forall a b. (a -> b) -> a -> b
$
[Char]
-> Port
-> [Char]
-> RevertableProperty
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
Apache.virtualHost [Char]
hn (Int -> Port
Port Int
80) [Char]
"/var/www/html"
Just Port
p -> [Char]
-> Props
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
forall {k} (metatypes :: k).
SingI metatypes =>
[Char]
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
propertyList [Char]
desc (Props (MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
-> Props
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
Props UnixLike
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> 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
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
Apache.listenPorts [Port
p]
Props (MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> RevertableProperty
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> 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))
& [Char]
-> Port
-> [Char]
-> RevertableProperty
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
Apache.virtualHost [Char]
hn Port
p [Char]
"/var/www/html"
identfile :: User -> Property (HasInfo + UnixLike)
identfile (User [Char]
u) = [Char] -> Context -> Property (HasInfo + UnixLike)
forall c.
IsContext c =>
[Char] -> c -> Property (HasInfo + UnixLike)
File.hasPrivContentExposed
([[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [Char]
"/var/lib/simpleid/identities/", [Char]
u, [Char]
".identity" ])
([Char] -> Context
Context [Char]
baseurl)