-- |Generated from ./Network/ONCRPC/Prot.x by <https://github.com/dylex/oncrpc hsrpcgen>
{-# LANGUAGE DataKinds, TypeFamilies #-}
module Network.ONCRPC.Prot where
import qualified Prelude
import qualified Control.Applicative
import qualified Network.ONCRPC.XDR as XDR

rPC_VERS :: Prelude.Integral a => a
rPC_VERS :: forall a. Integral a => a
rPC_VERS = a
2

data Auth_flavor = AUTH_NONE
                 | AUTH_SYS
                 | AUTH_SHORT
                 | AUTH_DH
                 | AUTH_KERB
                 | AUTH_RSA
                 | RPCSEC_GSS
                   deriving (Auth_flavor -> Auth_flavor -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Auth_flavor -> Auth_flavor -> Bool
$c/= :: Auth_flavor -> Auth_flavor -> Bool
== :: Auth_flavor -> Auth_flavor -> Bool
$c== :: Auth_flavor -> Auth_flavor -> Bool
Prelude.Eq, Eq Auth_flavor
Auth_flavor -> Auth_flavor -> Bool
Auth_flavor -> Auth_flavor -> Ordering
Auth_flavor -> Auth_flavor -> Auth_flavor
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 :: Auth_flavor -> Auth_flavor -> Auth_flavor
$cmin :: Auth_flavor -> Auth_flavor -> Auth_flavor
max :: Auth_flavor -> Auth_flavor -> Auth_flavor
$cmax :: Auth_flavor -> Auth_flavor -> Auth_flavor
>= :: Auth_flavor -> Auth_flavor -> Bool
$c>= :: Auth_flavor -> Auth_flavor -> Bool
> :: Auth_flavor -> Auth_flavor -> Bool
$c> :: Auth_flavor -> Auth_flavor -> Bool
<= :: Auth_flavor -> Auth_flavor -> Bool
$c<= :: Auth_flavor -> Auth_flavor -> Bool
< :: Auth_flavor -> Auth_flavor -> Bool
$c< :: Auth_flavor -> Auth_flavor -> Bool
compare :: Auth_flavor -> Auth_flavor -> Ordering
$ccompare :: Auth_flavor -> Auth_flavor -> Ordering
Prelude.Ord, Int -> Auth_flavor
Auth_flavor -> Int
Auth_flavor -> [Auth_flavor]
Auth_flavor -> Auth_flavor
Auth_flavor -> Auth_flavor -> [Auth_flavor]
Auth_flavor -> Auth_flavor -> Auth_flavor -> [Auth_flavor]
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 :: Auth_flavor -> Auth_flavor -> Auth_flavor -> [Auth_flavor]
$cenumFromThenTo :: Auth_flavor -> Auth_flavor -> Auth_flavor -> [Auth_flavor]
enumFromTo :: Auth_flavor -> Auth_flavor -> [Auth_flavor]
$cenumFromTo :: Auth_flavor -> Auth_flavor -> [Auth_flavor]
enumFromThen :: Auth_flavor -> Auth_flavor -> [Auth_flavor]
$cenumFromThen :: Auth_flavor -> Auth_flavor -> [Auth_flavor]
enumFrom :: Auth_flavor -> [Auth_flavor]
$cenumFrom :: Auth_flavor -> [Auth_flavor]
fromEnum :: Auth_flavor -> Int
$cfromEnum :: Auth_flavor -> Int
toEnum :: Int -> Auth_flavor
$ctoEnum :: Int -> Auth_flavor
pred :: Auth_flavor -> Auth_flavor
$cpred :: Auth_flavor -> Auth_flavor
succ :: Auth_flavor -> Auth_flavor
$csucc :: Auth_flavor -> Auth_flavor
Prelude.Enum, Auth_flavor
forall a. a -> a -> Bounded a
maxBound :: Auth_flavor
$cmaxBound :: Auth_flavor
minBound :: Auth_flavor
$cminBound :: Auth_flavor
Prelude.Bounded,
                             Int -> Auth_flavor -> ShowS
[Auth_flavor] -> ShowS
Auth_flavor -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Auth_flavor] -> ShowS
$cshowList :: [Auth_flavor] -> ShowS
show :: Auth_flavor -> String
$cshow :: Auth_flavor -> String
showsPrec :: Int -> Auth_flavor -> ShowS
$cshowsPrec :: Int -> Auth_flavor -> ShowS
Prelude.Show)

instance XDR.XDR Auth_flavor where
  xdrType :: Auth_flavor -> String
xdrType Auth_flavor
_ = String
"Auth_flavor"
  xdrPut :: Auth_flavor -> Put
xdrPut = forall a. XDREnum a => a -> Put
XDR.xdrPutEnum
  xdrGet :: Get Auth_flavor
xdrGet = forall a. XDREnum a => Get a
XDR.xdrGetEnum

instance XDR.XDREnum Auth_flavor where
  xdrFromEnum :: Auth_flavor -> Int
xdrFromEnum Auth_flavor
AUTH_NONE = Int
0
  xdrFromEnum Auth_flavor
AUTH_SYS = Int
1
  xdrFromEnum Auth_flavor
AUTH_SHORT = Int
2
  xdrFromEnum Auth_flavor
AUTH_DH = Int
3
  xdrFromEnum Auth_flavor
AUTH_KERB = Int
4
  xdrFromEnum Auth_flavor
AUTH_RSA = Int
5
  xdrFromEnum Auth_flavor
RPCSEC_GSS = Int
6
  xdrToEnum :: forall (m :: * -> *). MonadFail m => Int -> m Auth_flavor
xdrToEnum Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return Auth_flavor
AUTH_NONE
  xdrToEnum Int
1 = forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return Auth_flavor
AUTH_SYS
  xdrToEnum Int
2 = forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return Auth_flavor
AUTH_SHORT
  xdrToEnum Int
3 = forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return Auth_flavor
AUTH_DH
  xdrToEnum Int
4 = forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return Auth_flavor
AUTH_KERB
  xdrToEnum Int
5 = forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return Auth_flavor
AUTH_RSA
  xdrToEnum Int
6 = forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return Auth_flavor
RPCSEC_GSS
  xdrToEnum Int
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"invalid Auth_flavor"

type Opaque_auth_body = XDR.Opaque 400

data Opaque_auth = Opaque_auth{Opaque_auth -> Int
opaque_auth'flavor :: !XDR.Int,
                               Opaque_auth -> Opaque_auth_body
opaque_auth'body :: !Opaque_auth_body}
                   deriving (Opaque_auth -> Opaque_auth -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Opaque_auth -> Opaque_auth -> Bool
$c/= :: Opaque_auth -> Opaque_auth -> Bool
== :: Opaque_auth -> Opaque_auth -> Bool
$c== :: Opaque_auth -> Opaque_auth -> Bool
Prelude.Eq, Int -> Opaque_auth -> ShowS
[Opaque_auth] -> ShowS
Opaque_auth -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Opaque_auth] -> ShowS
$cshowList :: [Opaque_auth] -> ShowS
show :: Opaque_auth -> String
$cshow :: Opaque_auth -> String
showsPrec :: Int -> Opaque_auth -> ShowS
$cshowsPrec :: Int -> Opaque_auth -> ShowS
Prelude.Show)

instance XDR.XDR Opaque_auth where
  xdrType :: Opaque_auth -> String
