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

rPCB_PORT :: Prelude.Integral a => a
rPCB_PORT :: forall a. Integral a => a
rPCB_PORT = a
111

data Rpcb = Rpcb{Rpcb -> ProgNum
rpcb'r_prog :: !XDR.UnsignedInt,
                 Rpcb -> ProgNum
rpcb'r_vers :: !XDR.UnsignedInt,
                 Rpcb -> String 4294967295
rpcb'r_netid :: !(XDR.String 4294967295),
                 Rpcb -> String 4294967295
rpcb'r_addr :: !(XDR.String 4294967295),
                 Rpcb -> String 4294967295
rpcb'r_owner :: !(XDR.String 4294967295)}
            deriving (Rpcb -> Rpcb -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rpcb -> Rpcb -> Bool
$c/= :: Rpcb -> Rpcb -> Bool
== :: Rpcb -> Rpcb -> Bool
$c== :: Rpcb -> Rpcb -> Bool
Prelude.Eq, Int -> Rpcb -> ShowS
[Rpcb] -> ShowS
Rpcb -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rpcb] -> ShowS
$cshowList :: [Rpcb] -> ShowS
show :: Rpcb -> String
$cshow :: Rpcb -> String
showsPrec :: Int -> Rpcb -> ShowS
$cshowsPrec :: Int -> Rpcb -> ShowS
Prelude.Show)

instance XDR.XDR Rpcb where
  xdrType :: Rpcb -> String
xdrType Rpcb
_ = String
"Rpcb"
  xdrPut :: Rpcb -> Put
xdrPut Rpcb
_x
    = forall a. XDR a => a -> Put
XDR.xdrPut (Rpcb -> ProgNum
rpcb'r_prog Rpcb
_x) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*>
        forall a. XDR a => a -> Put
XDR.xdrPut (Rpcb -> ProgNum
rpcb'r_vers Rpcb
_x)
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*> forall a. XDR a => a -> Put
XDR.xdrPut (Rpcb -> String 4294967295
rpcb'r_netid Rpcb
_x)
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*> forall a. XDR a => a -> Put
XDR.xdrPut (Rpcb -> String 4294967295
rpcb'r_addr Rpcb
_x)
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*> forall a. XDR a => a -> Put
XDR.xdrPut (Rpcb -> String 4294967295
rpcb'r_owner Rpcb
_x)
  xdrGet :: Get Rpcb
xdrGet
    = forall (f :: * -> *) a. Applicative f => a -> f a
Control.Applicative.pure ProgNum
-> ProgNum
-> String 4294967295
-> String 4294967295
-> String 4294967295
-> Rpcb
Rpcb 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 Rp__list = Rp__list{Rp__list -> Rpcb
rp__list'rpcb_map :: !Rpcb,
                         Rp__list -> Optional Rp__list
rp__list'rpcb_next :: !(XDR.Optional Rp__list)}
                deriving (Rp__list -> Rp__list -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rp__list -> Rp__list -> Bool
$c/= :: Rp__list -> Rp__list -> Bool
== :: Rp__list -> Rp__list -> Bool
$c== :: Rp__list -> Rp__list -> Bool
Prelude.Eq, Int -> Rp__list -> ShowS
[Rp__list] -> ShowS
Rp__list -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rp__list] -> ShowS
$cshowList :: [Rp__list] -> ShowS
show :: Rp__list -> String
$cshow :: Rp__list -> String
showsPrec :: Int -> Rp__list -> ShowS
$cshowsPrec :: Int -> Rp__list -> ShowS
Prelude.Show)

instance XDR.XDR Rp__list where
  xdrType :: Rp__list -> String
xdrType Rp__list
_ = String
"Rp__list"
  xdrPut :: Rp__list -> Put
xdrPut Rp__list
_x
    = forall a. XDR a => a -> Put
XDR.xdrPut (Rp__list -> Rpcb
rp__list'rpcb_map Rp__list
_x) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*>
        forall a. XDR a => a -> Put
XDR.xdrPut (Rp__list -> Optional Rp__list
rp__list'rpcb_next Rp__list
_x)
  xdrGet :: Get Rp__list
xdrGet
    = forall (f :: * -> *) a. Applicative f => a -> f a
Control.Applicative.pure Rpcb -> Optional Rp__list -> Rp__list
Rp__list 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

type Rpcblist_ptr = XDR.Optional Rp__list

data Rpcb_rmtcallargs = Rpcb_rmtcallargs{Rpcb_rmtcallargs -> ProgNum
rpcb_rmtcallargs'prog ::
                                         !XDR.UnsignedInt,
                                         Rpcb_rmtcallargs -> ProgNum
rpcb_rmtcallargs'vers :: !XDR.UnsignedInt,
                                         Rpcb_rmtcallargs -> ProgNum
rpcb_rmtcallargs'proc :: !XDR.UnsignedInt,
                                         Rpcb_rmtcallargs -> Opaque 4294967295
rpcb_rmtcallargs'args :: !(XDR.Opaque 4294967295)}
                        deriving (Rpcb_rmtcallargs -> Rpcb_rmtcallargs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rpcb_rmtcallargs -> Rpcb_rmtcallargs -> Bool
$c/= :: Rpcb_rmtcallargs -> Rpcb_rmtcallargs -> Bool
== :: Rpcb_rmtcallargs -> Rpcb_rmtcallargs -> Bool
$c== :: Rpcb_rmtcallargs -> Rpcb_rmtcallargs -> Bool
Prelude.Eq, Int -> Rpcb_rmtcallargs -> ShowS
[Rpcb_rmtcallargs] -> ShowS
Rpcb_rmtcallargs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rpcb_rmtcallargs] -> ShowS
$cshowList :: [Rpcb_rmtcallargs] -> ShowS
show :: Rpcb_rmtcallargs -> String
$cshow :: Rpcb_rmtcallargs -> String
showsPrec :: Int -> Rpcb_rmtcallargs -> ShowS
$cshowsPrec :: Int -> Rpcb_rmtcallargs -> ShowS
Prelude.Show)

instance XDR.XDR Rpcb_rmtcallargs where
  xdrType :: Rpcb_rmtcallargs -> String
xdrType Rpcb_rmtcallargs
_ = String
"Rpcb_rmtcallargs"
  xdrPut :: Rpcb_rmtcallargs -> Put
xdrPut Rpcb_rmtcallargs
_x
    = forall a. XDR a => a -> Put
