{-# 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

-- | High level description of a operating system.
data System = System Distribution Architecture
	deriving (Int -> System -> ShowS
[System] -> ShowS
System -> String
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
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 -- ^ A well-known Debian derivative founded by a space tourist. The actual name of this distribution is not used in Propellor per <http://joeyh.name/blog/entry/trademark_nonsense/>
	| ArchLinux
	| FreeBSD FreeBSDRelease
	deriving (Int -> Distribution -> ShowS
[Distribution] -> ShowS
Distribution -> String
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
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)

-- | Properties can target one or more OS's; the targets are part
-- of the type of the property, so need to be kept fairly simple.
data TargetOS
	= OSDebian
	| OSBuntish
	| OSArchLinux
	| OSFreeBSD
	deriving (Int -> TargetOS -> ShowS
[TargetOS] -> ShowS
TargetOS -> String
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
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
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
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

-- | Most of Debian ports are based on Linux. There also exist hurd-i386,
-- kfreebsd-i386, kfreebsd-amd64 ports
data DebianKernel = Linux | KFreeBSD | Hurd
	deriving (Int -> DebianKernel -> ShowS
[DebianKernel] -> ShowS
DebianKernel -> String
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
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)

-- | Debian has several rolling suites, and a number of stable releases,
-- such as Stable "buster".
data DebianSuite = Experimental | Unstable | Testing | Stable Release
	deriving (Int -> DebianSuite -> ShowS
[DebianSuite] -> ShowS
DebianSuite -> String
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
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)

-- | FreeBSD breaks their releases into "Production" and "Legacy".
data FreeBSDRelease = FBSDProduction FBSDVersion | FBSDLegacy FBSDVersion
	deriving (Int -> FreeBSDRelease -> ShowS
[FreeBSDRelease] -> ShowS
FreeBSDRelease -> String
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
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
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
_ = 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 = 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

-- | Many of these architecture names are based on the names used by
-- Debian, with a few exceptions for clarity.
data Architecture
	= X86_64 -- ^ 64 bit Intel, called "amd64" in Debian
	| X86_32 -- ^ 32 bit Intel, called "i386" in Debian
	| ARMHF
	| ARMEL
	| PPC
	| PPC64
	| SPARC
	| SPARC64
	| MIPS
	| MIPSEL
	| MIPS64EL
	| SH4
	| IA64 -- ^ Itanium
	| S390
	| S390X
	| ALPHA
	| HPPA
	| M68K
	| ARM64
	| X32 -- ^ New Linux ABI for 64 bit CPUs using 32-bit integers. Not widely used.
	deriving (Int -> Architecture -> ShowS
[Architecture] -> ShowS
Architecture -> String
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
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
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
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
Ord, Int -> User -> ShowS
[User] -> ShowS
User -> String
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
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
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
Ord, Int -> Group -> ShowS
[Group] -> ShowS
Group -> String
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

-- | Makes a Group with the same name as the User.
userGroup :: User -> Group
userGroup :: User -> Group
userGroup (User String
u) = String -> Group
Group String
u

newtype Port = Port Int
	deriving (Port -> Port -> Bool
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
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
Ord, Int -> Port -> ShowS
[Port] -> ShowS
Port -> String
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) = forall a. Show a => a -> String
show Int
p