xdrType Opaque_auth
_ = String
"Opaque_auth"
  xdrPut :: Opaque_auth -> Put
xdrPut Opaque_auth
_x
    = forall a. XDR a => a -> Put
XDR.xdrPut (Opaque_auth -> Int
opaque_auth'flavor Opaque_auth
_x) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*>
        forall a. XDR a => a -> Put
XDR.xdrPut (Opaque_auth -> Opaque_auth_body
opaque_auth'body Opaque_auth
_x)
  xdrGet :: Get Opaque_auth
xdrGet
    = forall (f :: * -> *) a. Applicative f => a -> f a
Control.Applicative.pure Int -> Opaque_auth_body -> Opaque_auth
Opaque_auth forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Control.Applicative.<*>
        forall a. XDR a => Get a
XDR.xdrGet
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Control.Applicative.<*> forall a. XDR a => Get a
XDR.xdrGet

data Msg_type = CALL
              | REPLY
                deriving (Msg_type -> Msg_type -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Msg_type -> Msg_type -> Bool
$c/= :: Msg_type -> Msg_type -> Bool
== :: Msg_type -> Msg_type -> Bool
$c== :: Msg_type -> Msg_type -> Bool
Prelude.Eq, Eq Msg_type
Msg_type -> Msg_type -> Bool
Msg_type -> Msg_type -> Ordering
Msg_type -> Msg_type -> Msg_type
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 :: Msg_type -> Msg_type -> Msg_type
$cmin :: Msg_type -> Msg_type -> Msg_type
max :: Msg_type -> Msg_type -> Msg_type
$cmax :: Msg_type -> Msg_type -> Msg_type
>= :: Msg_type -> Msg_type -> Bool
$c>= :: Msg_type -> Msg_type -> Bool
> :: Msg_type -> Msg_type -> Bool
$c> :: Msg_type -> Msg_type -> Bool
<= :: Msg_type -> Msg_type -> Bool
$c<= :: Msg_type -> Msg_type -> Bool
< :: Msg_type -> Msg_type -> Bool
$c< :: Msg_type -> Msg_type -> Bool
compare :: Msg_type -> Msg_type -> Ordering
$ccompare :: Msg_type -> Msg_type -> Ordering
Prelude.Ord, Int -> Msg_type
Msg_type -> Int
Msg_type -> [Msg_type]
Msg_type -> Msg_type
Msg_type -> Msg_type -> [Msg_type]
Msg_type -> Msg_type -> Msg_type -> [Msg_type]
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 :: Msg_type -> Msg_type -> Msg_type -> [Msg_type]
$cenumFromThenTo :: Msg_type -> Msg_type -> Msg_type -> [Msg_type]
enumFromTo :: Msg_type -> Msg_type -> [Msg_type]
$cenumFromTo :: Msg_type -> Msg_type -> [Msg_type]
enumFromThen :: Msg_type -> Msg_type -> [Msg_type]
$cenumFromThen :: Msg_type -> Msg_type -> [Msg_type]
enumFrom :: Msg_type -> [Msg_type]
$cenumFrom :: Msg_type -> [Msg_type]
fromEnum :: Msg_type -> Int
$cfromEnum :: Msg_type -> Int
toEnum :: Int -> Msg_type
$ctoEnum :: Int -> Msg_type
pred :: Msg_type -> Msg_type
$cpred :: Msg_type -> Msg_type
succ :: Msg_type -> Msg_type
$csucc :: Msg_type -> Msg_type
Prelude.Enum, Msg_type
forall a. a -> a -> Bounded a
maxBound :: Msg_type
$cmaxBound :: Msg_type
minBound :: Msg_type
$cminBound :: Msg_type
Prelude.Bounded,
                          Int -> Msg_type -> ShowS
[Msg_type] -> ShowS
Msg_type -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Msg_type] -> ShowS
$cshowList :: [Msg_type] -> ShowS
show :: Msg_type -> String
$cshow :: Msg_type -> String
showsPrec :: Int -> Msg_type -> ShowS
$cshowsPrec :: Int -> Msg_type -> ShowS
Prelude.Show)

instance XDR.XDR Msg_type where
  xdrType :: Msg_type -> String
xdrType Msg_type
_ = String
"Msg_type"
  xdrPut :: Msg_type -> Put
xdrPut = forall a. XDREnum a => a -> Put
XDR.xdrPutEnum
  xdrGet :: Get Msg_type
xdrGet = forall a. XDREnum a => Get a
XDR.xdrGetEnum

instance XDR.XDREnum Msg_type where
  xdrFromEnum :: Msg_type -> Int
xdrFromEnum Msg_type
CALL = Int
0
  xdrFromEnum Msg_type
REPLY = Int
1
  xdrToEnum :: forall (m :: * -> *). MonadFail m => Int -> m Msg_type
xdrToEnum Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return Msg_type
CALL
  xdrToEnum Int
1 = forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return Msg_type
REPLY
  xdrToEnum Int
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"invalid Msg_type"

data Reply_stat = MSG_ACCEPTED
                | MSG_DENIED
                  deriving (Reply_stat -> Reply_stat -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Reply_stat -> Reply_stat -> Bool
$c/= :: Reply_stat -> Reply_stat -> Bool
== :: Reply_stat -> Reply_stat -> Bool
$c== :: Reply_stat -> Reply_stat -> Bool
Prelude.Eq, Eq Reply_stat
Reply_stat -> Reply_stat -> Bool
Reply_stat -> Reply_stat -> Ordering
Reply_stat -> Reply_stat -> Reply_stat
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 :: Reply_stat -> Reply_stat -> Reply_stat
$cmin :: Reply_stat -> Reply_stat -> Reply_stat
max :: Reply_stat -> Reply_stat -> Reply_stat
$cmax :: Reply_stat -> Reply_stat -> Reply_stat
>= :: Reply_stat -> Reply_stat -> Bool
$c>= :: Reply_stat -> Reply_stat -> Bool
> :: Reply_stat -> Reply_stat -> Bool
$c> :: Reply_stat -> Reply_stat -> Bool
<= :: Reply_stat -> Reply_stat -> Bool
$c<= :: Reply_stat -> Reply_stat -> Bool
< :: Reply_stat -> Reply_stat -> Bool
$c< :: Reply_stat -> Reply_stat -> Bool
compare :: Reply_stat -> Reply_stat -> Ordering
$ccompare :: Reply_stat -> Reply_stat -> Ordering
Prelude.Ord, Int -> Reply_stat
Reply_stat -> Int
Reply_stat -> [Reply_stat]
Reply_stat -> Reply_stat
Reply_stat -> Reply_stat -> [Reply_stat]
Reply_stat -> Reply_stat -> Reply_stat -> [Reply_stat]
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 :: Reply_stat -> Reply_stat -> Reply_stat -> [Reply_stat]
$cenumFromThenTo :: Reply_stat -> Reply_stat -> Reply_stat -> [Reply_stat]
enumFromTo :: Reply_stat -> Reply_stat -> [Reply_stat]
$cenumFromTo :: Reply_stat -> Reply_stat -> [Reply_stat]
enumFromThen :: Reply_stat -> Reply_stat -> [Reply_stat]
$cenumFromThen :: Reply_stat -> Reply_stat -> [Reply_stat]
enumFrom :: Reply_stat -> [Reply_stat]
$cenumFrom :: Reply_stat -> [Reply_stat]
fromEnum :: Reply_stat -> Int
$cfromEnum :: Reply_stat -> Int
toEnum :: Int -> Reply_stat
$ctoEnum :: Int -> Reply_stat
pred :: Reply_stat -> Reply_stat
$cpred :: Reply_stat -> Reply_stat
succ :: Reply_stat -> Reply_stat
$csucc :: Reply_stat -> Reply_stat
Prelude.Enum, Reply_stat
forall a. a -> a -> Bounded a
maxBound :: Reply_stat
$cmaxBound :: Reply_stat
minBound :: Reply_stat
$cminBound :: Reply_stat
Prelude.Bounded,
                            Int -> Reply_stat -> ShowS
[Reply_stat] -> ShowS
Reply_stat -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Reply_stat] -> ShowS
$cshowList :: [Reply_stat] -> ShowS
show :: Reply_stat -> String
$cshow :: Reply_stat -> String
showsPrec :: Int -> Reply_stat -> ShowS
$cshowsPrec :: Int -> Reply_stat -> ShowS
Prelude.Show)