XDR.xdrPut (Rpcb_rmtcallargs -> ProgNum
rpcb_rmtcallargs'prog Rpcb_rmtcallargs
_x) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*>
        forall a. XDR a => a -> Put
XDR.xdrPut (Rpcb_rmtcallargs -> ProgNum
rpcb_rmtcallargs'vers Rpcb_rmtcallargs
_x)
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*> forall a. XDR a => a -> Put
XDR.xdrPut (Rpcb_rmtcallargs -> ProgNum
rpcb_rmtcallargs'proc Rpcb_rmtcallargs
_x)
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*> forall a. XDR a => a -> Put
XDR.xdrPut (Rpcb_rmtcallargs -> Opaque 4294967295
rpcb_rmtcallargs'args Rpcb_rmtcallargs
_x)
  xdrGet :: Get Rpcb_rmtcallargs
xdrGet
    = forall (f :: * -> *) a. Applicative f => a -> f a
Control.Applicative.pure ProgNum
-> ProgNum -> ProgNum -> Opaque 4294967295 -> Rpcb_rmtcallargs
Rpcb_rmtcallargs 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 Rpcb_rmtcallres = Rpcb_rmtcallres{Rpcb_rmtcallres -> String 4294967295
rpcb_rmtcallres'addr ::
                                       !(XDR.String 4294967295),
                                       Rpcb_rmtcallres -> Opaque 4294967295
rpcb_rmtcallres'results :: !(XDR.Opaque 4294967295)}
                       deriving (Rpcb_rmtcallres -> Rpcb_rmtcallres -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rpcb_rmtcallres -> Rpcb_rmtcallres -> Bool
$c/= :: Rpcb_rmtcallres -> Rpcb_rmtcallres -> Bool
== :: Rpcb_rmtcallres -> Rpcb_rmtcallres -> Bool
$c== :: Rpcb_rmtcallres -> Rpcb_rmtcallres -> Bool
Prelude.Eq, Int -> Rpcb_rmtcallres -> ShowS
[Rpcb_rmtcallres] -> ShowS
Rpcb_rmtcallres -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rpcb_rmtcallres] -> ShowS
$cshowList :: [Rpcb_rmtcallres] -> ShowS
show :: Rpcb_rmtcallres -> String
$cshow :: Rpcb_rmtcallres -> String
showsPrec :: Int -> Rpcb_rmtcallres -> ShowS
$cshowsPrec :: Int -> Rpcb_rmtcallres -> ShowS
Prelude.Show)

instance XDR.XDR Rpcb_rmtcallres where
  xdrType :: Rpcb_rmtcallres -> String
xdrType Rpcb_rmtcallres
_ = String
"Rpcb_rmtcallres"
  xdrPut :: Rpcb_rmtcallres -> Put
xdrPut Rpcb_rmtcallres
_x
    = forall a. XDR a => a -> Put
XDR.xdrPut (Rpcb_rmtcallres -> String 4294967295
rpcb_rmtcallres'addr Rpcb_rmtcallres
_x) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*>
        forall a. XDR a => a -> Put
XDR.xdrPut (Rpcb_rmtcallres -> Opaque 4294967295
rpcb_rmtcallres'results Rpcb_rmtcallres
_x)
  xdrGet :: Get Rpcb_rmtcallres
xdrGet
    = forall (f :: * -> *) a. Applicative f => a -> f a
Control.Applicative.pure String 4294967295 -> Opaque 4294967295 -> Rpcb_rmtcallres
Rpcb_rmtcallres 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 Rpcb_entry = Rpcb_entry{Rpcb_entry -> String 4294967295
rpcb_entry'r_maddr ::
                             !(XDR.String 4294967295),
                             Rpcb_entry -> String 4294967295
rpcb_entry'r_nc_netid :: !(XDR.String 4294967295),
                             Rpcb_entry -> ProgNum
rpcb_entry'r_nc_semantics :: !XDR.UnsignedInt,
                             Rpcb_entry -> String 4294967295
rpcb_entry'r_nc_protofmly :: !(XDR.String 4294967295),
                             Rpcb_entry -> String 4294967295
rpcb_entry'r_nc_proto :: !(XDR.String 4294967295)}
                  deriving (Rpcb_entry -> Rpcb_entry -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rpcb_entry -> Rpcb_entry -> Bool
$c/= :: Rpcb_entry -> Rpcb_entry -> Bool
== :: Rpcb_entry -> Rpcb_entry -> Bool
$c== :: Rpcb_entry -> Rpcb_entry -> Bool
Prelude.Eq, Int -> Rpcb_entry -> ShowS
[Rpcb_entry] -> ShowS
Rpcb_entry -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rpcb_entry] -> ShowS
$cshowList :: [Rpcb_entry] -> ShowS
show :: Rpcb_entry -> String
$cshow :: Rpcb_entry -> String
showsPrec :: Int -> Rpcb_entry -> ShowS
$cshowsPrec :: Int -> Rpcb_entry -> ShowS
Prelude.Show)

instance XDR.XDR Rpcb_entry where
  xdrType :: Rpcb_entry -> String
xdrType Rpcb_entry
_ = String
"Rpcb_entry"
  xdrPut :: Rpcb_entry -> Put
xdrPut Rpcb_entry
_x
    = forall a. XDR a => a -> Put
XDR.xdrPut (Rpcb_entry -> String 4294967295
rpcb_entry'r_maddr Rpcb_entry
_x) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*>
        forall a. XDR a => a -> Put
XDR.xdrPut (Rpcb_entry -> String 4294967295
rpcb_entry'r_nc_netid Rpcb_entry
_x)
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*> forall a. XDR a => a -> Put
XDR.xdrPut (Rpcb_entry -> ProgNum
rpcb_entry'r_nc_semantics Rpcb_entry
_x)
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*> forall a. XDR a => a -> Put
XDR.xdrPut (Rpcb_entry -> String 4294967295
rpcb_entry'r_nc_protofmly Rpcb_entry
_x)
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*> forall a. XDR a => a -> Put
XDR.xdrPut (Rpcb_entry -> String 4294967295
rpcb_entry'r_nc_proto Rpcb_entry
_x)
  xdrGet :: Get Rpcb_entry
xdrGet
    = forall (f :: * -> *) a. Applicative f => a -> f a
