{-# LANGUAGE DeriveDataTypeable #-}
module Propellor.Types.OS (
System(..),
Distribution(..),
TargetOS(..),
DebianKernel(..),
DebianSuite(..),
FreeBSDRelease(..),
FBSDVersion(..),
isStable,
Release,
Architecture(..),
architectureToDebianArchString,
HostName,
UserName,
User(..),
Group(..),
userGroup,
Port(..),
systemToTargetOS,
) where
import Propellor.Types.ConfigurableValue
import Network.Socket (HostName)
import Data.Typeable
import Data.String
data System = System Distribution Architecture
deriving (Int -> System -> ShowS
[System] -> ShowS
System -> String
(Int -> System -> ShowS)
-> (System -> String) -> ([System] -> ShowS) -> Show System
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [System] -> ShowS
$cshowList :: [System] -> ShowS
show :: System -> String
$cshow :: System -> String
showsPrec :: Int -> System -> ShowS
$cshowsPrec :: Int -> System -> ShowS
Show, System -> System -> Bool
(System -> System -> Bool)
-> (System -> System -> Bool) -> Eq System
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: System -> System -> Bool
$c/= :: System -> System -> Bool
== :: System -> System -> Bool
$c== :: System -> System -> Bool
Eq, Typeable)
data Distribution
= Debian DebianKernel DebianSuite
| Buntish Release
| ArchLinux
| FreeBSD FreeBSDRelease
deriving (Int -> Distribution -> ShowS
[Distribution] -> ShowS
Distribution -> String
(Int -> Distribution -> ShowS)
-> (Distribution -> String)
-> ([Distribution] -> ShowS)
-> Show Distribution
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Distribution] -> ShowS
$cshowList :: [Distribution] -> ShowS
show :: Distribution -> String
$cshow :: Distribution -> String
showsPrec :: Int -> Distribution -> ShowS
$cshowsPrec :: Int -> Distribution -> ShowS
Show, Distribution -> Distribution -> Bool
(Distribution -> Distribution -> Bool)
-> (Distribution -> Distribution -> Bool) -> Eq Distribution
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Distribution -> Distribution -> Bool
$c/= :: Distribution -> Distribution -> Bool
== :: Distribution -> Distribution -> Bool
$c== :: Distribution -> Distribution -> Bool
Eq)
data TargetOS
= OSDebian
| OSBuntish
| OSArchLinux
| OSFreeBSD
deriving (Int -> TargetOS -> ShowS
[TargetOS] -> ShowS
TargetOS -> String
(Int -> TargetOS -> ShowS)
-> (TargetOS -> String) -> ([TargetOS] -> ShowS) -> Show TargetOS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TargetOS] -> ShowS
$cshowList :: [TargetOS] -> ShowS
show :: TargetOS -> String
$cshow :: TargetOS -> String
showsPrec :: Int -> TargetOS -> ShowS
$cshowsPrec :: Int -> TargetOS -> ShowS
Show, TargetOS -> TargetOS -> Bool
(TargetOS -> TargetOS -> Bool)
-> (TargetOS -> TargetOS -> Bool) -> Eq TargetOS
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TargetOS -> TargetOS -> Bool
$c/= :: TargetOS -> TargetOS -> Bool
== :: TargetOS -> TargetOS -> Bool
$c== :: TargetOS -> TargetOS -> Bool
Eq, Eq TargetOS
Eq TargetOS
-> (TargetOS -> TargetOS -> Ordering)
-> (TargetOS -> TargetOS -> Bool)
-> (TargetOS -> TargetOS -> Bool)
-> (TargetOS -> TargetOS -> Bool)
-> (TargetOS -> TargetOS -> Bool)
-> (TargetOS -> TargetOS -> TargetOS)
-> (TargetOS -> TargetOS -> TargetOS)
-> Ord TargetOS
TargetOS -> TargetOS -> Bool
TargetOS -> TargetOS -> Ordering
TargetOS -> TargetOS -> TargetOS
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TargetOS -> TargetOS -> TargetOS
$cmin :: TargetOS -> TargetOS -> TargetOS
max :: TargetOS -> TargetOS -> TargetOS
$cmax :: TargetOS -> TargetOS -> TargetOS
>= :: TargetOS -> TargetOS -> Bool
$c>= :: TargetOS -> TargetOS -> Bool
> :: TargetOS -> TargetOS -> Bool
$c> :: TargetOS -> TargetOS -> Bool
<= :: TargetOS -> TargetOS -> Bool
$c<= :: TargetOS -> TargetOS -> Bool
< :: TargetOS -> TargetOS -> Bool
$c< :: TargetOS -> TargetOS -> Bool
compare :: TargetOS -> TargetOS -> Ordering
$ccompare :: TargetOS -> TargetOS -> Ordering
$cp1Ord :: Eq TargetOS
Ord)
systemToTargetOS :: System -> TargetOS
systemToTargetOS :: System -> TargetOS
systemToTargetOS (System (Debian DebianKernel
_ DebianSuite
_) Architecture
_) = TargetOS
OSDebian
systemToTargetOS (System (Buntish String
_) Architecture
_) = TargetOS
OSBuntish
systemToTargetOS (System (Distribution
ArchLinux) Architecture
_) = TargetOS
OSArchLinux
systemToTargetOS (System (FreeBSD FreeBSDRelease
_) Architecture
_) = TargetOS
OSFreeBSD
data DebianKernel = Linux | KFreeBSD | Hurd
deriving (Int -> DebianKernel -> ShowS
[DebianKernel] -> ShowS
DebianKernel -> String
(Int -> DebianKernel -> ShowS)
-> (DebianKernel -> String)
-> ([DebianKernel] -> ShowS)
-> Show DebianKernel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebianKernel] -> ShowS
$cshowList :: [DebianKernel] -> ShowS
show :: DebianKernel -> String
$cshow :: DebianKernel -> String
showsPrec :: Int -> DebianKernel -> ShowS
$cshowsPrec :: Int -> DebianKernel -> ShowS
Show, DebianKernel -> DebianKernel -> Bool
(DebianKernel -> DebianKernel -> Bool)
-> (DebianKernel -> DebianKernel -> Bool) -> Eq DebianKernel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebianKernel -> DebianKernel -> Bool
$c/= :: DebianKernel -> DebianKernel -> Bool
== :: DebianKernel -> DebianKernel -> Bool
$c== :: DebianKernel -> DebianKernel -> Bool
Eq)
data DebianSuite = Experimental | Unstable | Testing | Stable Release
deriving (Int -> DebianSuite -> ShowS
[DebianSuite] -> ShowS
DebianSuite -> String
(Int -> DebianSuite -> ShowS)
-> (DebianSuite -> String)
-> ([DebianSuite] -> ShowS)
-> Show DebianSuite
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebianSuite] -> ShowS
$cshowList :: [DebianSuite] -> ShowS
show :: DebianSuite -> String
$cshow :: DebianSuite -> String
showsPrec :: Int -> DebianSuite -> ShowS
$cshowsPrec :: Int -> DebianSuite -> ShowS
Show, DebianSuite -> DebianSuite -> Bool
(DebianSuite -> DebianSuite -> Bool)
-> (DebianSuite -> DebianSuite -> Bool) -> Eq DebianSuite
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebianSuite -> DebianSuite -> Bool
$c/= :: DebianSuite -> DebianSuite -> Bool
== :: DebianSuite -> DebianSuite -> Bool
$c== :: DebianSuite -> DebianSuite -> Bool
Eq)
data FreeBSDRelease = FBSDProduction FBSDVersion | FBSDLegacy FBSDVersion
deriving (Int -> FreeBSDRelease -> ShowS
[FreeBSDRelease] -> ShowS
FreeBSDRelease -> String
(Int -> FreeBSDRelease -> ShowS)
-> (FreeBSDRelease -> String)
-> ([FreeBSDRelease] -> ShowS)
-> Show FreeBSDRelease
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FreeBSDRelease] -> ShowS
$cshowList :: [FreeBSDRelease] -> ShowS
show :: FreeBSDRelease -> String
$cshow :: FreeBSDRelease -> String
showsPrec :: Int -> FreeBSDRelease -> ShowS
$cshowsPrec :: Int -> FreeBSDRelease -> ShowS
Show, FreeBSDRelease -> FreeBSDRelease -> Bool
(FreeBSDRelease -> FreeBSDRelease -> Bool)
-> (FreeBSDRelease -> FreeBSDRelease -> Bool) -> Eq FreeBSDRelease
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FreeBSDRelease -> FreeBSDRelease -> Bool
$c/= :: FreeBSDRelease -> FreeBSDRelease -> Bool
== :: FreeBSDRelease -> FreeBSDRelease -> Bool
$c== :: FreeBSDRelease -> FreeBSDRelease -> Bool
Eq)
data FBSDVersion = FBSD101 | FBSD102 | FBSD093
deriving (FBSDVersion -> FBSDVersion -> Bool
(FBSDVersion -> FBSDVersion -> Bool)
-> (FBSDVersion -> FBSDVersion -> Bool) -> Eq FBSDVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FBSDVersion -> FBSDVersion -> Bool
$c/= :: FBSDVersion -> FBSDVersion -> Bool
== :: FBSDVersion -> FBSDVersion -> Bool
$c== :: FBSDVersion -> FBSDVersion -> Bool
Eq)
instance IsString FBSDVersion where
fromString :: String -> FBSDVersion
fromString String
"10.1-RELEASE" = FBSDVersion
FBSD101
fromString String
"10.2-RELEASE" = FBSDVersion
FBSD102
fromString String
"9.3-RELEASE" = FBSDVersion
FBSD093
fromString String
_ = String -> FBSDVersion
forall a. HasCallStack => String -> a
error String
"Invalid FreeBSD release"
instance ConfigurableValue FBSDVersion where
val :: FBSDVersion -> String
val FBSDVersion
FBSD101 = String
"10.1-RELEASE"
val FBSDVersion
FBSD102 = String
"10.2-RELEASE"
val FBSDVersion
FBSD093 = String
"9.3-RELEASE"
instance Show FBSDVersion where
show :: FBSDVersion -> String
show = FBSDVersion -> String
forall t. ConfigurableValue t => t -> String
val
isStable :: DebianSuite -> Bool
isStable :: DebianSuite -> Bool
isStable (Stable String
_) = Bool
True
isStable DebianSuite
_ = Bool
False
type Release = String
data Architecture
= X86_64
| X86_32
| ARMHF
| ARMEL
| PPC
| PPC64
| SPARC
| SPARC64
| MIPS
| MIPSEL
| MIPS64EL
| SH4
| IA64
| S390
| S390X
| ALPHA
| HPPA
| M68K
| ARM64
| X32
deriving (Int -> Architecture -> ShowS
[Architecture] -> ShowS
Architecture -> String
(Int -> Architecture -> ShowS)
-> (Architecture -> String)
-> ([Architecture] -> ShowS)
-> Show Architecture
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Architecture] -> ShowS
$cshowList :: [Architecture] -> ShowS
show :: Architecture -> String
$cshow :: Architecture -> String
showsPrec :: Int -> Architecture -> ShowS
$cshowsPrec :: Int -> Architecture -> ShowS
Show, Architecture -> Architecture -> Bool
(Architecture -> Architecture -> Bool)
-> (Architecture -> Architecture -> Bool) -> Eq Architecture
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Architecture -> Architecture -> Bool
$c/= :: Architecture -> Architecture -> Bool
== :: Architecture -> Architecture -> Bool
$c== :: Architecture -> Architecture -> Bool
Eq)
architectureToDebianArchString :: Architecture -> String
architectureToDebianArchString :: Architecture -> String
architectureToDebianArchString Architecture
X86_64 = String
"amd64"
architectureToDebianArchString Architecture
X86_32 = String
"i386"
architectureToDebianArchString Architecture
ARMHF = String
"armhf"
architectureToDebianArchString Architecture
ARMEL = String
"armel"
architectureToDebianArchString Architecture
PPC = String
"powerpc"
architectureToDebianArchString Architecture
PPC64 = String
"ppc64el"
architectureToDebianArchString Architecture
SPARC = String
"sparc"
architectureToDebianArchString Architecture
SPARC64 = String
"sparc64"
architectureToDebianArchString Architecture
MIPS = String
"mips"
architectureToDebianArchString Architecture
MIPSEL = String
"mipsel"
architectureToDebianArchString Architecture
MIPS64EL = String
"mips64el"
architectureToDebianArchString Architecture
SH4 = String
"sh"
architectureToDebianArchString Architecture
IA64 = String
"ia64"
architectureToDebianArchString Architecture
S390 = String
"s390"
architectureToDebianArchString Architecture
S390X = String
"s390x"
architectureToDebianArchString Architecture
ALPHA = String
"alpha"
architectureToDebianArchString Architecture
HPPA = String
"hppa"
architectureToDebianArchString Architecture
M68K = String
"m68k"
architectureToDebianArchString Architecture
ARM64 = String
"arm64"
architectureToDebianArchString Architecture
X32 = String
"x32"
type UserName = String
newtype User = User UserName
deriving (User -> User -> Bool
(User -> User -> Bool) -> (User -> User -> Bool) -> Eq User
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: User -> User -> Bool
$c/= :: User -> User -> Bool
== :: User -> User -> Bool
$c== :: User -> User -> Bool
Eq, Eq User
Eq User
-> (User -> User -> Ordering)
-> (User -> User -> Bool)
-> (User -> User -> Bool)
-> (User -> User -> Bool)
-> (User -> User -> Bool)
-> (User -> User -> User)
-> (User -> User -> User)
-> Ord User
User -> User -> Bool
User -> User -> Ordering
User -> User -> User
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: User -> User -> User
$cmin :: User -> User -> User
max :: User -> User -> User
$cmax :: User -> User -> User
>= :: User -> User -> Bool
$c>= :: User -> User -> Bool
> :: User -> User -> Bool
$c> :: User -> User -> Bool
<= :: User -> User -> Bool
$c<= :: User -> User -> Bool
< :: User -> User -> Bool
$c< :: User -> User -> Bool
compare :: User -> User -> Ordering
$ccompare :: User -> User -> Ordering
$cp1Ord :: Eq User
Ord, Int -> User -> ShowS
[User] -> ShowS
User -> String
(Int -> User -> ShowS)
-> (User -> String) -> ([User] -> ShowS) -> Show User
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [User] -> ShowS
$cshowList :: [User] -> ShowS
show :: User -> String
$cshow :: User -> String
showsPrec :: Int -> User -> ShowS
$cshowsPrec :: Int -> User -> ShowS
Show)
instance ConfigurableValue User where
val :: User -> String
val (User String
n) = String
n
newtype Group = Group String
deriving (Group -> Group -> Bool
(Group -> Group -> Bool) -> (Group -> Group -> Bool) -> Eq Group
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Group -> Group -> Bool
$c/= :: Group -> Group -> Bool
== :: Group -> Group -> Bool
$c== :: Group -> Group -> Bool
Eq, Eq Group
Eq Group
-> (Group -> Group -> Ordering)
-> (Group -> Group -> Bool)
-> (Group -> Group -> Bool)
-> (Group -> Group -> Bool)
-> (Group -> Group -> Bool)
-> (Group -> Group -> Group)
-> (Group -> Group -> Group)
-> Ord Group
Group -> Group -> Bool
Group -> Group -> Ordering
Group -> Group -> Group
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Group -> Group -> Group
$cmin :: Group -> Group -> Group
max :: Group -> Group -> Group
$cmax :: Group -> Group -> Group
>= :: Group -> Group -> Bool
$c>= :: Group -> Group -> Bool
> :: Group -> Group -> Bool
$c> :: Group -> Group -> Bool
<= :: Group -> Group -> Bool
$c<= :: Group -> Group -> Bool
< :: Group -> Group -> Bool
$c< :: Group -> Group -> Bool
compare :: Group -> Group -> Ordering
$ccompare :: Group -> Group -> Ordering
$cp1Ord :: Eq Group
Ord, Int -> Group -> ShowS
[Group] -> ShowS
Group -> String
(Int -> Group -> ShowS)
-> (Group -> String) -> ([Group] -> ShowS) -> Show Group
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Group] -> ShowS
$cshowList :: [Group] -> ShowS
show :: Group -> String
$cshow :: Group -> String
showsPrec :: Int -> Group -> ShowS
$cshowsPrec :: Int -> Group -> ShowS
Show)
instance ConfigurableValue Group where
val :: Group -> String
val (Group String
n) = String
n
userGroup :: User -> Group
userGroup :: User -> Group
userGroup (User String
u) = String -> Group
Group String
u
newtype Port = Port Int
deriving (Port -> Port -> Bool
(Port -> Port -> Bool) -> (Port -> Port -> Bool) -> Eq Port
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Port -> Port -> Bool
$c/= :: Port -> Port -> Bool
== :: Port -> Port -> Bool
$c== :: Port -> Port -> Bool
Eq, Eq Port
Eq Port
-> (Port -> Port -> Ordering)
-> (Port -> Port -> Bool)
-> (Port -> Port -> Bool)
-> (Port -> Port -> Bool)
-> (Port -> Port -> Bool)
-> (Port -> Port -> Port)
-> (Port -> Port -> Port)
-> Ord Port
Port -> Port -> Bool
Port -> Port -> Ordering
Port -> Port -> Port
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Port -> Port -> Port
$cmin :: Port -> Port -> Port
max :: Port -> Port -> Port
$cmax :: Port -> Port -> Port
>= :: Port -> Port -> Bool
$c>= :: Port -> Port -> Bool
> :: Port -> Port -> Bool
$c> :: Port -> Port -> Bool
<= :: Port -> Port -> Bool
$c<= :: Port -> Port -> Bool
< :: Port -> Port -> Bool
$c< :: Port -> Port -> Bool
compare :: Port -> Port -> Ordering
$ccompare :: Port -> Port -> Ordering
$cp1Ord :: Eq Port
Ord, Int -> Port -> ShowS
[Port] -> ShowS
Port -> String
(Int -> Port -> ShowS)
-> (Port -> String) -> ([Port] -> ShowS) -> Show Port
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Port] -> ShowS
$cshowList :: [Port] -> ShowS
show :: Port -> String
$cshow :: Port -> String
showsPrec :: Int -> Port -> ShowS
$cshowsPrec :: Int -> Port -> ShowS
Show)
instance ConfigurableValue Port where
val :: Port -> String
val (Port Int
p) = Int -> String
forall a. Show a => a -> String
show Int
p