instance XDR.XDR Reply_stat where
  xdrType :: Reply_stat -> String
xdrType Reply_stat
_ = String
"Reply_stat"
  xdrPut :: Reply_stat -> Put
xdrPut = forall a. XDREnum a => a -> Put
XDR.xdrPutEnum
  xdrGet :: Get Reply_stat
xdrGet = forall a. XDREnum a => Get a
XDR.xdrGetEnum

instance XDR.XDREnum Reply_stat where
  xdrFromEnum :: Reply_stat -> Int
xdrFromEnum Reply_stat
MSG_ACCEPTED = Int
0
  xdrFromEnum Reply_stat
MSG_DENIED = Int
1
  xdrToEnum :: forall (m :: * -> *). MonadFail m => Int -> m Reply_stat
xdrToEnum Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return Reply_stat
MSG_ACCEPTED
  xdrToEnum Int
1 = forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return Reply_stat
MSG_DENIED
  xdrToEnum Int
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"invalid Reply_stat"

data Accept_stat = SUCCESS
                 | PROG_UNAVAIL
                 | PROG_MISMATCH
                 | PROC_UNAVAIL
                 | GARBAGE_ARGS
                 | SYSTEM_ERR
                   deriving (Accept_stat -> Accept_stat -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Accept_stat -> Accept_stat -> Bool
$c/= :: Accept_stat -> Accept_stat -> Bool
== :: Accept_stat -> Accept_stat -> Bool
$c== :: Accept_stat -> Accept_stat -> Bool
Prelude.Eq, Eq Accept_stat
Accept_stat -> Accept_stat -> Bool
Accept_stat -> Accept_stat -> Ordering
Accept_stat -> Accept_stat -> Accept_stat
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 :: Accept_stat -> Accept_stat -> Accept_stat
$cmin :: Accept_stat -> Accept_stat -> Accept_stat
max :: Accept_stat -> Accept_stat -> Accept_stat
$cmax :: Accept_stat -> Accept_stat -> Accept_stat
>= :: Accept_stat -> Accept_stat -> Bool
$c>= :: Accept_stat -> Accept_stat -> Bool
> :: Accept_stat -> Accept_stat -> Bool
$c> :: Accept_stat -> Accept_stat -> Bool
<= :: Accept_stat -> Accept_stat -> Bool
$c<= :: Accept_stat -> Accept_stat -> Bool
< :: Accept_stat -> Accept_stat -> Bool
$c< :: Accept_stat -> Accept_stat -> Bool
compare :: Accept_stat -> Accept_stat -> Ordering
$ccompare :: Accept_stat -> Accept_stat -> Ordering
Prelude.Ord, Int -> Accept_stat
Accept_stat -> Int
Accept_stat -> [Accept_stat]
Accept_stat -> Accept_stat
Accept_stat -> Accept_stat -> [Accept_stat]
Accept_stat -> Accept_stat -> Accept_stat -> [Accept_stat]
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 :: Accept_stat -> Accept_stat -> Accept_stat -> [Accept_stat]
$cenumFromThenTo :: Accept_stat -> Accept_stat -> Accept_stat -> [Accept_stat]
enumFromTo :: Accept_stat -> Accept_stat -> [Accept_stat]
$cenumFromTo :: Accept_stat -> Accept_stat -> [Accept_stat]
enumFromThen :: Accept_stat -> Accept_stat -> [Accept_stat]
$cenumFromThen :: Accept_stat -> Accept_stat -> [Accept_stat]
enumFrom :: Accept_stat -> [Accept_stat]
$cenumFrom :: Accept_stat -> [Accept_stat]
fromEnum :: Accept_stat -> Int
$cfromEnum :: Accept_stat -> Int
toEnum :: Int -> Accept_stat
$ctoEnum :: Int -> Accept_stat
pred :: Accept_stat -> Accept_stat
$cpred :: Accept_stat -> Accept_stat
succ :: Accept_stat -> Accept_stat
$csucc :: Accept_stat -> Accept_stat
Prelude.Enum, Accept_stat
forall a. a -> a -> Bounded a
maxBound :: Accept_stat
$cmaxBound :: Accept_stat
minBound :: Accept_stat
$cminBound :: Accept_stat
Prelude.Bounded,
                             Int -> Accept_stat -> ShowS
[Accept_stat] -> ShowS
Accept_stat -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Accept_stat] -> ShowS
$cshowList :: [Accept_stat] -> ShowS
show :: Accept_stat -> String
$cshow :: Accept_stat -> String
showsPrec :: Int -> Accept_stat -> ShowS
$cshowsPrec :: Int -> Accept_stat -> ShowS
Prelude.Show)

instance XDR.XDR Accept_stat where
  xdrType :: Accept_stat -> String
xdrType Accept_stat
_ = String
"Accept_stat"
  xdrPut :: Accept_stat -> Put
xdrPut = forall a. XDREnum a => a -> Put
XDR.xdrPutEnum
  xdrGet :: Get Accept_stat
xdrGet = forall a. XDREnum a => Get a
XDR.xdrGetEnum

instance XDR.XDREnum Accept_stat where
  xdrFromEnum :: Accept_stat -> Int
xdrFromEnum Accept_stat
SUCCESS = Int
0
  xdrFromEnum Accept_stat
PROG_UNAVAIL = Int
1
  xdrFromEnum Accept_stat
PROG_MISMATCH = Int
2
  xdrFromEnum Accept_stat
PROC_UNAVAIL = Int
3
  xdrFromEnum Accept_stat
GARBAGE_ARGS = Int
4
  xdrFromEnum Accept_stat
SYSTEM_ERR = Int
5
  xdrToEnum :: forall (m :: * -> *). MonadFail m => Int -> m Accept_stat
xdrToEnum Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return Accept_stat
SUCCESS
  xdrToEnum Int
1 = forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return Accept_stat
PROG_UNAVAIL
  xdrToEnum Int
2 = forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return Accept_stat
PROG_MISMATCH
  xdrToEnum Int
3 = forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return Accept_stat
PROC_UNAVAIL
  xdrToEnum Int
4 = forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return Accept_stat
GARBAGE_ARGS
  xdrToEnum Int
5 = forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return Accept_stat
SYSTEM_ERR
  xdrToEnum Int
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"invalid Accept_stat"