Control.Applicative.pure String 4294967295
-> String 4294967295
-> ProgNum
-> String 4294967295
-> String 4294967295
-> Rpcb_entry
Rpcb_entry 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 Rpcb_entry_list = Rpcb_entry_list{Rpcb_entry_list -> Rpcb_entry
rpcb_entry_list'rpcb_entry_map
                                       :: !Rpcb_entry,
                                       Rpcb_entry_list -> Optional Rpcb_entry_list
rpcb_entry_list'rpcb_entry_next ::
                                       !(XDR.Optional Rpcb_entry_list)}
                       deriving (Rpcb_entry_list -> Rpcb_entry_list -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rpcb_entry_list -> Rpcb_entry_list -> Bool
$c/= :: Rpcb_entry_list -> Rpcb_entry_list -> Bool
== :: Rpcb_entry_list -> Rpcb_entry_list -> Bool
$c== :: Rpcb_entry_list -> Rpcb_entry_list -> Bool
Prelude.Eq, Int -> Rpcb_entry_list -> ShowS
[Rpcb_entry_list] -> ShowS
Rpcb_entry_list -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rpcb_entry_list] -> ShowS
$cshowList :: [Rpcb_entry_list] -> ShowS
show :: Rpcb_entry_list -> String
$cshow :: Rpcb_entry_list -> String
showsPrec :: Int -> Rpcb_entry_list -> ShowS
$cshowsPrec :: Int -> Rpcb_entry_list -> ShowS
Prelude.Show)

instance XDR.XDR Rpcb_entry_list where
  xdrType :: Rpcb_entry_list -> String
xdrType Rpcb_entry_list
_ = String
"Rpcb_entry_list"
  xdrPut :: Rpcb_entry_list -> Put
xdrPut Rpcb_entry_list
_x
    = forall a. XDR a => a -> Put
XDR.xdrPut (Rpcb_entry_list -> Rpcb_entry
rpcb_entry_list'rpcb_entry_map Rpcb_entry_list
_x)
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*>
        forall a. XDR a => a -> Put
XDR.xdrPut (Rpcb_entry_list -> Optional Rpcb_entry_list
rpcb_entry_list'rpcb_entry_next Rpcb_entry_list
_x)
  xdrGet :: Get Rpcb_entry_list
xdrGet
    = forall (f :: * -> *) a. Applicative f => a -> f a
Control.Applicative.pure Rpcb_entry -> Optional Rpcb_entry_list -> Rpcb_entry_list
Rpcb_entry_list 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

type Rpcb_entry_list_ptr = XDR.Optional Rpcb_entry_list

rpcb_highproc_2 :: Prelude.Integral a => a
rpcb_highproc_2 :: forall a. Integral a => a
rpcb_highproc_2 = a
5

rpcb_highproc_3 :: Prelude.Integral a => a
rpcb_highproc_3 :: forall a. Integral a => a
rpcb_highproc_3 = a
8

rpcb_highproc_4 :: Prelude.Integral a => a
rpcb_highproc_4 :: forall a. Integral a => a
rpcb_highproc_4 = a
12

rPCBSTAT_HIGHPROC :: Prelude.Integral a => a
rPCBSTAT_HIGHPROC :: forall a. Integral a => a
rPCBSTAT_HIGHPROC = a
13

rPCBVERS_STAT :: Prelude.Integral a => a
rPCBVERS_STAT :: forall a. Integral a => a
rPCBVERS_STAT = a
3

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

rPCBVERS_3_STAT :: Prelude.Integral a => a
rPCBVERS_3_STAT :: forall a. Integral a => a
rPCBVERS_3_STAT = a
1

rPCBVERS_2_STAT :: Prelude.Integral a => a
rPCBVERS_2_STAT :: forall a. Integral a => a
rPCBVERS_2_STAT = a
0

data Rpcbs_addrlist = Rpcbs_addrlist{Rpcbs_addrlist -> ProgNum
rpcbs_addrlist'prog ::
                                     !XDR.UnsignedInt,
                                     Rpcbs_addrlist -> ProgNum
rpcbs_addrlist'vers :: !XDR.UnsignedInt,
                                     Rpcbs_addrlist -> Int
rpcbs_addrlist'success :: !XDR.Int,
                                     Rpcbs_addrlist -> Int
rpcbs_addrlist'failure :: !XDR.Int,
                                     Rpcbs_addrlist -> String 4294967295
rpcbs_addrlist'netid :: !(XDR.String 4294967295),
                                     Rpcbs_addrlist -> Optional Rpcbs_addrlist
rpcbs_addrlist'next :: !(XDR.Optional Rpcbs_addrlist)}
                      deriving (Rpcbs_addrlist -> Rpcbs_addrlist -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rpcbs_addrlist -> Rpcbs_addrlist -> Bool
$c/= :: Rpcbs_addrlist -> Rpcbs_addrlist -> Bool
== :: Rpcbs_addrlist -> Rpcbs_addrlist -> Bool
$c== :: Rpcbs_addrlist -> Rpcbs_addrlist -> Bool
Prelude.Eq, Int -> Rpcbs_addrlist -> ShowS
[Rpcbs_addrlist] -> ShowS
Rpcbs_addrlist -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rpcbs_addrlist] -> ShowS
$cshowList :: [Rpcbs_addrlist] -> ShowS
show :: Rpcbs_addrlist -> String
$cshow :: Rpcbs_addrlist -> String
showsPrec :: Int -> Rpcbs_addrlist -> ShowS
$cshowsPrec :: Int -> Rpcbs_addrlist -> ShowS
Prelude.Show)

instance XDR.XDR Rpcbs_addrlist where
  xdrType :: Rpcbs_addrlist -> String
xdrType Rpcbs_addrlist
_ = String
"Rpcbs_addrlist"
  xdrPut :: Rpcbs_addrlist -> Put
xdrPut Rpcbs_addrlist
_x
    = forall a. XDR a => a -> Put
XDR.xdrPut (Rpcbs_addrlist -> ProgNum
rpcbs_addrlist'prog Rpcbs_addrlist
_x) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*>
        forall a. XDR a => a -> Put
