module Propellor.Types.PrivData where

import Propellor.Types.OS
import Utility.PartialPrelude
import Utility.FileSystemEncoding

import Data.Maybe
import qualified Data.ByteString.Lazy as L

-- | Note that removing or changing constructors or changing types will
-- break the serialized privdata files, so don't do that!
-- It's fine to add new constructors.
data PrivDataField
	= DockerAuthentication
	| SshPubKey SshKeyType UserName -- ^ Not used anymore, but retained to avoid breaking serialization of old files
	| SshPrivKey SshKeyType UserName -- ^ For host key, use empty UserName
	| SshAuthorizedKeys UserName
	| Password UserName
	| CryptPassword UserName
	| PrivFile FilePath
	| GpgKey
	| DnsSec DnsSecKey
	deriving (ReadPrec [PrivDataField]
ReadPrec PrivDataField
Int -> ReadS PrivDataField
ReadS [PrivDataField]
(Int -> ReadS PrivDataField)
-> ReadS [PrivDataField]
-> ReadPrec PrivDataField
-> ReadPrec [PrivDataField]
-> Read PrivDataField
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PrivDataField]
$creadListPrec :: ReadPrec [PrivDataField]
readPrec :: ReadPrec PrivDataField
$creadPrec :: ReadPrec PrivDataField
readList :: ReadS [PrivDataField]
$creadList :: ReadS [PrivDataField]
readsPrec :: Int -> ReadS PrivDataField
$creadsPrec :: Int -> ReadS PrivDataField
Read, Int -> PrivDataField -> ShowS
[PrivDataField] -> ShowS
PrivDataField -> String
(Int -> PrivDataField -> ShowS)
-> (PrivDataField -> String)
-> ([PrivDataField] -> ShowS)
-> Show PrivDataField
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrivDataField] -> ShowS
$cshowList :: [PrivDataField] -> ShowS
show :: PrivDataField -> String
$cshow :: PrivDataField -> String
showsPrec :: Int -> PrivDataField -> ShowS
$cshowsPrec :: Int -> PrivDataField -> ShowS
Show, Eq PrivDataField
Eq PrivDataField
-> (PrivDataField -> PrivDataField -> Ordering)
-> (PrivDataField -> PrivDataField -> Bool)
-> (PrivDataField -> PrivDataField -> Bool)
-> (PrivDataField -> PrivDataField -> Bool)
-> (PrivDataField -> PrivDataField -> Bool)
-> (PrivDataField -> PrivDataField -> PrivDataField)
-> (PrivDataField -> PrivDataField -> PrivDataField)
-> Ord PrivDataField
PrivDataField -> PrivDataField -> Bool
PrivDataField -> PrivDataField -> Ordering
PrivDataField -> PrivDataField -> PrivDataField
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 :: PrivDataField -> PrivDataField -> PrivDataField
$cmin :: PrivDataField -> PrivDataField -> PrivDataField
max :: PrivDataField -> PrivDataField -> PrivDataField
$cmax :: PrivDataField -> PrivDataField -> PrivDataField
>= :: PrivDataField -> PrivDataField -> Bool
$c>= :: PrivDataField -> PrivDataField -> Bool
> :: PrivDataField -> PrivDataField -> Bool
$c> :: PrivDataField -> PrivDataField -> Bool
<= :: PrivDataField -> PrivDataField -> Bool
$c<= :: PrivDataField -> PrivDataField -> Bool
< :: PrivDataField -> PrivDataField -> Bool
$c< :: PrivDataField -> PrivDataField -> Bool
compare :: PrivDataField -> PrivDataField -> Ordering
$ccompare :: PrivDataField -> PrivDataField -> Ordering
$cp1Ord :: Eq PrivDataField
Ord, PrivDataField -> PrivDataField -> Bool
(PrivDataField -> PrivDataField -> Bool)
-> (PrivDataField -> PrivDataField -> Bool) -> Eq PrivDataField
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrivDataField -> PrivDataField -> Bool
$c/= :: PrivDataField -> PrivDataField -> Bool
== :: PrivDataField -> PrivDataField -> Bool
$c== :: PrivDataField -> PrivDataField -> Bool
Eq)