data Reject_stat = RPC_MISMATCH
                 | AUTH_ERROR
                   deriving (Reject_stat -> Reject_stat -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Reject_stat -> Reject_stat -> Bool
$c/= :: Reject_stat -> Reject_stat -> Bool
== :: Reject_stat -> Reject_stat -> Bool
$c== :: Reject_stat -> Reject_stat -> Bool
Prelude.Eq, Eq Reject_stat
Reject_stat -> Reject_stat -> Bool
Reject_stat -> Reject_stat -> Ordering
Reject_stat -> Reject_stat -> Reject_stat
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 :: Reject_stat -> Reject_stat -> Reject_stat
$cmin :: Reject_stat -> Reject_stat -> Reject_stat
max :: Reject_stat -> Reject_stat -> Reject_stat
$cmax :: Reject_stat -> Reject_stat -> Reject_stat
>= :: Reject_stat -> Reject_stat -> Bool
$c>= :: Reject_stat -> Reject_stat -> Bool
> :: Reject_stat -> Reject_stat -> Bool
$c> :: Reject_stat -> Reject_stat -> Bool
<= :: Reject_stat -> Reject_stat -> Bool
$c<= :: Reject_stat -> Reject_stat -> Bool
< :: Reject_stat -> Reject_stat -> Bool
$c< :: Reject_stat -> Reject_stat -> Bool
compare :: Reject_stat -> Reject_stat -> Ordering
$ccompare :: Reject_stat -> Reject_stat -> Ordering
Prelude.Ord, Int -> Reject_stat
Reject_stat -> Int
Reject_stat -> [Reject_stat]
Reject_stat -> Reject_stat
Reject_stat -> Reject_stat -> [Reject_stat]
Reject_stat -> Reject_stat -> Reject_stat -> [Reject_stat]
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 :: Reject_stat -> Reject_stat -> Reject_stat -> [Reject_stat]
$cenumFromThenTo :: Reject_stat -> Reject_stat -> Reject_stat -> [Reject_stat]
enumFromTo :: Reject_stat -> Reject_stat -> [Reject_stat]
$cenumFromTo :: Reject_stat -> Reject_stat -> [Reject_stat]
enumFromThen :: Reject_stat -> Reject_stat -> [Reject_stat]
$cenumFromThen :: Reject_stat -> Reject_stat -> [Reject_stat]
enumFrom :: Reject_stat -> [Reject_stat]
$cenumFrom :: Reject_stat -> [Reject_stat]
fromEnum :: Reject_stat -> Int
$cfromEnum :: Reject_stat -> Int
toEnum :: Int -> Reject_stat
$ctoEnum :: Int -> Reject_stat
pred :: Reject_stat -> Reject_stat
$cpred :: Reject_stat -> Reject_stat
succ :: Reject_stat -> Reject_stat
$csucc :: Reject_stat -> Reject_stat
Prelude.Enum, Reject_stat
forall a. a -> a -> Bounded a
maxBound :: Reject_stat
$cmaxBound :: Reject_stat
minBound :: Reject_stat
$cminBound :: Reject_stat
Prelude.Bounded,
                             Int -> Reject_stat -> ShowS
[Reject_stat] -> ShowS
Reject_stat -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Reject_stat] -> ShowS
$cshowList :: [Reject_stat] -> ShowS
show :: Reject_stat -> String
$cshow :: Reject_stat -> String
showsPrec :: Int -> Reject_stat -> ShowS
$cshowsPrec :: Int -> Reject_stat -> ShowS
Prelude.Show)

instance XDR.XDR Reject_stat where
  xdrType :: Reject_stat -> String
xdrType Reject_stat
_ = String
"Reject_stat"
  xdrPut :: Reject_stat -> Put
xdrPut = forall a. XDREnum a => a -> Put
XDR.xdrPutEnum
  xdrGet :: Get Reject_stat
xdrGet = forall a. XDREnum a => Get a
XDR.xdrGetEnum

instance XDR.XDREnum Reject_stat where
  xdrFromEnum :: Reject_stat -> Int
xdrFromEnum Reject_stat
RPC_MISMATCH = Int
0
  xdrFromEnum Reject_stat
AUTH_ERROR = Int
1
  xdrToEnum :: forall (m :: * -> *). MonadFail m => Int -> m Reject_stat
xdrToEnum Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return Reject_stat
RPC_MISMATCH
  xdrToEnum Int
1 = forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return Reject_stat
AUTH_ERROR
  xdrToEnum Int
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"invalid Reject_stat"

data Auth_stat = AUTH_OK
               | AUTH_BADCRED
               | AUTH_REJECTEDCRED
               | AUTH_BADVERF
               | AUTH_REJECTEDVERF
               | AUTH_TOOWEAK
               | AUTH_INVALIDRESP
               | AUTH_FAILED
               | AUTH_KERB_GENERIC
               | AUTH_TIMEEXPIRE
               | AUTH_TKT_FILE
               | AUTH_DECODE
               | AUTH_NET_ADDR
               | RPCSEC_GSS_CREDPROBLEM
               | RPCSEC_GSS_CTXPROBLEM
                 deriving (Auth_stat -> Auth_stat -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Auth_stat -> Auth_stat -> Bool
$c/= :: Auth_stat -> Auth_stat -> Bool
== :: Auth_stat -> Auth_stat -> Bool
$c== :: Auth_stat -> Auth_stat -> Bool
Prelude.Eq, Eq Auth_stat
Auth_stat -> Auth_stat -> Bool
Auth_stat -> Auth_stat -> Ordering
Auth_stat -> Auth_stat -> Auth_stat
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 :: Auth_stat -> Auth_stat -> Auth_stat
$cmin :: Auth_stat -> Auth_stat -> Auth_stat
max :: Auth_stat -> Auth_stat -> Auth_stat
$cmax :: Auth_stat -> Auth_stat -> Auth_stat
>= :: Auth_stat -> Auth_stat -> Bool
$c>= :: Auth_stat -> Auth_stat -> Bool
> :: Auth_stat -> Auth_stat -> Bool
$c> :: Auth_stat -> Auth_stat -> Bool
<= :: Auth_stat -> Auth_stat -> Bool
$c<= :: Auth_stat -> Auth_stat -> Bool
< :: Auth_stat -> Auth_stat -> Bool
$c< :: Auth_stat -> Auth_stat -> Bool
compare :: Auth_stat -> Auth_stat -> Ordering
$ccompare :: Auth_stat -> Auth_stat -> Ordering
Prelude.Ord, Int -> Auth_stat
Auth_stat -> Int
Auth_stat -> [Auth_stat]
Auth_stat -> Auth_stat
Auth_stat -> Auth_stat -> [Auth_stat]
Auth_stat -> Auth_stat -> Auth_stat -> [Auth_stat]
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 :: Auth_stat -> Auth_stat -> Auth_stat -> [Auth_stat]
$cenumFromThenTo :: Auth_stat -> Auth_stat -> Auth_stat -> [Auth_stat]
enumFromTo :: Auth_stat -> Auth_stat -> [Auth_stat]
$cenumFromTo :: Auth_stat -> Auth_stat -> [Auth_stat]
enumFromThen :: Auth_stat -> Auth_stat -> [Auth_stat]
$cenumFromThen :: Auth_stat -> Auth_stat -> [Auth_stat]
enumFrom :: Auth_stat -> [Auth_stat]
$cenumFrom :: Auth_stat -> [Auth_stat]
fromEnum :: Auth_stat -> Int
$cfromEnum :: Auth_stat -> Int
toEnum :: Int -> Auth_stat
$ctoEnum :: Int -> Auth_stat
pred :: Auth_stat -> Auth_stat
$cpred :: Auth_stat -> Auth_stat
succ :: Auth_stat -> Auth_stat
$csucc :: Auth_stat -> Auth_stat
Prelude.Enum, Auth_stat
forall a. a -> a -> Bounded a
maxBound :: Auth_stat
$cmaxBound :: Auth_stat
minBound :: Auth_stat
$cminBound :: Auth_stat
Prelude.Bounded,
                           Int -> Auth_stat -> ShowS
[Auth_stat] -> ShowS
Auth_stat -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Auth_stat] -> ShowS
$cshowList :: [Auth_stat] -> ShowS
show :: Auth_stat -> String
$cshow :: Auth_stat -> String
showsPrec :: Int -> Auth_stat -> ShowS
$cshowsPrec :: Int -> Auth_stat -> ShowS
Prelude.Show)