XDR.xdrPut (Rpcbs_addrlist -> ProgNum
rpcbs_addrlist'vers Rpcbs_addrlist
_x)
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*> forall a. XDR a => a -> Put
XDR.xdrPut (Rpcbs_addrlist -> Int
rpcbs_addrlist'success Rpcbs_addrlist
_x)
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*> forall a. XDR a => a -> Put
XDR.xdrPut (Rpcbs_addrlist -> Int
rpcbs_addrlist'failure Rpcbs_addrlist
_x)
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*> forall a. XDR a => a -> Put
XDR.xdrPut (Rpcbs_addrlist -> String 4294967295
rpcbs_addrlist'netid Rpcbs_addrlist
_x)
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*> forall a. XDR a => a -> Put
XDR.xdrPut (Rpcbs_addrlist -> Optional Rpcbs_addrlist
rpcbs_addrlist'next Rpcbs_addrlist
_x)
  xdrGet :: Get Rpcbs_addrlist
xdrGet
    = forall (f :: * -> *) a. Applicative f => a -> f a
Control.Applicative.pure ProgNum
-> ProgNum
-> Int
-> Int
-> String 4294967295
-> Optional Rpcbs_addrlist
-> Rpcbs_addrlist
Rpcbs_addrlist 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 Rpcbs_rmtcalllist = Rpcbs_rmtcalllist{Rpcbs_rmtcalllist -> ProgNum
rpcbs_rmtcalllist'prog
                                           :: !XDR.UnsignedInt,
                                           Rpcbs_rmtcalllist -> ProgNum
rpcbs_rmtcalllist'vers :: !XDR.UnsignedInt,
                                           Rpcbs_rmtcalllist -> ProgNum
rpcbs_rmtcalllist'proc :: !XDR.UnsignedInt,
                                           Rpcbs_rmtcalllist -> Int
rpcbs_rmtcalllist'success :: !XDR.Int,
                                           Rpcbs_rmtcalllist -> Int
rpcbs_rmtcalllist'failure :: !XDR.Int,
                                           Rpcbs_rmtcalllist -> Int
rpcbs_rmtcalllist'indirect :: !XDR.Int,
                                           Rpcbs_rmtcalllist -> String 4294967295
rpcbs_rmtcalllist'netid :: !(XDR.String 4294967295),
                                           Rpcbs_rmtcalllist -> Optional Rpcbs_rmtcalllist
rpcbs_rmtcalllist'next ::
                                           !(XDR.Optional Rpcbs_rmtcalllist)}
                         deriving (Rpcbs_rmtcalllist -> Rpcbs_rmtcalllist -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rpcbs_rmtcalllist -> Rpcbs_rmtcalllist -> Bool
$c/= :: Rpcbs_rmtcalllist -> Rpcbs_rmtcalllist -> Bool
== :: Rpcbs_rmtcalllist -> Rpcbs_rmtcalllist -> Bool
$c== :: Rpcbs_rmtcalllist -> Rpcbs_rmtcalllist -> Bool
Prelude.Eq, Int -> Rpcbs_rmtcalllist -> ShowS
[Rpcbs_rmtcalllist] -> ShowS
Rpcbs_rmtcalllist -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rpcbs_rmtcalllist] -> ShowS
$cshowList :: [Rpcbs_rmtcalllist] -> ShowS
show :: Rpcbs_rmtcalllist -> String
$cshow :: Rpcbs_rmtcalllist -> String
showsPrec :: Int -> Rpcbs_rmtcalllist -> ShowS
$cshowsPrec :: Int -> Rpcbs_rmtcalllist -> ShowS
Prelude.Show)

instance XDR.XDR Rpcbs_rmtcalllist where
  xdrType :: Rpcbs_rmtcalllist -> String
xdrType Rpcbs_rmtcalllist
_ = String
"Rpcbs_rmtcalllist"
  xdrPut :: Rpcbs_rmtcalllist -> Put
xdrPut Rpcbs_rmtcalllist
_x
    = forall a. XDR a => a -> Put
XDR.xdrPut (Rpcbs_rmtcalllist -> ProgNum
rpcbs_rmtcalllist'prog Rpcbs_rmtcalllist
_x) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*>
        forall a. XDR a => a -> Put
XDR.xdrPut (Rpcbs_rmtcalllist -> ProgNum
rpcbs_rmtcalllist'vers Rpcbs_rmtcalllist
_x)
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*> forall a. XDR a => a -> Put
XDR.xdrPut (Rpcbs_rmtcalllist -> ProgNum
rpcbs_rmtcalllist'proc Rpcbs_rmtcalllist
_x)
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*> forall a. XDR a => a -> Put
XDR.xdrPut (Rpcbs_rmtcalllist -> Int
rpcbs_rmtcalllist'success Rpcbs_rmtcalllist
_x)
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*> forall a. XDR a => a -> Put
XDR.xdrPut (Rpcbs_rmtcalllist -> Int
rpcbs_rmtcalllist'failure Rpcbs_rmtcalllist
_x)
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*> forall a. XDR a => a -> Put
XDR.xdrPut (Rpcbs_rmtcalllist -> Int
rpcbs_rmtcalllist'indirect Rpcbs_rmtcalllist
_x)
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*> forall a. XDR a => a -> Put
XDR.xdrPut (Rpcbs_rmtcalllist -> String 4294967295
rpcbs_rmtcalllist'netid Rpcbs_rmtcalllist
_x)
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*> forall a. XDR a => a -> Put
XDR.xdrPut (Rpcbs_rmtcalllist -> Optional Rpcbs_rmtcalllist
rpcbs_rmtcalllist'next Rpcbs_rmtcalllist
_x)
  xdrGet :: Get Rpcbs_rmtcalllist
xdrGet
    = forall (f :: * -> *) a. Applicative f => a -> f a
Control.Applicative.pure ProgNum
-> ProgNum
-> ProgNum
-> Int
-> Int
-> Int
-> String 4294967295
-> Optional Rpcbs_rmtcalllist
-> Rpcbs_rmtcalllist
Rpcbs_rmtcalllist
        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
        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

type Rpcbs_proc = XDR.FixedArray 13 XDR.Int

type Rpcbs_addrlist_ptr = XDR.Optional Rpcbs_addrlist

type Rpcbs_rmtcalllist_ptr = XDR.Optional Rpcbs_rmtcalllist