-- | Combines a PrivDataField with a description of how to generate
-- its value.
data PrivDataSource
	= PrivDataSourceFile PrivDataField FilePath
	| PrivDataSourceFileFromCommand PrivDataField FilePath String
	| PrivDataSource PrivDataField String

type PrivDataSourceDesc = String

class IsPrivDataSource s where
	privDataField :: s -> PrivDataField
	describePrivDataSource :: s -> Maybe PrivDataSourceDesc

instance IsPrivDataSource PrivDataField where
	privDataField :: PrivDataField -> PrivDataField
privDataField = PrivDataField -> PrivDataField
forall a. a -> a
id
	describePrivDataSource :: PrivDataField -> Maybe String
describePrivDataSource PrivDataField
_ = Maybe String
forall a. Maybe a
Nothing

instance IsPrivDataSource PrivDataSource where
	privDataField :: PrivDataSource -> PrivDataField
privDataField PrivDataSource
s = case PrivDataSource
s of
		PrivDataSourceFile PrivDataField
f String
_ -> PrivDataField
f
		PrivDataSourceFileFromCommand PrivDataField
f String
_ String
_ -> PrivDataField
f
		PrivDataSource PrivDataField
f String
_ -> PrivDataField
f
	describePrivDataSource :: PrivDataSource -> Maybe String
describePrivDataSource PrivDataSource
s = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ case PrivDataSource
s of
		PrivDataSourceFile PrivDataField
_ String
f -> String
"< " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
f
		PrivDataSourceFileFromCommand PrivDataField
_ String
f String
c ->
			String
"< " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (created by running, for example, `" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"` )"
		PrivDataSource PrivDataField
_ String
d -> String
"< (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
d String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

-- | A context in which a PrivDataField is used.
--
-- Often this will be a domain name. For example, 
-- Context "www.example.com" could be used for the SSL cert
-- for the web server serving that domain. Multiple hosts might
-- use that privdata.
--
-- This appears in serialized privdata files.
newtype Context = Context String
	deriving (ReadPrec [Context]
ReadPrec Context
Int -> ReadS Context
ReadS [Context]
(Int -> ReadS Context)
-> ReadS [Context]
-> ReadPrec Context
-> ReadPrec [Context]
-> Read Context
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Context]
$creadListPrec :: ReadPrec [Context]
readPrec :: ReadPrec Context
$creadPrec :: ReadPrec Context
readList :: ReadS [Context]
$creadList :: ReadS [Context]
readsPrec :: Int -> ReadS Context
$creadsPrec :: Int -> ReadS Context
Read, Int -> Context -> ShowS
[Context] -> ShowS
Context -> String
(Int -> Context -> ShowS)
-> (Context -> String) -> ([Context] -> ShowS) -> Show Context
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Context] -> ShowS
$cshowList :: [Context] -> ShowS
show :: Context -> String
$cshow :: Context -> String
showsPrec :: Int -> Context -> ShowS
$cshowsPrec :: Int -> Context -> ShowS
Show, Eq Context
Eq Context
-> (Context -> Context -> Ordering)
-> (Context -> Context -> Bool)
-> (Context -> Context -> Bool)
-> (Context -> Context -> Bool)
-> (Context -> Context -> Bool)
-> (Context -> Context -> Context)
-> (Context -> Context -> Context)
-> Ord Context
Context -> Context -> Bool
Context -> Context -> Ordering
Context -> Context -> Context
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 :: Context -> Context -> Context
$cmin :: Context -> Context -> Context
max :: Context -> Context -> Context
$cmax :: Context -> Context -> Context
>= :: Context -> Context -> Bool
$c>= :: Context -> Context -> Bool
> :: Context -> Context -> Bool
$c> :: Context -> Context -> Bool
<= :: Context -> Context -> Bool
$c<= :: Context -> Context -> Bool
< :: Context -> Context -> Bool
$c< :: Context -> Context -> Bool
compare :: Context -> Context -> Ordering
$ccompare :: Context -> Context -> Ordering
$cp1Ord :: Eq Context
Ord, Context -> Context -> Bool
(Context -> Context -> Bool)
-> (Context -> Context -> Bool) -> Eq Context
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Context -> Context -> Bool
$c/= :: Context -> Context -> Bool
== :: Context -> Context -> Bool
$c== :: Context -> Context -> Bool
Eq)