instance XDR.XDR Auth_stat where
  xdrType :: Auth_stat -> String
xdrType Auth_stat
_ = String
"Auth_stat"
  xdrPut :: Auth_stat -> Put
xdrPut = forall a. XDREnum a => a -> Put
XDR.xdrPutEnum
  xdrGet :: Get Auth_stat
xdrGet = forall a. XDREnum a => Get a
XDR.xdrGetEnum

instance XDR.XDREnum Auth_stat where
  xdrFromEnum :: Auth_stat -> Int
xdrFromEnum Auth_stat
AUTH_OK = Int
0
  xdrFromEnum Auth_stat
AUTH_BADCRED = Int
1
  xdrFromEnum Auth_stat
AUTH_REJECTEDCRED = Int
2
  xdrFromEnum Auth_stat
AUTH_BADVERF = Int
3
  xdrFromEnum Auth_stat
AUTH_REJECTEDVERF = Int
4
  xdrFromEnum Auth_stat
AUTH_TOOWEAK = Int
5
  xdrFromEnum Auth_stat
AUTH_INVALIDRESP = Int
6
  xdrFromEnum Auth_stat
AUTH_FAILED = Int
7
  xdrFromEnum Auth_stat
AUTH_KERB_GENERIC = Int
8
  xdrFromEnum Auth_stat
AUTH_TIMEEXPIRE = Int
9
  xdrFromEnum Auth_stat
AUTH_TKT_FILE = Int
10
  xdrFromEnum Auth_stat
AUTH_DECODE = Int
11
  xdrFromEnum Auth_stat
AUTH_NET_ADDR = Int
12
  xdrFromEnum Auth_stat
RPCSEC_GSS_CREDPROBLEM = Int
13
  xdrFromEnum Auth_stat
RPCSEC_GSS_CTXPROBLEM = Int
14
  xdrToEnum :: forall (m :: * -> *). MonadFail m => Int -> m Auth_stat
xdrToEnum Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return Auth_stat
AUTH_OK
  xdrToEnum Int
1 = forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return Auth_stat
AUTH_BADCRED
  xdrToEnum Int
2 = forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return Auth_stat
AUTH_REJECTEDCRED
  xdrToEnum Int
3 = forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return Auth_stat
AUTH_BADVERF
  xdrToEnum Int
4 = forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return Auth_stat
AUTH_REJECTEDVERF
  xdrToEnum Int
5 = forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return Auth_stat
AUTH_TOOWEAK
  xdrToEnum Int
6 = forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return Auth_stat
AUTH_INVALIDRESP
  xdrToEnum Int
7 = forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return Auth_stat
AUTH_FAILED
  xdrToEnum Int
8 = forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return Auth_stat
AUTH_KERB_GENERIC
  xdrToEnum Int
9 = forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return Auth_stat
AUTH_TIMEEXPIRE
  xdrToEnum Int
10 = forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return Auth_stat
AUTH_TKT_FILE
  xdrToEnum Int
11 = forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return Auth_stat
AUTH_DECODE
  xdrToEnum Int
12 = forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return Auth_stat
AUTH_NET_ADDR
  xdrToEnum Int
13 = forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return Auth_stat
RPCSEC_GSS_CREDPROBLEM
  xdrToEnum Int
14 = forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return Auth_stat
RPCSEC_GSS_CTXPROBLEM
  xdrToEnum Int
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"invalid Auth_stat"

data Rpc_msg = Rpc_msg{Rpc_msg -> UnsignedInt
rpc_msg'xid :: !XDR.UnsignedInt,
                       Rpc_msg -> Rpc_msg_body
rpc_msg'body :: !Rpc_msg_body}
               deriving (Rpc_msg -> Rpc_msg -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rpc_msg -> Rpc_msg -> Bool
$c/= :: Rpc_msg -> Rpc_msg -> Bool
== :: Rpc_msg -> Rpc_msg -> Bool
$c== :: Rpc_msg -> Rpc_msg -> Bool
Prelude.Eq, Int -> Rpc_msg -> ShowS
[Rpc_msg] -> ShowS
Rpc_msg -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rpc_msg] -> ShowS
$cshowList :: [Rpc_msg] -> ShowS
show :: Rpc_msg -> String
$cshow :: Rpc_msg -> String
showsPrec :: Int -> Rpc_msg -> ShowS
$cshowsPrec :: Int -> Rpc_msg -> ShowS
Prelude.Show)

instance XDR.XDR Rpc_msg where
  xdrType :: Rpc_msg -> String
xdrType Rpc_msg
_ = String
"Rpc_msg"
  xdrPut :: Rpc_msg -> Put
xdrPut Rpc_msg
_x
    = forall a. XDR a => a -> Put
XDR.xdrPut (Rpc_msg -> UnsignedInt
rpc_msg'xid Rpc_msg
_x) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*>
        forall a. XDR a => a -> Put
XDR.xdrPut (Rpc_msg -> Rpc_msg_body
rpc_msg'body Rpc_msg
_x)
  xdrGet :: Get Rpc_msg
xdrGet
    = forall (f :: * -> *) a. Applicative f => a -> f a
Control.Applicative.pure UnsignedInt -> Rpc_msg_body -> Rpc_msg
Rpc_msg forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Control.Applicative.<*>
        forall a. XDR a => Get a
XDR.xdrGet
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Control.Applicative.<*> forall a. XDR a => Get a
XDR.xdrGet

data Rpc_msg_body = Rpc_msg_body'CALL{Rpc_msg_body -> Call_body
rpc_msg_body'cbody ::
                                      !Call_body}
                  | Rpc_msg_body'REPLY{Rpc_msg_body -> Reply_body
rpc_msg_body'rbody :: !Reply_body}
                    deriving (Rpc_msg_body -> Rpc_msg_body -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rpc_msg_body -> Rpc_msg_body -> Bool
$c/= :: Rpc_msg_body -> Rpc_msg_body -> Bool
== :: Rpc_msg_body -> Rpc_msg_body -> Bool
$c== :: Rpc_msg_body -> Rpc_msg_body -> Bool
Prelude.Eq, Int -> Rpc_msg_body -> ShowS
[Rpc_msg_body] -> ShowS
Rpc_msg_body -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rpc_msg_body] -> ShowS
$cshowList :: [Rpc_msg_body] -> ShowS
show :: Rpc_msg_body -> String
$cshow :: Rpc_msg_body -> String
showsPrec :: Int -> Rpc_msg_body -> ShowS
$cshowsPrec :: Int -> Rpc_msg_body -> ShowS
Prelude.Show)