data Rpcb_stat = Rpcb_stat{Rpcb_stat -> Rpcbs_proc
rpcb_stat'info :: !Rpcbs_proc,
                           Rpcb_stat -> Int
rpcb_stat'setinfo :: !XDR.Int, Rpcb_stat -> Int
rpcb_stat'unsetinfo :: !XDR.Int,
                           Rpcb_stat -> Optional Rpcbs_addrlist
rpcb_stat'addrinfo :: !Rpcbs_addrlist_ptr,
                           Rpcb_stat -> Optional Rpcbs_rmtcalllist
rpcb_stat'rmtinfo :: !Rpcbs_rmtcalllist_ptr}
                 deriving (Rpcb_stat -> Rpcb_stat -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rpcb_stat -> Rpcb_stat -> Bool
$c/= :: Rpcb_stat -> Rpcb_stat -> Bool
== :: Rpcb_stat -> Rpcb_stat -> Bool
$c== :: Rpcb_stat -> Rpcb_stat -> Bool
Prelude.Eq, Int -> Rpcb_stat -> ShowS
[Rpcb_stat] -> ShowS
Rpcb_stat -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rpcb_stat] -> ShowS
$cshowList :: [Rpcb_stat] -> ShowS
show :: Rpcb_stat -> String
$cshow :: Rpcb_stat -> String
showsPrec :: Int -> Rpcb_stat -> ShowS
$cshowsPrec :: Int -> Rpcb_stat -> ShowS
Prelude.Show)

instance XDR.XDR Rpcb_stat where
  xdrType :: Rpcb_stat -> String
xdrType Rpcb_stat
_ = String
"Rpcb_stat"
  xdrPut :: Rpcb_stat -> Put
xdrPut Rpcb_stat
_x
    = forall a. XDR a => a -> Put
XDR.xdrPut (Rpcb_stat -> Rpcbs_proc
rpcb_stat'info Rpcb_stat
_x) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*>
        forall a. XDR a => a -> Put
XDR.xdrPut (Rpcb_stat -> Int
rpcb_stat'setinfo Rpcb_stat
_x)
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*> forall a. XDR a => a -> Put
XDR.xdrPut (Rpcb_stat -> Int
rpcb_stat'unsetinfo Rpcb_stat
_x)
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*> forall a. XDR a => a -> Put
XDR.xdrPut (Rpcb_stat -> Optional Rpcbs_addrlist
rpcb_stat'addrinfo Rpcb_stat
_x)
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*> forall a. XDR a => a -> Put
XDR.xdrPut (Rpcb_stat -> Optional Rpcbs_rmtcalllist
rpcb_stat'rmtinfo Rpcb_stat
_x)
  xdrGet :: Get Rpcb_stat
xdrGet
    = forall (f :: * -> *) a. Applicative f => a -> f a
Control.Applicative.pure Rpcbs_proc
-> Int
-> Int
-> Optional Rpcbs_addrlist
-> Optional Rpcbs_rmtcalllist
-> Rpcb_stat
Rpcb_stat 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

type Rpcb_stat_byvers = XDR.FixedArray 3 Rpcb_stat

data Netbuf = Netbuf{Netbuf -> ProgNum
netbuf'maxlen :: !XDR.UnsignedInt,
                     Netbuf -> Opaque 4294967295
netbuf'buf :: !(XDR.Opaque 4294967295)}
              deriving (Netbuf -> Netbuf -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Netbuf -> Netbuf -> Bool
$c/= :: Netbuf -> Netbuf -> Bool
== :: Netbuf -> Netbuf -> Bool
$c== :: Netbuf -> Netbuf -> Bool
Prelude.Eq, Int -> Netbuf -> ShowS
[Netbuf] -> ShowS
Netbuf -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Netbuf] -> ShowS
$cshowList :: [Netbuf] -> ShowS
show :: Netbuf -> String
$cshow :: Netbuf -> String
showsPrec :: Int -> Netbuf -> ShowS
$cshowsPrec :: Int -> Netbuf -> ShowS
Prelude.Show)

instance XDR.XDR Netbuf where
  xdrType :: Netbuf -> String
xdrType Netbuf
_ = String
"Netbuf"
  xdrPut :: Netbuf -> Put
xdrPut Netbuf
_x
    = forall a. XDR a => a -> Put
XDR.xdrPut (Netbuf -> ProgNum
netbuf'maxlen Netbuf
_x) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*>
        forall a. XDR a => a -> Put
XDR.xdrPut (Netbuf -> Opaque 4294967295
netbuf'buf Netbuf
_x)
  xdrGet :: Get Netbuf
xdrGet
    = forall (f :: * -> *) a. Applicative f => a -> f a
Control.Applicative.pure ProgNum -> Opaque 4294967295 -> Netbuf
Netbuf 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

type Rpc_string = XDR.String 4294967295

rPCBPROG :: RPCBPROG
rPCBPROG :: RPCBPROG
rPCBPROG
  = RPCBPROG'RPCBVERS -> RPCBPROG'RPCBVERS4 -> RPCBPROG