-- | A context that may vary depending on the HostName where it's used.
newtype HostContext = HostContext { HostContext -> String -> Context
mkHostContext :: HostName -> Context }

instance Show HostContext where
	show :: HostContext -> String
show HostContext
hc = Context -> String
forall a. Show a => a -> String
show (Context -> String) -> Context -> String
forall a b. (a -> b) -> a -> b
$ HostContext -> String -> Context
mkHostContext HostContext
hc String
"<hostname>"

instance Ord HostContext where
	HostContext
a <= :: HostContext -> HostContext -> Bool
<= HostContext
b = HostContext -> String
forall a. Show a => a -> String
show HostContext
a String -> String -> Bool
forall a. Ord a => a -> a -> Bool
<= HostContext -> String
forall a. Show a => a -> String
show HostContext
b

instance Eq HostContext where
	HostContext
a == :: HostContext -> HostContext -> Bool
== HostContext
b = HostContext -> String
forall a. Show a => a -> String
show HostContext
a String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== HostContext -> String
forall a. Show a => a -> String
show HostContext
b

-- | Class of things that can be used as a Context.
class IsContext c where
	asContext :: HostName -> c -> Context
	asHostContext :: c -> HostContext

instance IsContext HostContext where
	asContext :: String -> HostContext -> Context
asContext = (HostContext -> String -> Context)
-> String -> HostContext -> Context
forall a b c. (a -> b -> c) -> b -> a -> c
flip HostContext -> String -> Context
mkHostContext
	asHostContext :: HostContext -> HostContext
asHostContext = HostContext -> HostContext
forall a. a -> a
id

instance IsContext Context where
	asContext :: String -> Context -> Context
asContext String
_ Context
c = Context
c
	asHostContext :: Context -> HostContext
asHostContext = (String -> Context) -> HostContext
HostContext ((String -> Context) -> HostContext)
-> (Context -> String -> Context) -> Context -> HostContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> String -> Context
forall a b. a -> b -> a
const

-- | Use when a PrivDataField is not dependent on any paricular context.
anyContext :: Context
anyContext :: Context
anyContext = String -> Context
Context String
"any"

-- | Makes a HostContext that consists just of the hostname.
hostContext :: HostContext
hostContext :: HostContext
hostContext = (String -> Context) -> HostContext
HostContext String -> Context
Context

-- | Contains the actual private data.
--
-- Note that this may contain exta newlines at the end, or they may have
-- been stripped off, depending on how the user entered the privdata,
-- and which version of propellor stored it. Use the accessor functions
-- below to avoid newline problems.
newtype PrivData = PrivData String

-- | When PrivData is the content of a file, this is the lines thereof.
privDataLines :: PrivData -> [String]
privDataLines :: PrivData -> [String]
privDataLines (PrivData String
s) = String -> [String]
lines String
s

-- | When the PrivData is a single value, like a password, this extracts
-- it. Note that if multiple lines are present in the PrivData, only
-- the first is returned; there is never a newline in the String.
privDataVal :: PrivData -> String
privDataVal :: PrivData -> String
privDataVal (PrivData String
s) = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" ([String] -> Maybe String
forall a. [a] -> Maybe a
headMaybe (String -> [String]
lines String
s))

-- | Use to get ByteString out of PrivData.
privDataByteString :: PrivData -> L.ByteString
privDataByteString :: PrivData -> ByteString
privDataByteString (PrivData String
s) = String -> ByteString
encodeBS String
s