rpc_msg_body'mtype :: Rpc_msg_body -> Msg_type
rpc_msg_body'mtype :: Rpc_msg_body -> Msg_type
rpc_msg_body'mtype = forall a. XDRUnion a => a -> XDRDiscriminant a
XDR.xdrDiscriminant

instance XDR.XDR Rpc_msg_body where
  xdrType :: Rpc_msg_body -> String
xdrType Rpc_msg_body
_ = String
"Rpc_msg_body"
  xdrPut :: Rpc_msg_body -> Put
xdrPut = forall a. XDRUnion a => a -> Put
XDR.xdrPutUnion
  xdrGet :: Get Rpc_msg_body
xdrGet = forall a. XDRUnion a => Get a
XDR.xdrGetUnion

instance XDR.XDRUnion Rpc_msg_body where
  type XDRDiscriminant Rpc_msg_body = Msg_type
  xdrSplitUnion :: Rpc_msg_body -> (Int, Put)
xdrSplitUnion _x :: Rpc_msg_body
_x@Rpc_msg_body'CALL{}
    = (Int
0, forall a. XDR a => a -> Put
XDR.xdrPut (Rpc_msg_body -> Call_body
rpc_msg_body'cbody Rpc_msg_body
_x))
  xdrSplitUnion _x :: Rpc_msg_body
_x@Rpc_msg_body'REPLY{}
    = (Int
1, forall a. XDR a => a -> Put
XDR.xdrPut (Rpc_msg_body -> Reply_body
rpc_msg_body'rbody Rpc_msg_body
_x))
  xdrGetUnionArm :: Int -> Get Rpc_msg_body
xdrGetUnionArm Int
0
    = forall (f :: * -> *) a. Applicative f => a -> f a
Control.Applicative.pure Call_body -> Rpc_msg_body
Rpc_msg_body'CALL
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Control.Applicative.<*> forall a. XDR a => Get a
XDR.xdrGet
  xdrGetUnionArm Int
1
    = forall (f :: * -> *) a. Applicative f => a -> f a
Control.Applicative.pure Reply_body -> Rpc_msg_body
Rpc_msg_body'REPLY
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Control.Applicative.<*> forall a. XDR a => Get a
XDR.xdrGet
  xdrGetUnionArm Int
_c
    = forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"invalid Rpc_msg_body discriminant"

data Call_body = Call_body{Call_body -> UnsignedInt
call_body'rpcvers :: !XDR.UnsignedInt,
                           Call_body -> UnsignedInt
call_body'prog :: !XDR.UnsignedInt,
                           Call_body -> UnsignedInt
call_body'vers :: !XDR.UnsignedInt,
                           Call_body -> UnsignedInt
call_body'proc :: !XDR.UnsignedInt, Call_body -> Opaque_auth
call_body'cred :: !Opaque_auth,
                           Call_body -> Opaque_auth
call_body'verf :: !Opaque_auth}
                 deriving (Call_body -> Call_body -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Call_body -> Call_body -> Bool
$c/= :: Call_body -> Call_body -> Bool
== :: Call_body -> Call_body -> Bool
$c== :: Call_body -> Call_body -> Bool
Prelude.Eq, Int -> Call_body -> ShowS
[Call_body] -> ShowS
Call_body -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Call_body] -> ShowS
$cshowList :: [Call_body] -> ShowS
show :: Call_body -> String
$cshow :: Call_body -> String
showsPrec :: Int -> Call_body -> ShowS
$cshowsPrec :: Int -> Call_body -> ShowS
Prelude.Show)

instance XDR.XDR Call_body where
  xdrType :: Call_body -> String
xdrType Call_body
_ = String
"Call_body"
  xdrPut :: Call_body -> Put
xdrPut Call_body
_x
    = forall a. XDR a => a -> Put
XDR.xdrPut (Call_body -> UnsignedInt
call_body'rpcvers Call_body
_x) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*>
        forall a. XDR a => a -> Put
XDR.xdrPut (Call_body -> UnsignedInt
call_body'prog Call_body
_x)
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*> forall a. XDR a => a -> Put
XDR.xdrPut (Call_body -> UnsignedInt
call_body'vers Call_body
_x)
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*> forall a. XDR a => a -> Put
XDR.xdrPut (Call_body -> UnsignedInt
call_body'proc Call_body
_x)
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*> forall a. XDR a => a -> Put
XDR.xdrPut (Call_body -> Opaque_auth
call_body'cred Call_body
_x)
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*> forall a. XDR a => a -> Put
XDR.xdrPut (Call_body -> Opaque_auth
call_body'verf Call_body
_x)
  xdrGet :: Get Call_body
xdrGet
    = forall (f :: * -> *) a. Applicative f => a -> f a
Control.Applicative.pure UnsignedInt
-> UnsignedInt
-> UnsignedInt
-> UnsignedInt
-> Opaque_auth
-> Opaque_auth
-> Call_body
Call_body forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Control.Applicative.<*>
        forall a. XDR a => Get a
XDR.xdrGet
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Control.Applicative.<*> forall a. XDR a => Get a
XDR.xdrGet
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Control.Applicative.<*> forall a. XDR a => Get a
XDR.xdrGet
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Control.Applicative.<*> forall a. XDR a => Get a
XDR.xdrGet
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Control.Applicative.<*> forall a. XDR a => Get a
XDR.xdrGet
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Control.Applicative.<*> forall a. XDR a => Get a
XDR.xdrGet

data Reply_body = Reply_body'MSG_ACCEPTED{Reply_body -> Accepted_reply
reply_body'areply ::
                                          !Accepted_reply}
                | Reply_body'MSG_DENIED{Reply_body -> Rejected_reply
reply_body'rreply :: !Rejected_reply}
                  deriving (Reply_body -> Reply_body -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Reply_body -> Reply_body -> Bool
$c/= :: Reply_body -> Reply_body -> Bool
== :: Reply_body -> Reply_body -> Bool
$c== :: Reply_body -> Reply_body -> Bool
Prelude.Eq, Int -> Reply_body -> ShowS
[Reply_body] -> ShowS
Reply_body -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Reply_body] -> ShowS
$cshowList :: [Reply_body] -> ShowS
show :: Reply_body -> String
$cshow :: Reply_body -> String
showsPrec :: Int -> Reply_body -> ShowS
$cshowsPrec :: Int -> Reply_body -> ShowS
Prelude.Show)

reply_body'stat :: Reply_body -> Reply_stat
reply_body'stat :: Reply_body -> Reply_stat
reply_body'stat = forall a. XDRUnion a => a -> XDRDiscriminant a
XDR.xdrDiscriminant

instance XDR.XDR Reply_body where
  xdrType :: Reply_body -> String
xdrType Reply_body
_ = String
"Reply_body"
  xdrPut :: Reply_body -> Put
xdrPut = forall a. XDRUnion a => a -> Put
XDR.xdrPutUnion
  xdrGet :: Get Reply_body
xdrGet = forall a. XDRUnion a => Get a
XDR.xdrGetUnion

instance XDR.XDRUnion Reply_body where
  type XDRDiscriminant Reply_body = Reply_stat
  xdrSplitUnion :: Reply_body -> (Int, Put)