RPCBPROG
      (Procedure Rpcb Bool
-> Procedure Rpcb Bool
-> Procedure Rpcb (String 4294967295)
-> Procedure () (Optional Rp__list)
-> Procedure Rpcb_rmtcallargs Rpcb_rmtcallres
-> Procedure () ProgNum
-> Procedure (String 4294967295) Netbuf
-> Procedure Netbuf (String 4294967295)
-> RPCBPROG'RPCBVERS
RPCBPROG'RPCBVERS (forall a r. ProgNum -> ProgNum -> ProgNum -> Procedure a r
RPC.Procedure ProgNum
100000 ProgNum
3 ProgNum
1)
         (forall a r. ProgNum -> ProgNum -> ProgNum -> Procedure a r
RPC.Procedure ProgNum
100000 ProgNum
3 ProgNum
2)
         (forall a r. ProgNum -> ProgNum -> ProgNum -> Procedure a r
RPC.Procedure ProgNum
100000 ProgNum
3 ProgNum
3)
         (forall a r. ProgNum -> ProgNum -> ProgNum -> Procedure a r
RPC.Procedure ProgNum
100000 ProgNum
3 ProgNum
4)
         (forall a r. ProgNum -> ProgNum -> ProgNum -> Procedure a r
RPC.Procedure ProgNum
100000 ProgNum
3 ProgNum
5)
         (forall a r. ProgNum -> ProgNum -> ProgNum -> Procedure a r
RPC.Procedure ProgNum
100000 ProgNum
3 ProgNum
6)
         (forall a r. ProgNum -> ProgNum -> ProgNum -> Procedure a r
RPC.Procedure ProgNum
100000 ProgNum
3 ProgNum
7)
         (forall a r. ProgNum -> ProgNum -> ProgNum -> Procedure a r
RPC.Procedure ProgNum
100000 ProgNum
3 ProgNum
8))
      (Procedure Rpcb Bool
-> Procedure Rpcb Bool
-> Procedure Rpcb (String 4294967295)
-> Procedure () (Optional Rp__list)
-> Procedure Rpcb_rmtcallargs Rpcb_rmtcallres
-> Procedure () ProgNum
-> Procedure (String 4294967295) Netbuf
-> Procedure Netbuf (String 4294967295)
-> Procedure Rpcb (String 4294967295)
-> Procedure Rpcb_rmtcallargs Rpcb_rmtcallres
-> Procedure Rpcb (Optional Rpcb_entry_list)
-> Procedure () Rpcb_stat_byvers
-> RPCBPROG'RPCBVERS4
RPCBPROG'RPCBVERS4 (forall a r. ProgNum -> ProgNum -> ProgNum -> Procedure a r
RPC.Procedure ProgNum
100000 ProgNum
4 ProgNum
1)
         (forall a r. ProgNum -> ProgNum -> ProgNum -> Procedure a r
RPC.Procedure ProgNum
100000 ProgNum
4 ProgNum
2)
         (forall a r. ProgNum -> ProgNum -> ProgNum -> Procedure a r
RPC.Procedure ProgNum
100000 ProgNum
4 ProgNum
3)
         (forall a r. ProgNum -> ProgNum -> ProgNum -> Procedure a r
RPC.Procedure ProgNum
100000 ProgNum
4 ProgNum
4)
         (forall a r. ProgNum -> ProgNum -> ProgNum -> Procedure a r
RPC.Procedure ProgNum
100000 ProgNum
4 ProgNum
5)
         (forall a r. ProgNum -> ProgNum -> ProgNum -> Procedure a r
RPC.Procedure ProgNum
100000 ProgNum
4 ProgNum
6)
         (forall a r. ProgNum -> ProgNum -> ProgNum -> Procedure a r
RPC.Procedure ProgNum
100000 ProgNum
4 ProgNum
7)
         (forall a r. ProgNum -> ProgNum -> ProgNum -> Procedure a r
RPC.Procedure ProgNum
100000 ProgNum
4 ProgNum
8)
         (forall a r. ProgNum -> ProgNum -> ProgNum -> Procedure a r
RPC.Procedure ProgNum
100000 ProgNum
4 ProgNum
9)
         (forall a r. ProgNum -> ProgNum -> ProgNum -> Procedure a r
RPC.Procedure ProgNum
100000 ProgNum
4 ProgNum
10)
         (forall a r. ProgNum -> ProgNum -> ProgNum -> Procedure a r
RPC.Procedure ProgNum
100000 ProgNum
4 ProgNum
11)
         (forall a r. ProgNum -> ProgNum -> ProgNum -> Procedure a r
RPC.Procedure ProgNum
100000 ProgNum
4 ProgNum
12))

data RPCBPROG = RPCBPROG{RPCBPROG -> RPCBPROG'RPCBVERS
rPCBPROG'RPCBVERS :: !RPCBPROG'RPCBVERS,
                         RPCBPROG -> RPCBPROG'RPCBVERS4
rPCBPROG'RPCBVERS4 :: !RPCBPROG'RPCBVERS4}
                deriving ()

data RPCBPROG'RPCBVERS = RPCBPROG'RPCBVERS{RPCBPROG'RPCBVERS -> Procedure Rpcb Bool
rPCBPROG'RPCBVERS'RPCBPROC_SET
                                           :: !(RPC.Procedure Rpcb XDR.Bool),
                                           RPCBPROG'RPCBVERS -> Procedure Rpcb Bool
rPCBPROG'RPCBVERS'RPCBPROC_UNSET ::
                                           !(RPC.Procedure Rpcb XDR.Bool),
                                           RPCBPROG'RPCBVERS -> Procedure Rpcb (String 4294967295)
rPCBPROG'RPCBVERS'RPCBPROC_GETADDR ::
                                           !(RPC.Procedure Rpcb Rpc_string),
                                           RPCBPROG'RPCBVERS -> Procedure () (Optional Rp__list)
rPCBPROG'RPCBVERS'RPCBPROC_DUMP ::
                                           !(RPC.Procedure () Rpcblist_ptr),
                                           RPCBPROG'RPCBVERS -> Procedure Rpcb_rmtcallargs Rpcb_rmtcallres
rPCBPROG'RPCBVERS'RPCBPROC_CALLIT ::
                                           !(RPC.Procedure Rpcb_rmtcallargs Rpcb_rmtcallres),
                                           RPCBPROG'RPCBVERS -> Procedure () ProgNum
rPCBPROG'RPCBVERS'RPCBPROC_GETTIME ::
                                           !(RPC.Procedure () XDR.UnsignedInt),
                                           RPCBPROG'RPCBVERS -> Procedure (String 4294967295) Netbuf
rPCBPROG'RPCBVERS'RPCBPROC_UADDR2TADDR ::
                                           !(RPC.Procedure Rpc_string Netbuf),
                                           RPCBPROG'RPCBVERS -> Procedure Netbuf (String 4294967295)
rPCBPROG'RPCBVERS'RPCBPROC_TADDR2UADDR ::
                                           !(RPC.Procedure Netbuf Rpc_string)}
                         deriving ()