data SshKeyType = SshRsa | SshDsa | SshEcdsa | SshEd25519
	deriving (ReadPrec [SshKeyType]
ReadPrec SshKeyType
Int -> ReadS SshKeyType
ReadS [SshKeyType]
(Int -> ReadS SshKeyType)
-> ReadS [SshKeyType]
-> ReadPrec SshKeyType
-> ReadPrec [SshKeyType]
-> Read SshKeyType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SshKeyType]
$creadListPrec :: ReadPrec [SshKeyType]
readPrec :: ReadPrec SshKeyType
$creadPrec :: ReadPrec SshKeyType
readList :: ReadS [SshKeyType]
$creadList :: ReadS [SshKeyType]
readsPrec :: Int -> ReadS SshKeyType
$creadsPrec :: Int -> ReadS SshKeyType
Read, Int -> SshKeyType -> ShowS
[SshKeyType] -> ShowS
SshKeyType -> String
(Int -> SshKeyType -> ShowS)
-> (SshKeyType -> String)
-> ([SshKeyType] -> ShowS)
-> Show SshKeyType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SshKeyType] -> ShowS
$cshowList :: [SshKeyType] -> ShowS
show :: SshKeyType -> String
$cshow :: SshKeyType -> String
showsPrec :: Int -> SshKeyType -> ShowS
$cshowsPrec :: Int -> SshKeyType -> ShowS
Show, Eq SshKeyType
Eq SshKeyType
-> (SshKeyType -> SshKeyType -> Ordering)
-> (SshKeyType -> SshKeyType -> Bool)
-> (SshKeyType -> SshKeyType -> Bool)
-> (SshKeyType -> SshKeyType -> Bool)
-> (SshKeyType -> SshKeyType -> Bool)
-> (SshKeyType -> SshKeyType -> SshKeyType)
-> (SshKeyType -> SshKeyType -> SshKeyType)
-> Ord SshKeyType
SshKeyType -> SshKeyType -> Bool
SshKeyType -> SshKeyType -> Ordering
SshKeyType -> SshKeyType -> SshKeyType
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 :: SshKeyType -> SshKeyType -> SshKeyType
$cmin :: SshKeyType -> SshKeyType -> SshKeyType
max :: SshKeyType -> SshKeyType -> SshKeyType
$cmax :: SshKeyType -> SshKeyType -> SshKeyType
>= :: SshKeyType -> SshKeyType -> Bool
$c>= :: SshKeyType -> SshKeyType -> Bool
> :: SshKeyType -> SshKeyType -> Bool
$c> :: SshKeyType -> SshKeyType -> Bool
<= :: SshKeyType -> SshKeyType -> Bool
$c<= :: SshKeyType -> SshKeyType -> Bool
< :: SshKeyType -> SshKeyType -> Bool
$c< :: SshKeyType -> SshKeyType -> Bool
compare :: SshKeyType -> SshKeyType -> Ordering
$ccompare :: SshKeyType -> SshKeyType -> Ordering
$cp1Ord :: Eq SshKeyType
Ord, SshKeyType -> SshKeyType -> Bool
(SshKeyType -> SshKeyType -> Bool)
-> (SshKeyType -> SshKeyType -> Bool) -> Eq SshKeyType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SshKeyType -> SshKeyType -> Bool
$c/= :: SshKeyType -> SshKeyType -> Bool
== :: SshKeyType -> SshKeyType -> Bool
$c== :: SshKeyType -> SshKeyType -> Bool
Eq, Int -> SshKeyType
SshKeyType -> Int
SshKeyType -> [SshKeyType]
SshKeyType -> SshKeyType
SshKeyType -> SshKeyType -> [SshKeyType]
SshKeyType -> SshKeyType -> SshKeyType -> [SshKeyType]
(SshKeyType -> SshKeyType)
-> (SshKeyType -> SshKeyType)
-> (Int -> SshKeyType)
-> (SshKeyType -> Int)
-> (SshKeyType -> [SshKeyType])
-> (SshKeyType -> SshKeyType -> [SshKeyType])
-> (SshKeyType -> SshKeyType -> [SshKeyType])
-> (SshKeyType -> SshKeyType -> SshKeyType -> [SshKeyType])
-> Enum SshKeyType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SshKeyType -> SshKeyType -> SshKeyType -> [SshKeyType]
$cenumFromThenTo :: SshKeyType -> SshKeyType -> SshKeyType -> [SshKeyType]
enumFromTo :: SshKeyType -> SshKeyType -> [SshKeyType]
$cenumFromTo :: SshKeyType -> SshKeyType -> [SshKeyType]
enumFromThen :: SshKeyType -> SshKeyType -> [SshKeyType]
$cenumFromThen :: SshKeyType -> SshKeyType -> [SshKeyType]
enumFrom :: SshKeyType -> [SshKeyType]
$cenumFrom :: SshKeyType -> [SshKeyType]
fromEnum :: SshKeyType -> Int
$cfromEnum :: SshKeyType -> Int
toEnum :: Int -> SshKeyType
$ctoEnum :: Int -> SshKeyType
pred :: SshKeyType -> SshKeyType
$cpred :: SshKeyType -> SshKeyType
succ :: SshKeyType -> SshKeyType
$csucc :: SshKeyType -> SshKeyType
Enum, SshKeyType
SshKeyType -> SshKeyType -> Bounded SshKeyType
forall a. a -> a -> Bounded a
maxBound :: SshKeyType
$cmaxBound :: SshKeyType
minBound :: SshKeyType
$cminBound :: SshKeyType
Bounded)