xdrSplitUnion _x :: Reply_body
_x@Reply_body'MSG_ACCEPTED{}
    = (Int
0, forall a. XDR a => a -> Put
XDR.xdrPut (Reply_body -> Accepted_reply
reply_body'areply Reply_body
_x))
  xdrSplitUnion _x :: Reply_body
_x@Reply_body'MSG_DENIED{}
    = (Int
1, forall a. XDR a => a -> Put
XDR.xdrPut (Reply_body -> Rejected_reply
reply_body'rreply Reply_body
_x))
  xdrGetUnionArm :: Int -> Get Reply_body
xdrGetUnionArm Int
0
    = forall (f :: * -> *) a. Applicative f => a -> f a
Control.Applicative.pure Accepted_reply -> Reply_body
Reply_body'MSG_ACCEPTED
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Control.Applicative.<*> forall a. XDR a => Get a
XDR.xdrGet
  xdrGetUnionArm Int
1
    = forall (f :: * -> *) a. Applicative f => a -> f a
Control.Applicative.pure Rejected_reply -> Reply_body
Reply_body'MSG_DENIED
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Control.Applicative.<*> forall a. XDR a => Get a
XDR.xdrGet
  xdrGetUnionArm Int
_c = forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"invalid Reply_body discriminant"

data Accepted_reply = Accepted_reply{Accepted_reply -> Opaque_auth
accepted_reply'verf ::
                                     !Opaque_auth,
                                     Accepted_reply -> Accepted_reply_data
accepted_reply'reply_data :: !Accepted_reply_data}
                      deriving (Accepted_reply -> Accepted_reply -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Accepted_reply -> Accepted_reply -> Bool
$c/= :: Accepted_reply -> Accepted_reply -> Bool
== :: Accepted_reply -> Accepted_reply -> Bool
$c== :: Accepted_reply -> Accepted_reply -> Bool
Prelude.Eq, Int -> Accepted_reply -> ShowS
[Accepted_reply] -> ShowS
Accepted_reply -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Accepted_reply] -> ShowS
$cshowList :: [Accepted_reply] -> ShowS
show :: Accepted_reply -> String
$cshow :: Accepted_reply -> String
showsPrec :: Int -> Accepted_reply -> ShowS
$cshowsPrec :: Int -> Accepted_reply -> ShowS
Prelude.Show)

instance XDR.XDR Accepted_reply where
  xdrType :: Accepted_reply -> String
xdrType Accepted_reply
_ = String
"Accepted_reply"
  xdrPut :: Accepted_reply -> Put
xdrPut Accepted_reply
_x
    = forall a. XDR a => a -> Put
XDR.xdrPut (Accepted_reply -> Opaque_auth
accepted_reply'verf Accepted_reply
_x) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*>
        forall a. XDR a => a -> Put
XDR.xdrPut (Accepted_reply -> Accepted_reply_data
accepted_reply'reply_data Accepted_reply
_x)
  xdrGet :: Get Accepted_reply
xdrGet
    = forall (f :: * -> *) a. Applicative f => a -> f a
Control.Applicative.pure Opaque_auth -> Accepted_reply_data -> Accepted_reply
Accepted_reply forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Control.Applicative.<*>
        forall a. XDR a => Get a
XDR.xdrGet
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Control.Applicative.<*> forall a. XDR a => Get a
XDR.xdrGet

data Accepted_reply_data = Accepted_reply_data'SUCCESS{}
                         | Accepted_reply_data'PROG_MISMATCH{Accepted_reply_data -> UnsignedInt
accepted_reply_data'mismatch_info'low
                                                             :: !XDR.UnsignedInt,
                                                             Accepted_reply_data -> UnsignedInt
accepted_reply_data'mismatch_info'high
                                                             :: !XDR.UnsignedInt}
                         | Accepted_reply_data'default{Accepted_reply_data -> Accept_stat
accepted_reply_data'stat' ::
                                                       !Accept_stat}
                           deriving (Accepted_reply_data -> Accepted_reply_data -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Accepted_reply_data -> Accepted_reply_data -> Bool
$c/= :: Accepted_reply_data -> Accepted_reply_data -> Bool
== :: Accepted_reply_data -> Accepted_reply_data -> Bool
$c== :: Accepted_reply_data -> Accepted_reply_data -> Bool
Prelude.Eq, Int -> Accepted_reply_data -> ShowS
[Accepted_reply_data] -> ShowS
Accepted_reply_data -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Accepted_reply_data] -> ShowS
$cshowList :: [Accepted_reply_data] -> ShowS
show :: Accepted_reply_data -> String
$cshow :: Accepted_reply_data -> String
showsPrec :: Int -> Accepted_reply_data -> ShowS
$cshowsPrec :: Int -> Accepted_reply_data -> ShowS
Prelude.Show)

accepted_reply_data'stat :: Accepted_reply_data -> Accept_stat
accepted_reply_data'stat :: Accepted_reply_data -> Accept_stat
accepted_reply_data'stat = forall a. XDRUnion a => a -> XDRDiscriminant a
XDR.xdrDiscriminant

instance XDR.XDR Accepted_reply_data where
  xdrType :: Accepted_reply_data -> String
xdrType Accepted_reply_data
_ = String
"Accepted_reply_data"
  xdrPut :: Accepted_reply_data -> Put
xdrPut = forall a. XDRUnion a => a -> Put
XDR.xdrPutUnion
  xdrGet :: Get Accepted_reply_data
xdrGet = forall a. XDRUnion a => Get a
XDR.xdrGetUnion

instance XDR.XDRUnion Accepted_reply_data where
  type XDRDiscriminant Accepted_reply_data = Accept_stat
  xdrSplitUnion :: Accepted_reply_data -> (Int, Put)
xdrSplitUnion _x :: Accepted_reply_data
_x@Accepted_reply_data'SUCCESS{}
    = (Int
0, forall (f :: * -> *) a. Applicative f => a -> f a
Control.Applicative.pure ())
  xdrSplitUnion _x :: Accepted_reply_data
_x@Accepted_reply_data'PROG_MISMATCH{}
    = (Int
2,
       forall a. XDR a => a -> Put
XDR.xdrPut (Accepted_reply_data -> UnsignedInt
accepted_reply_data'mismatch_info'low Accepted_reply_data
_x)
         forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*>
         forall a. XDR a => a -> Put
XDR.xdrPut (Accepted_reply_data -> UnsignedInt
accepted_reply_data'mismatch_info'high Accepted_reply_data
_x))
  xdrSplitUnion
    _x :: Accepted_reply_data
_x@Accepted_reply_data'default{accepted_reply_data'stat' :: Accepted_reply_data -> Accept_stat
accepted_reply_data'stat' = Accept_stat
d}
    = (forall a. XDREnum a => a -> Int
XDR.xdrFromEnum Accept_stat
d, forall (f :: * -> *) a. Applicative f => a -> f a
Control.Applicative.pure ())
  xdrGetUnionArm :: Int -> Get Accepted_reply_data
xdrGetUnionArm Int
0
    = forall (f :: * -> *) a. Applicative f => a -> f a
Control.Applicative.pure Accepted_reply_data
Accepted_reply_data'SUCCESS
  xdrGetUnionArm Int
2
    = forall (f :: * -> *) a. Applicative f => a -> f a
Control.Applicative.pure UnsignedInt -> UnsignedInt -> Accepted_reply_data
Accepted_reply_data'PROG_MISMATCH
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Control.Applicative.<*> forall a. XDR a => Get a
XDR.xdrGet
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Control.Applicative.<*> forall a. XDR a => Get a
XDR.xdrGet
  xdrGetUnionArm Int