data RPCBPROG'RPCBVERS4 = RPCBPROG'RPCBVERS4{RPCBPROG'RPCBVERS4 -> Procedure Rpcb Bool
rPCBPROG'RPCBVERS4'RPCBPROC_SET
                                             :: !(RPC.Procedure Rpcb XDR.Bool),
                                             RPCBPROG'RPCBVERS4 -> Procedure Rpcb Bool
rPCBPROG'RPCBVERS4'RPCBPROC_UNSET ::
                                             !(RPC.Procedure Rpcb XDR.Bool),
                                             RPCBPROG'RPCBVERS4 -> Procedure Rpcb (String 4294967295)
rPCBPROG'RPCBVERS4'RPCBPROC_GETADDR ::
                                             !(RPC.Procedure Rpcb Rpc_string),
                                             RPCBPROG'RPCBVERS4 -> Procedure () (Optional Rp__list)
rPCBPROG'RPCBVERS4'RPCBPROC_DUMP ::
                                             !(RPC.Procedure () Rpcblist_ptr),
                                             RPCBPROG'RPCBVERS4 -> Procedure Rpcb_rmtcallargs Rpcb_rmtcallres
rPCBPROG'RPCBVERS4'RPCBPROC_BCAST ::
                                             !(RPC.Procedure Rpcb_rmtcallargs Rpcb_rmtcallres),
                                             RPCBPROG'RPCBVERS4 -> Procedure () ProgNum
rPCBPROG'RPCBVERS4'RPCBPROC_GETTIME ::
                                             !(RPC.Procedure () XDR.UnsignedInt),
                                             RPCBPROG'RPCBVERS4 -> Procedure (String 4294967295) Netbuf
rPCBPROG'RPCBVERS4'RPCBPROC_UADDR2TADDR ::
                                             !(RPC.Procedure Rpc_string Netbuf),
                                             RPCBPROG'RPCBVERS4 -> Procedure Netbuf (String 4294967295)
rPCBPROG'RPCBVERS4'RPCBPROC_TADDR2UADDR ::
                                             !(RPC.Procedure Netbuf Rpc_string),
                                             RPCBPROG'RPCBVERS4 -> Procedure Rpcb (String 4294967295)
rPCBPROG'RPCBVERS4'RPCBPROC_GETVERSADDR ::
                                             !(RPC.Procedure Rpcb Rpc_string),
                                             RPCBPROG'RPCBVERS4 -> Procedure Rpcb_rmtcallargs Rpcb_rmtcallres
rPCBPROG'RPCBVERS4'RPCBPROC_INDIRECT ::
                                             !(RPC.Procedure Rpcb_rmtcallargs Rpcb_rmtcallres),
                                             RPCBPROG'RPCBVERS4 -> Procedure Rpcb (Optional Rpcb_entry_list)
rPCBPROG'RPCBVERS4'RPCBPROC_GETADDRLIST ::
                                             !(RPC.Procedure Rpcb Rpcb_entry_list_ptr),
                                             RPCBPROG'RPCBVERS4 -> Procedure () Rpcb_stat_byvers
rPCBPROG'RPCBVERS4'RPCBPROC_GETSTAT ::
                                             !(RPC.Procedure () Rpcb_stat_byvers)}
                          deriving ()

pMAP_PORT :: Prelude.Integral a => a
pMAP_PORT :: forall a. Integral a => a
pMAP_PORT = a
111

data Mapping = Mapping{Mapping -> ProgNum
mapping'prog :: !XDR.UnsignedInt,
                       Mapping -> ProgNum
mapping'vers :: !XDR.UnsignedInt, Mapping -> ProgNum
mapping'prot :: !XDR.UnsignedInt,
                       Mapping -> ProgNum
mapping'port :: !XDR.UnsignedInt}
               deriving (Mapping -> Mapping -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mapping -> Mapping -> Bool
$c/= :: Mapping -> Mapping -> Bool
== :: Mapping -> Mapping -> Bool
$c== :: Mapping -> Mapping -> Bool
Prelude.Eq, Int -> Mapping -> ShowS
[Mapping] -> ShowS
Mapping -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mapping] -> ShowS
$cshowList :: [Mapping] -> ShowS
show :: Mapping -> String
$cshow :: Mapping -> String
showsPrec :: Int -> Mapping -> ShowS
$cshowsPrec :: Int -> Mapping -> ShowS
Prelude.Show)

instance XDR.XDR Mapping where
  xdrType :: Mapping -> String
xdrType Mapping
_ = String
"Mapping"
  xdrPut :: Mapping -> Put
xdrPut Mapping
_x
    = forall a. XDR a => a -> Put
XDR.xdrPut (Mapping -> ProgNum
mapping'prog Mapping
_x) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*>
        forall a. XDR a => a -> Put
XDR.xdrPut (Mapping -> ProgNum
mapping'vers Mapping
_x)
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*> forall a. XDR a => a -> Put
XDR.xdrPut (Mapping -> ProgNum
mapping'prot Mapping
_x)
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*> forall a. XDR a => a -> Put
XDR.xdrPut (Mapping -> ProgNum
mapping'port Mapping
_x)
  xdrGet :: Get Mapping
xdrGet
    = forall (f :: * -> *) a. Applicative f => a -> f a
Control.Applicative.pure ProgNum -> ProgNum -> ProgNum -> ProgNum -> Mapping
Mapping 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

iPPROTO_TCP :: Prelude.Integral a => a
iPPROTO_TCP :: forall a. Integral a => a
iPPROTO_TCP = a
6

iPPROTO_UDP :: Prelude.Integral a => a
iPPROTO_UDP :: forall a. Integral a => a
iPPROTO_UDP = a
17

data Pmap = Pmap{Pmap -> Mapping
pmap'map :: !Mapping, Pmap -> Pmaplist
pmap'next :: !Pmaplist}
            deriving (Pmap -> Pmap -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pmap -> Pmap -> Bool
$c/= :: Pmap -> Pmap -> Bool
== :: Pmap -> Pmap -> Bool
$c== :: Pmap -> Pmap -> Bool
Prelude.Eq, Int -> Pmap -> ShowS
[Pmap] -> ShowS
Pmap -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pmap] -> ShowS
$cshowList :: [Pmap] -> ShowS
show :: Pmap -> String
$cshow :: Pmap -> String
showsPrec :: Int -> Pmap -> ShowS
$cshowsPrec :: Int -> Pmap -> ShowS
Prelude.Show)

instance XDR.XDR Pmap where
  xdrType :: Pmap -> String
xdrType Pmap
_ = String
"Pmap"
  xdrPut :: Pmap -> Put
xdrPut Pmap
_x
    = forall a. XDR a => a -> Put
XDR.xdrPut (Pmap -> Mapping
pmap'map Pmap
_x) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*>
        forall a. XDR a => a -> Put
XDR.xdrPut (Pmap -> Pmaplist
pmap'next Pmap
_x)
  xdrGet :: Get Pmap
xdrGet
    = forall (f :: * -> *) a. Applicative f => a -> f a
Control.Applicative.pure Mapping -> Pmaplist -> Pmap
Pmap 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

type Pmaplist = XDR.Optional Pmap