-- | Parameter that would be passed to ssh-keygen to generate key of this type
sshKeyTypeParam :: SshKeyType -> String
sshKeyTypeParam :: SshKeyType -> String
sshKeyTypeParam SshKeyType
SshRsa = String
"RSA"
sshKeyTypeParam SshKeyType
SshDsa = String
"DSA"
sshKeyTypeParam SshKeyType
SshEcdsa = String
"ECDSA"
sshKeyTypeParam SshKeyType
SshEd25519 = String
"ED25519"

data DnsSecKey
	= PubZSK -- ^ DNSSEC Zone Signing Key (public)
	| PrivZSK -- ^ DNSSEC Zone Signing Key (private)
	| PubKSK -- ^ DNSSEC Key Signing Key (public)
	| PrivKSK -- ^ DNSSEC Key Signing Key (private)
	deriving (ReadPrec [DnsSecKey]
ReadPrec DnsSecKey
Int -> ReadS DnsSecKey
ReadS [DnsSecKey]
(Int -> ReadS DnsSecKey)
-> ReadS [DnsSecKey]
-> ReadPrec DnsSecKey
-> ReadPrec [DnsSecKey]
-> Read DnsSecKey
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DnsSecKey]
$creadListPrec :: ReadPrec [DnsSecKey]
readPrec :: ReadPrec DnsSecKey
$creadPrec :: ReadPrec DnsSecKey
readList :: ReadS [DnsSecKey]
$creadList :: ReadS [DnsSecKey]
readsPrec :: Int -> ReadS DnsSecKey
$creadsPrec :: Int -> ReadS DnsSecKey
Read, Int -> DnsSecKey -> ShowS
[DnsSecKey] -> ShowS
DnsSecKey -> String
(Int -> DnsSecKey -> ShowS)
-> (DnsSecKey -> String)
-> ([DnsSecKey] -> ShowS)
-> Show DnsSecKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DnsSecKey] -> ShowS
$cshowList :: [DnsSecKey] -> ShowS
show :: DnsSecKey -> String
$cshow :: DnsSecKey -> String
showsPrec :: Int -> DnsSecKey -> ShowS
$cshowsPrec :: Int -> DnsSecKey -> ShowS
Show, Eq DnsSecKey
Eq DnsSecKey
-> (DnsSecKey -> DnsSecKey -> Ordering)
-> (DnsSecKey -> DnsSecKey -> Bool)
-> (DnsSecKey -> DnsSecKey -> Bool)
-> (DnsSecKey -> DnsSecKey -> Bool)
-> (DnsSecKey -> DnsSecKey -> Bool)
-> (DnsSecKey -> DnsSecKey -> DnsSecKey)
-> (DnsSecKey -> DnsSecKey -> DnsSecKey)
-> Ord DnsSecKey
DnsSecKey -> DnsSecKey -> Bool
DnsSecKey -> DnsSecKey -> Ordering
DnsSecKey -> DnsSecKey -> DnsSecKey
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 :: DnsSecKey -> DnsSecKey -> DnsSecKey
$cmin :: DnsSecKey -> DnsSecKey -> DnsSecKey
max :: DnsSecKey -> DnsSecKey -> DnsSecKey
$cmax :: DnsSecKey -> DnsSecKey -> DnsSecKey
>= :: DnsSecKey -> DnsSecKey -> Bool
$c>= :: DnsSecKey -> DnsSecKey -> Bool
> :: DnsSecKey -> DnsSecKey -> Bool
$c> :: DnsSecKey -> DnsSecKey -> Bool
<= :: DnsSecKey -> DnsSecKey -> Bool
$c<= :: DnsSecKey -> DnsSecKey -> Bool
< :: DnsSecKey -> DnsSecKey -> Bool
$c< :: DnsSecKey -> DnsSecKey -> Bool
compare :: DnsSecKey -> DnsSecKey -> Ordering
$ccompare :: DnsSecKey -> DnsSecKey -> Ordering
$cp1Ord :: Eq DnsSecKey
Ord, DnsSecKey -> DnsSecKey -> Bool
(DnsSecKey -> DnsSecKey -> Bool)
-> (DnsSecKey -> DnsSecKey -> Bool) -> Eq DnsSecKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DnsSecKey -> DnsSecKey -> Bool
$c/= :: DnsSecKey -> DnsSecKey -> Bool
== :: DnsSecKey -> DnsSecKey -> Bool
$c== :: DnsSecKey -> DnsSecKey -> Bool
Eq, DnsSecKey
DnsSecKey -> DnsSecKey -> Bounded DnsSecKey
forall a. a -> a -> Bounded a
maxBound :: DnsSecKey
$cmaxBound :: DnsSecKey
minBound :: DnsSecKey
$cminBound :: DnsSecKey
Bounded, Int -> DnsSecKey
DnsSecKey -> Int
DnsSecKey -> [DnsSecKey]
DnsSecKey -> DnsSecKey
DnsSecKey -> DnsSecKey -> [DnsSecKey]
DnsSecKey -> DnsSecKey -> DnsSecKey -> [DnsSecKey]
(DnsSecKey -> DnsSecKey)
-> (DnsSecKey -> DnsSecKey)
-> (Int -> DnsSecKey)
-> (DnsSecKey -> Int)
-> (DnsSecKey -> [DnsSecKey])
-> (DnsSecKey -> DnsSecKey -> [DnsSecKey])
-> (DnsSecKey -> DnsSecKey -> [DnsSecKey])
-> (DnsSecKey -> DnsSecKey -> DnsSecKey -> [DnsSecKey])
-> Enum DnsSecKey
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: DnsSecKey -> DnsSecKey -> DnsSecKey -> [DnsSecKey]
$cenumFromThenTo :: DnsSecKey -> DnsSecKey -> DnsSecKey -> [DnsSecKey]
enumFromTo :: DnsSecKey -> DnsSecKey -> [DnsSecKey]
$cenumFromTo :: DnsSecKey -> DnsSecKey -> [DnsSecKey]
enumFromThen :: DnsSecKey -> DnsSecKey -> [DnsSecKey]
$cenumFromThen :: DnsSecKey -> DnsSecKey -> [DnsSecKey]
enumFrom :: DnsSecKey -> [DnsSecKey]
$cenumFrom :: DnsSecKey -> [DnsSecKey]
fromEnum :: DnsSecKey -> Int
$cfromEnum :: DnsSecKey -> Int
toEnum :: Int -> DnsSecKey
$ctoEnum :: Int -> DnsSecKey
pred :: DnsSecKey -> DnsSecKey
$cpred :: DnsSecKey -> DnsSecKey
succ :: DnsSecKey -> DnsSecKey
$csucc :: DnsSecKey -> DnsSecKey
Enum)