_c
    = Accept_stat -> Accepted_reply_data
Accepted_reply_data'default forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Control.Applicative.<$>
        forall a (m :: * -> *). (XDREnum a, MonadFail m) => Int -> m a
XDR.xdrToEnum Int
_c

data Rejected_reply = Rejected_reply'RPC_MISMATCH{Rejected_reply -> UnsignedInt
rejected_reply'mismatch_info'low
                                                  :: !XDR.UnsignedInt,
                                                  Rejected_reply -> UnsignedInt
rejected_reply'mismatch_info'high ::
                                                  !XDR.UnsignedInt}
                    | Rejected_reply'AUTH_ERROR{Rejected_reply -> Auth_stat
rejected_reply'auth_stat :: !Auth_stat}
                      deriving (Rejected_reply -> Rejected_reply -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rejected_reply -> Rejected_reply -> Bool
$c/= :: Rejected_reply -> Rejected_reply -> Bool
== :: Rejected_reply -> Rejected_reply -> Bool
$c== :: Rejected_reply -> Rejected_reply -> Bool
Prelude.Eq, Int -> Rejected_reply -> ShowS
[Rejected_reply] -> ShowS
Rejected_reply -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rejected_reply] -> ShowS
$cshowList :: [Rejected_reply] -> ShowS
show :: Rejected_reply -> String
$cshow :: Rejected_reply -> String
showsPrec :: Int -> Rejected_reply -> ShowS
$cshowsPrec :: Int -> Rejected_reply -> ShowS
Prelude.Show)

rejected_reply'stat :: Rejected_reply -> Reject_stat
rejected_reply'stat :: Rejected_reply -> Reject_stat
rejected_reply'stat = forall a. XDRUnion a => a -> XDRDiscriminant a
XDR.xdrDiscriminant

instance XDR.XDR Rejected_reply where
  xdrType :: Rejected_reply -> String
xdrType Rejected_reply
_ = String
"Rejected_reply"
  xdrPut :: Rejected_reply -> Put
xdrPut = forall a. XDRUnion a => a -> Put
XDR.xdrPutUnion
  xdrGet :: Get Rejected_reply
xdrGet = forall a. XDRUnion a => Get a
XDR.xdrGetUnion

instance XDR.XDRUnion Rejected_reply where
  type XDRDiscriminant Rejected_reply = Reject_stat
  xdrSplitUnion :: Rejected_reply -> (Int, Put)
xdrSplitUnion _x :: Rejected_reply
_x@Rejected_reply'RPC_MISMATCH{}
    = (Int
0,
       forall a. XDR a => a -> Put
XDR.xdrPut (Rejected_reply -> UnsignedInt
rejected_reply'mismatch_info'low Rejected_reply
_x)
         forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*>
         forall a. XDR a => a -> Put
XDR.xdrPut (Rejected_reply -> UnsignedInt
rejected_reply'mismatch_info'high Rejected_reply
_x))
  xdrSplitUnion _x :: Rejected_reply
_x@Rejected_reply'AUTH_ERROR{}
    = (Int
1, forall a. XDR a => a -> Put
XDR.xdrPut (Rejected_reply -> Auth_stat
rejected_reply'auth_stat Rejected_reply
_x))
  xdrGetUnionArm :: Int -> Get Rejected_reply
xdrGetUnionArm Int
0
    = forall (f :: * -> *) a. Applicative f => a -> f a
Control.Applicative.pure UnsignedInt -> UnsignedInt -> Rejected_reply
Rejected_reply'RPC_MISMATCH
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Control.Applicative.<*> forall a. XDR a => Get a
XDR.xdrGet
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Control.Applicative.<*> forall a. XDR a => Get a
XDR.xdrGet
  xdrGetUnionArm Int
1
    = forall (f :: * -> *) a. Applicative f => a -> f a
Control.Applicative.pure Auth_stat -> Rejected_reply
Rejected_reply'AUTH_ERROR
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Control.Applicative.<*> forall a. XDR a => Get a
XDR.xdrGet
  xdrGetUnionArm Int
_c
    = forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"invalid Rejected_reply discriminant"

data Authsys_parms = Authsys_parms{Authsys_parms -> UnsignedInt
authsys_parms'stamp ::
                                   !XDR.UnsignedInt,
                                   Authsys_parms -> String 255
authsys_parms'machinename :: !(XDR.String 255),
                                   Authsys_parms -> UnsignedInt
authsys_parms'uid :: !XDR.UnsignedInt,
                                   Authsys_parms -> UnsignedInt
authsys_parms'gid :: !XDR.UnsignedInt,
                                   Authsys_parms -> Array 16 UnsignedInt
authsys_parms'gids :: !(XDR.Array 16 XDR.UnsignedInt)}
                     deriving (Authsys_parms -> Authsys_parms -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Authsys_parms -> Authsys_parms -> Bool
$c/= :: Authsys_parms -> Authsys_parms -> Bool
== :: Authsys_parms -> Authsys_parms -> Bool
$c== :: Authsys_parms -> Authsys_parms -> Bool
Prelude.Eq, Int -> Authsys_parms -> ShowS
[Authsys_parms] -> ShowS
Authsys_parms -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Authsys_parms] -> ShowS
$cshowList :: [Authsys_parms] -> ShowS
show :: Authsys_parms -> String
$cshow :: Authsys_parms -> String
showsPrec :: Int -> Authsys_parms -> ShowS
$cshowsPrec :: Int -> Authsys_parms -> ShowS
Prelude.Show)

instance XDR.XDR Authsys_parms where
  xdrType :: Authsys_parms -> String
xdrType Authsys_parms
_ = String
"Authsys_parms"
  xdrPut :: Authsys_parms -> Put
xdrPut Authsys_parms
_x
    = forall a. XDR a => a -> Put
XDR.xdrPut (Authsys_parms -> UnsignedInt
authsys_parms'stamp Authsys_parms
_x) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*>
        forall a. XDR a => a -> Put
XDR.xdrPut (Authsys_parms -> String 255
authsys_parms'machinename Authsys_parms
_x)
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*> forall a. XDR a => a -> Put
XDR.xdrPut (Authsys_parms -> UnsignedInt
authsys_parms'uid Authsys_parms
_x)
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*> forall a. XDR a => a -> Put
XDR.xdrPut (Authsys_parms -> UnsignedInt
authsys_parms'gid Authsys_parms
_x)
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*> forall a. XDR a => a -> Put
XDR.xdrPut (Authsys_parms -> Array 16 UnsignedInt
authsys_parms'gids Authsys_parms
_x)
  xdrGet :: Get Authsys_parms
xdrGet
    = forall (f :: * -> *) a. Applicative f => a -> f a
Control.Applicative.pure UnsignedInt
-> String 255
-> UnsignedInt
-> UnsignedInt
-> Array 16 UnsignedInt
-> Authsys_parms
Authsys_parms forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Control.Applicative.<*>
        forall a. XDR a => Get a
XDR.xdrGet
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Control.Applicative.<*> forall a. XDR a => Get a
XDR.xdrGet
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Control.Applicative.<*> forall a. XDR a => Get a
XDR.xdrGet
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Control.Applicative.<*> forall a. XDR a => Get a
XDR.xdrGet
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Control.Applicative.<*> forall a. XDR a => Get a
XDR.xdrGet