data Call_args = Call_args{Call_args -> ProgNum
call_args'prog :: !XDR.UnsignedInt,
                           Call_args -> ProgNum
call_args'vers :: !XDR.UnsignedInt,
                           Call_args -> ProgNum
call_args'proc :: !XDR.UnsignedInt,
                           Call_args -> Opaque 4294967295
call_args'args :: !(XDR.Opaque 4294967295)}
                 deriving (Call_args -> Call_args -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Call_args -> Call_args -> Bool
$c/= :: Call_args -> Call_args -> Bool
== :: Call_args -> Call_args -> Bool
$c== :: Call_args -> Call_args -> Bool
Prelude.Eq, Int -> Call_args -> ShowS
[Call_args] -> ShowS
Call_args -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Call_args] -> ShowS
$cshowList :: [Call_args] -> ShowS
show :: Call_args -> String
$cshow :: Call_args -> String
showsPrec :: Int -> Call_args -> ShowS
$cshowsPrec :: Int -> Call_args -> ShowS
Prelude.Show)

instance XDR.XDR Call_args where
  xdrType :: Call_args -> String
xdrType Call_args
_ = String
"Call_args"
  xdrPut :: Call_args -> Put
xdrPut Call_args
_x
    = forall a. XDR a => a -> Put
XDR.xdrPut (Call_args -> ProgNum
call_args'prog Call_args
_x) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*>
        forall a. XDR a => a -> Put
XDR.xdrPut (Call_args -> ProgNum
call_args'vers Call_args
_x)
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*> forall a. XDR a => a -> Put
XDR.xdrPut (Call_args -> ProgNum
call_args'proc Call_args
_x)
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*> forall a. XDR a => a -> Put
XDR.xdrPut (Call_args -> Opaque 4294967295
call_args'args Call_args
_x)
  xdrGet :: Get Call_args
xdrGet
    = forall (f :: * -> *) a. Applicative f => a -> f a
Control.Applicative.pure ProgNum -> ProgNum -> ProgNum -> Opaque 4294967295 -> Call_args
Call_args 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 Call_result = Call_result{Call_result -> ProgNum
call_result'port ::
                               !XDR.UnsignedInt,
                               Call_result -> Opaque 4294967295
call_result'res :: !(XDR.Opaque 4294967295)}
                   deriving (Call_result -> Call_result -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Call_result -> Call_result -> Bool
$c/= :: Call_result -> Call_result -> Bool
== :: Call_result -> Call_result -> Bool
$c== :: Call_result -> Call_result -> Bool
Prelude.Eq, Int -> Call_result -> ShowS
[Call_result] -> ShowS
Call_result -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Call_result] -> ShowS
$cshowList :: [Call_result] -> ShowS
show :: Call_result -> String
$cshow :: Call_result -> String
showsPrec :: Int -> Call_result -> ShowS
$cshowsPrec :: Int -> Call_result -> ShowS
Prelude.Show)

instance XDR.XDR Call_result where
  xdrType :: Call_result -> String
xdrType Call_result
_ = String
"Call_result"
  xdrPut :: Call_result -> Put
xdrPut Call_result
_x
    = forall a. XDR a => a -> Put
XDR.xdrPut (Call_result -> ProgNum
call_result'port Call_result
_x) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Control.Applicative.*>
        forall a. XDR a => a -> Put
XDR.xdrPut (Call_result -> Opaque 4294967295
call_result'res Call_result
_x)
  xdrGet :: Get Call_result
xdrGet
    = forall (f :: * -> *) a. Applicative f => a -> f a
Control.Applicative.pure ProgNum -> Opaque 4294967295 -> Call_result
Call_result 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

pMAP_PROG :: PMAP_PROG
pMAP_PROG :: PMAP_PROG
pMAP_PROG
  = PMAP_PROG'PMAP_VERS -> PMAP_PROG
PMAP_PROG
      (Procedure () ()
-> Procedure Mapping Bool
-> Procedure Mapping Bool
-> Procedure Mapping ProgNum
-> Procedure () Pmaplist
-> Procedure Call_args Call_result
-> PMAP_PROG'PMAP_VERS
PMAP_PROG'PMAP_VERS (forall a r. ProgNum -> ProgNum -> ProgNum -> Procedure a r
RPC.Procedure ProgNum
100000 ProgNum
2 ProgNum
0)
         (forall a r. ProgNum -> ProgNum -> ProgNum -> Procedure a r
RPC.Procedure ProgNum
100000 ProgNum
2 ProgNum
1)
         (forall a r. ProgNum -> ProgNum -> ProgNum -> Procedure a r
RPC.Procedure ProgNum
100000 ProgNum
2 ProgNum
2)
         (forall a r. ProgNum -> ProgNum -> ProgNum -> Procedure a r
RPC.Procedure ProgNum
100000 ProgNum
2 ProgNum
3)
         (forall a r. ProgNum -> ProgNum -> ProgNum -> Procedure a r
RPC.Procedure ProgNum
100000 ProgNum
2 ProgNum
4)
         (forall a r. ProgNum -> ProgNum -> ProgNum -> Procedure a r
RPC.Procedure ProgNum
100000 ProgNum
2 ProgNum
5))

data PMAP_PROG = PMAP_PROG{PMAP_PROG -> PMAP_PROG'PMAP_VERS
pMAP_PROG'PMAP_VERS ::
                           !PMAP_PROG'PMAP_VERS}
                 deriving ()

data PMAP_PROG'PMAP_VERS = PMAP_PROG'PMAP_VERS{PMAP_PROG'PMAP_VERS -> Procedure () ()
pMAP_PROG'PMAP_VERS'PMAPPROC_NULL
                                               :: !(RPC.Procedure () ()),
                                               PMAP_PROG'PMAP_VERS -> Procedure Mapping Bool
pMAP_PROG'PMAP_VERS'PMAPPROC_SET ::
                                               !(RPC.Procedure Mapping XDR.Bool),
                                               PMAP_PROG'PMAP_VERS -> Procedure Mapping Bool
pMAP_PROG'PMAP_VERS'PMAPPROC_UNSET ::
                                               !(RPC.Procedure Mapping XDR.Bool),
                                               PMAP_PROG'PMAP_VERS -> Procedure Mapping ProgNum
pMAP_PROG'PMAP_VERS'PMAPPROC_GETPORT ::
                                               !(RPC.Procedure Mapping XDR.UnsignedInt),
                                               PMAP_PROG'PMAP_VERS -> Procedure () Pmaplist
pMAP_PROG'PMAP_VERS'PMAPPROC_DUMP ::
                                               !(RPC.Procedure () Pmaplist),
                                               PMAP_PROG'PMAP_VERS -> Procedure Call_args Call_result
pMAP_PROG'PMAP_VERS'PMAPPROC_CALLIT ::
                                               !(RPC.Procedure Call_args Call_result)}
                           deriving ()