{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
module Codec.Encryption.OpenPGP.Types.Internal.PacketClass where
import Codec.Encryption.OpenPGP.Types.Internal.Base
import Codec.Encryption.OpenPGP.Types.Internal.PKITypes
import Codec.Encryption.OpenPGP.Types.Internal.Pkt
import Control.Lens (makeLenses)
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as BL
import Data.Data (Data)
import Data.List.NonEmpty (NonEmpty)
import Data.Text (Text)
import Data.Typeable (Typeable)
import Data.Word (Word8)
import qualified Data.Kind
import Prettyprinter (Pretty(..))
class Packet a where
data PacketType a :: Data.Kind.Type
packetType :: a -> PacketType a
packetCode :: PacketType a -> Word8
toPkt :: a -> Pkt
fromPkt :: Pkt -> a
data PKESK =
PKESK
{ PKESK -> PacketVersion
_pkeskPacketVersion :: PacketVersion
, PKESK -> EightOctetKeyId
_pkeskEightOctetKeyId :: EightOctetKeyId
, PKESK -> PubKeyAlgorithm
_pkeskPubKeyAlgorithm :: PubKeyAlgorithm
, PKESK -> NonEmpty MPI
_pkeskMPIs :: NonEmpty MPI
}
deriving (Typeable PKESK
Typeable PKESK
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PKESK -> c PKESK)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PKESK)
-> (PKESK -> Constr)
-> (PKESK -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PKESK))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PKESK))
-> ((forall b. Data b => b -> b) -> PKESK -> PKESK)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PKESK -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PKESK -> r)
-> (forall u. (forall d. Data d => d -> u) -> PKESK -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> PKESK -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PKESK -> m PKESK)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PKESK -> m PKESK)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PKESK -> m PKESK)
-> Data PKESK
PKESK -> Constr
PKESK -> DataType
(forall b. Data b => b -> b) -> PKESK -> PKESK
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> PKESK -> u
forall u. (forall d. Data d => d -> u) -> PKESK -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PKESK -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PKESK -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PKESK -> m PKESK
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PKESK -> m PKESK
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PKESK
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PKESK -> c PKESK
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PKESK)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PKESK)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PKESK -> c PKESK
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PKESK -> c PKESK
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PKESK
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PKESK
$ctoConstr :: PKESK -> Constr
toConstr :: PKESK -> Constr
$cdataTypeOf :: PKESK -> DataType
dataTypeOf :: PKESK -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PKESK)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PKESK)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PKESK)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PKESK)
$cgmapT :: (forall b. Data b => b -> b) -> PKESK -> PKESK
gmapT :: (forall b. Data b => b -> b) -> PKESK -> PKESK
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PKESK -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PKESK -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PKESK -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PKESK -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PKESK -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> PKESK -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PKESK -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PKESK -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PKESK -> m PKESK
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PKESK -> m PKESK
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PKESK -> m PKESK
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PKESK -> m PKESK
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PKESK -> m PKESK
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PKESK -> m PKESK
Data, PKESK -> PKESK -> Bool
(PKESK -> PKESK -> Bool) -> (PKESK -> PKESK -> Bool) -> Eq PKESK
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PKESK -> PKESK -> Bool
== :: PKESK -> PKESK -> Bool
$c/= :: PKESK -> PKESK -> Bool
/= :: PKESK -> PKESK -> Bool
Eq, Int -> PKESK -> ShowS
[PKESK] -> ShowS
PKESK -> String
(Int -> PKESK -> ShowS)
-> (PKESK -> String) -> ([PKESK] -> ShowS) -> Show PKESK
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PKESK -> ShowS
showsPrec :: Int -> PKESK -> ShowS
$cshow :: PKESK -> String
show :: PKESK -> String
$cshowList :: [PKESK] -> ShowS
showList :: [PKESK] -> ShowS
Show, Typeable)
instance Packet PKESK where
data PacketType PKESK = PKESKType
deriving (Int -> PacketType PKESK -> ShowS
[PacketType PKESK] -> ShowS
PacketType PKESK -> String
(Int -> PacketType PKESK -> ShowS)
-> (PacketType PKESK -> String)
-> ([PacketType PKESK] -> ShowS)
-> Show (PacketType PKESK)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PacketType PKESK -> ShowS
showsPrec :: Int -> PacketType PKESK -> ShowS
$cshow :: PacketType PKESK -> String
show :: PacketType PKESK -> String
$cshowList :: [PacketType PKESK] -> ShowS
showList :: [PacketType PKESK] -> ShowS
Show, PacketType PKESK -> PacketType PKESK -> Bool
(PacketType PKESK -> PacketType PKESK -> Bool)
-> (PacketType PKESK -> PacketType PKESK -> Bool)
-> Eq (PacketType PKESK)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PacketType PKESK -> PacketType PKESK -> Bool
== :: PacketType PKESK -> PacketType PKESK -> Bool
$c/= :: PacketType PKESK -> PacketType PKESK -> Bool
/= :: PacketType PKESK -> PacketType PKESK -> Bool
Eq)
packetType :: PKESK -> PacketType PKESK
packetType PKESK
_ = PacketType PKESK
PKESKType
packetCode :: PacketType PKESK -> PacketVersion
packetCode PacketType PKESK
_ = PacketVersion
1
toPkt :: PKESK -> Pkt
toPkt (PKESK PacketVersion
a EightOctetKeyId
b PubKeyAlgorithm
c NonEmpty MPI
d) = PacketVersion
-> EightOctetKeyId -> PubKeyAlgorithm -> NonEmpty MPI -> Pkt
PKESKPkt PacketVersion
a EightOctetKeyId
b PubKeyAlgorithm
c NonEmpty MPI
d
fromPkt :: Pkt -> PKESK
fromPkt (PKESKPkt PacketVersion
a EightOctetKeyId
b PubKeyAlgorithm
c NonEmpty MPI
d) = PacketVersion
-> EightOctetKeyId -> PubKeyAlgorithm -> NonEmpty MPI -> PKESK
PKESK PacketVersion
a EightOctetKeyId
b PubKeyAlgorithm
c NonEmpty MPI
d
fromPkt Pkt
_ = String -> PKESK
forall a. HasCallStack => String -> a
error String
"Cannot coerce non-PKESK packet"
instance Pretty PKESK where
pretty :: forall ann. PKESK -> Doc ann
pretty = Pkt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Pkt -> Doc ann
pretty (Pkt -> Doc ann) -> (PKESK -> Pkt) -> PKESK -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PKESK -> Pkt
forall a. Packet a => a -> Pkt
toPkt
newtype Signature =
Signature
{ Signature -> SignaturePayload
_signaturePayload :: SignaturePayload
}
deriving (Typeable Signature
Typeable Signature
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Signature -> c Signature)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Signature)
-> (Signature -> Constr)
-> (Signature -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Signature))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Signature))
-> ((forall b. Data b => b -> b) -> Signature -> Signature)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Signature -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Signature -> r)
-> (forall u. (forall d. Data d => d -> u) -> Signature -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> Signature -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Signature -> m Signature)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Signature -> m Signature)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Signature -> m Signature)
-> Data Signature
Signature -> Constr
Signature -> DataType
(forall b. Data b => b -> b) -> Signature -> Signature
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Signature -> u
forall u. (forall d. Data d => d -> u) -> Signature -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Signature -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Signature -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Signature -> m Signature
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Signature -> m Signature
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Signature
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Signature -> c Signature
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Signature)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Signature)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Signature -> c Signature
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Signature -> c Signature
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Signature
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Signature
$ctoConstr :: Signature -> Constr
toConstr :: Signature -> Constr
$cdataTypeOf :: Signature -> DataType
dataTypeOf :: Signature -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Signature)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Signature)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Signature)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Signature)
$cgmapT :: (forall b. Data b => b -> b) -> Signature -> Signature
gmapT :: (forall b. Data b => b -> b) -> Signature -> Signature
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Signature -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Signature -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Signature -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Signature -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Signature -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Signature -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Signature -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Signature -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Signature -> m Signature
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Signature -> m Signature
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Signature -> m Signature
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Signature -> m Signature
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Signature -> m Signature
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Signature -> m Signature
Data, Signature -> Signature -> Bool
(Signature -> Signature -> Bool)
-> (Signature -> Signature -> Bool) -> Eq Signature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Signature -> Signature -> Bool
== :: Signature -> Signature -> Bool
$c/= :: Signature -> Signature -> Bool
/= :: Signature -> Signature -> Bool
Eq, Int -> Signature -> ShowS
[Signature] -> ShowS
Signature -> String
(Int -> Signature -> ShowS)
-> (Signature -> String)
-> ([Signature] -> ShowS)
-> Show Signature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Signature -> ShowS
showsPrec :: Int -> Signature -> ShowS
$cshow :: Signature -> String
show :: Signature -> String
$cshowList :: [Signature] -> ShowS
showList :: [Signature] -> ShowS
Show, Typeable)
instance Packet Signature where
data PacketType Signature = SignatureType
deriving (Int -> PacketType Signature -> ShowS
[PacketType Signature] -> ShowS
PacketType Signature -> String
(Int -> PacketType Signature -> ShowS)
-> (PacketType Signature -> String)
-> ([PacketType Signature] -> ShowS)
-> Show (PacketType Signature)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PacketType Signature -> ShowS
showsPrec :: Int -> PacketType Signature -> ShowS
$cshow :: PacketType Signature -> String
show :: PacketType Signature -> String
$cshowList :: [PacketType Signature] -> ShowS
showList :: [PacketType Signature] -> ShowS
Show, PacketType Signature -> PacketType Signature -> Bool
(PacketType Signature -> PacketType Signature -> Bool)
-> (PacketType Signature -> PacketType Signature -> Bool)
-> Eq (PacketType Signature)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PacketType Signature -> PacketType Signature -> Bool
== :: PacketType Signature -> PacketType Signature -> Bool
$c/= :: PacketType Signature -> PacketType Signature -> Bool
/= :: PacketType Signature -> PacketType Signature -> Bool
Eq)
packetType :: Signature -> PacketType Signature
packetType Signature
_ = PacketType Signature
SignatureType
packetCode :: PacketType Signature -> PacketVersion
packetCode PacketType Signature
_ = PacketVersion
2
toPkt :: Signature -> Pkt
toPkt (Signature SignaturePayload
a) = SignaturePayload -> Pkt
SignaturePkt SignaturePayload
a
fromPkt :: Pkt -> Signature
fromPkt (SignaturePkt SignaturePayload
a) = SignaturePayload -> Signature
Signature SignaturePayload
a
fromPkt Pkt
_ = String -> Signature
forall a. HasCallStack => String -> a
error String
"Cannot coerce non-Signature packet"
instance Pretty Signature where
pretty :: forall ann. Signature -> Doc ann
pretty = Pkt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Pkt -> Doc ann
pretty (Pkt -> Doc ann) -> (Signature -> Pkt) -> Signature -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature -> Pkt
forall a. Packet a => a -> Pkt
toPkt
data SKESK =
SKESK
{ SKESK -> PacketVersion
_skeskPacketVersion :: PacketVersion
, SKESK -> SymmetricAlgorithm
_skeskSymmetricAlgorithm :: SymmetricAlgorithm
, SKESK -> S2K
_skeskS2K :: S2K
, SKESK -> Maybe ByteString
_skeskESK :: Maybe BL.ByteString
}
deriving (Typeable SKESK
Typeable SKESK
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SKESK -> c SKESK)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SKESK)
-> (SKESK -> Constr)
-> (SKESK -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SKESK))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SKESK))
-> ((forall b. Data b => b -> b) -> SKESK -> SKESK)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SKESK -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SKESK -> r)
-> (forall u. (forall d. Data d => d -> u) -> SKESK -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> SKESK -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SKESK -> m SKESK)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SKESK -> m SKESK)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SKESK -> m SKESK)
-> Data SKESK
SKESK -> Constr
SKESK -> DataType
(forall b. Data b => b -> b) -> SKESK -> SKESK
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SKESK -> u
forall u. (forall d. Data d => d -> u) -> SKESK -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SKESK -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SKESK -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SKESK -> m SKESK
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SKESK -> m SKESK
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SKESK
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SKESK -> c SKESK
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SKESK)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SKESK)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SKESK -> c SKESK
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SKESK -> c SKESK
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SKESK
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SKESK
$ctoConstr :: SKESK -> Constr
toConstr :: SKESK -> Constr
$cdataTypeOf :: SKESK -> DataType
dataTypeOf :: SKESK -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SKESK)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SKESK)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SKESK)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SKESK)
$cgmapT :: (forall b. Data b => b -> b) -> SKESK -> SKESK
gmapT :: (forall b. Data b => b -> b) -> SKESK -> SKESK
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SKESK -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SKESK -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SKESK -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SKESK -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SKESK -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> SKESK -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SKESK -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SKESK -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SKESK -> m SKESK
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SKESK -> m SKESK
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SKESK -> m SKESK
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SKESK -> m SKESK
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SKESK -> m SKESK
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SKESK -> m SKESK
Data, SKESK -> SKESK -> Bool
(SKESK -> SKESK -> Bool) -> (SKESK -> SKESK -> Bool) -> Eq SKESK
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SKESK -> SKESK -> Bool
== :: SKESK -> SKESK -> Bool
$c/= :: SKESK -> SKESK -> Bool
/= :: SKESK -> SKESK -> Bool
Eq, Int -> SKESK -> ShowS
[SKESK] -> ShowS
SKESK -> String
(Int -> SKESK -> ShowS)
-> (SKESK -> String) -> ([SKESK] -> ShowS) -> Show SKESK
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SKESK -> ShowS
showsPrec :: Int -> SKESK -> ShowS
$cshow :: SKESK -> String
show :: SKESK -> String
$cshowList :: [SKESK] -> ShowS
showList :: [SKESK] -> ShowS
Show, Typeable)
instance Packet SKESK where
data PacketType SKESK = SKESKType
deriving (Int -> PacketType SKESK -> ShowS
[PacketType SKESK] -> ShowS
PacketType SKESK -> String
(Int -> PacketType SKESK -> ShowS)
-> (PacketType SKESK -> String)
-> ([PacketType SKESK] -> ShowS)
-> Show (PacketType SKESK)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PacketType SKESK -> ShowS
showsPrec :: Int -> PacketType SKESK -> ShowS
$cshow :: PacketType SKESK -> String
show :: PacketType SKESK -> String
$cshowList :: [PacketType SKESK] -> ShowS
showList :: [PacketType SKESK] -> ShowS
Show, PacketType SKESK -> PacketType SKESK -> Bool
(PacketType SKESK -> PacketType SKESK -> Bool)
-> (PacketType SKESK -> PacketType SKESK -> Bool)
-> Eq (PacketType SKESK)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PacketType SKESK -> PacketType SKESK -> Bool
== :: PacketType SKESK -> PacketType SKESK -> Bool
$c/= :: PacketType SKESK -> PacketType SKESK -> Bool
/= :: PacketType SKESK -> PacketType SKESK -> Bool
Eq)
packetType :: SKESK -> PacketType SKESK
packetType SKESK
_ = PacketType SKESK
SKESKType
packetCode :: PacketType SKESK -> PacketVersion
packetCode PacketType SKESK
_ = PacketVersion
3
toPkt :: SKESK -> Pkt
toPkt (SKESK PacketVersion
a SymmetricAlgorithm
b S2K
c Maybe ByteString
d) = PacketVersion
-> SymmetricAlgorithm -> S2K -> Maybe ByteString -> Pkt
SKESKPkt PacketVersion
a SymmetricAlgorithm
b S2K
c Maybe ByteString
d
fromPkt :: Pkt -> SKESK
fromPkt (SKESKPkt PacketVersion
a SymmetricAlgorithm
b S2K
c Maybe ByteString
d) = PacketVersion
-> SymmetricAlgorithm -> S2K -> Maybe ByteString -> SKESK
SKESK PacketVersion
a SymmetricAlgorithm
b S2K
c Maybe ByteString
d
fromPkt Pkt
_ = String -> SKESK
forall a. HasCallStack => String -> a
error String
"Cannot coerce non-SKESK packet"
instance Pretty SKESK where
pretty :: forall ann. SKESK -> Doc ann
pretty = Pkt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Pkt -> Doc ann
pretty (Pkt -> Doc ann) -> (SKESK -> Pkt) -> SKESK -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SKESK -> Pkt
forall a. Packet a => a -> Pkt
toPkt
data OnePassSignature =
OnePassSignature
{ OnePassSignature -> PacketVersion
_onePassSignaturePacketVersion :: PacketVersion
, OnePassSignature -> SigType
_onePassSignatureSigType :: SigType
, OnePassSignature -> HashAlgorithm
_onePassSignatureHashAlgorithm :: HashAlgorithm
, OnePassSignature -> PubKeyAlgorithm
_onePassSignaturePubKeyAlgorithm :: PubKeyAlgorithm
, OnePassSignature -> EightOctetKeyId
_onePassSignatureEightOctetKeyId :: EightOctetKeyId
, OnePassSignature -> Bool
_onePassSignatureNestedFlag :: NestedFlag
}
deriving (Typeable OnePassSignature
Typeable OnePassSignature
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OnePassSignature -> c OnePassSignature)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OnePassSignature)
-> (OnePassSignature -> Constr)
-> (OnePassSignature -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OnePassSignature))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OnePassSignature))
-> ((forall b. Data b => b -> b)
-> OnePassSignature -> OnePassSignature)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OnePassSignature -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OnePassSignature -> r)
-> (forall u.
(forall d. Data d => d -> u) -> OnePassSignature -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> OnePassSignature -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> OnePassSignature -> m OnePassSignature)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> OnePassSignature -> m OnePassSignature)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> OnePassSignature -> m OnePassSignature)
-> Data OnePassSignature
OnePassSignature -> Constr
OnePassSignature -> DataType
(forall b. Data b => b -> b)
-> OnePassSignature -> OnePassSignature
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> OnePassSignature -> u
forall u. (forall d. Data d => d -> u) -> OnePassSignature -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OnePassSignature -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OnePassSignature -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> OnePassSignature -> m OnePassSignature
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> OnePassSignature -> m OnePassSignature
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OnePassSignature
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OnePassSignature -> c OnePassSignature
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OnePassSignature)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OnePassSignature)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OnePassSignature -> c OnePassSignature
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OnePassSignature -> c OnePassSignature
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OnePassSignature
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OnePassSignature
$ctoConstr :: OnePassSignature -> Constr
toConstr :: OnePassSignature -> Constr
$cdataTypeOf :: OnePassSignature -> DataType
dataTypeOf :: OnePassSignature -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OnePassSignature)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OnePassSignature)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OnePassSignature)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OnePassSignature)
$cgmapT :: (forall b. Data b => b -> b)
-> OnePassSignature -> OnePassSignature
gmapT :: (forall b. Data b => b -> b)
-> OnePassSignature -> OnePassSignature
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OnePassSignature -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OnePassSignature -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OnePassSignature -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OnePassSignature -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> OnePassSignature -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> OnePassSignature -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> OnePassSignature -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> OnePassSignature -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> OnePassSignature -> m OnePassSignature
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> OnePassSignature -> m OnePassSignature
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> OnePassSignature -> m OnePassSignature
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> OnePassSignature -> m OnePassSignature
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> OnePassSignature -> m OnePassSignature
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> OnePassSignature -> m OnePassSignature
Data, OnePassSignature -> OnePassSignature -> Bool
(OnePassSignature -> OnePassSignature -> Bool)
-> (OnePassSignature -> OnePassSignature -> Bool)
-> Eq OnePassSignature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OnePassSignature -> OnePassSignature -> Bool
== :: OnePassSignature -> OnePassSignature -> Bool
$c/= :: OnePassSignature -> OnePassSignature -> Bool
/= :: OnePassSignature -> OnePassSignature -> Bool
Eq, Int -> OnePassSignature -> ShowS
[OnePassSignature] -> ShowS
OnePassSignature -> String
(Int -> OnePassSignature -> ShowS)
-> (OnePassSignature -> String)
-> ([OnePassSignature] -> ShowS)
-> Show OnePassSignature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OnePassSignature -> ShowS
showsPrec :: Int -> OnePassSignature -> ShowS
$cshow :: OnePassSignature -> String
show :: OnePassSignature -> String
$cshowList :: [OnePassSignature] -> ShowS
showList :: [OnePassSignature] -> ShowS
Show, Typeable)
instance Packet OnePassSignature where
data PacketType OnePassSignature = OnePassSignatureType
deriving (Int -> PacketType OnePassSignature -> ShowS
[PacketType OnePassSignature] -> ShowS
PacketType OnePassSignature -> String
(Int -> PacketType OnePassSignature -> ShowS)
-> (PacketType OnePassSignature -> String)
-> ([PacketType OnePassSignature] -> ShowS)
-> Show (PacketType OnePassSignature)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PacketType OnePassSignature -> ShowS
showsPrec :: Int -> PacketType OnePassSignature -> ShowS
$cshow :: PacketType OnePassSignature -> String
show :: PacketType OnePassSignature -> String
$cshowList :: [PacketType OnePassSignature] -> ShowS
showList :: [PacketType OnePassSignature] -> ShowS
Show, PacketType OnePassSignature -> PacketType OnePassSignature -> Bool
(PacketType OnePassSignature
-> PacketType OnePassSignature -> Bool)
-> (PacketType OnePassSignature
-> PacketType OnePassSignature -> Bool)
-> Eq (PacketType OnePassSignature)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PacketType OnePassSignature -> PacketType OnePassSignature -> Bool
== :: PacketType OnePassSignature -> PacketType OnePassSignature -> Bool
$c/= :: PacketType OnePassSignature -> PacketType OnePassSignature -> Bool
/= :: PacketType OnePassSignature -> PacketType OnePassSignature -> Bool
Eq)
packetType :: OnePassSignature -> PacketType OnePassSignature
packetType OnePassSignature
_ = PacketType OnePassSignature
OnePassSignatureType
packetCode :: PacketType OnePassSignature -> PacketVersion
packetCode PacketType OnePassSignature
_ = PacketVersion
4
toPkt :: OnePassSignature -> Pkt
toPkt (OnePassSignature PacketVersion
a SigType
b HashAlgorithm
c PubKeyAlgorithm
d EightOctetKeyId
e Bool
f) = PacketVersion
-> SigType
-> HashAlgorithm
-> PubKeyAlgorithm
-> EightOctetKeyId
-> Bool
-> Pkt
OnePassSignaturePkt PacketVersion
a SigType
b HashAlgorithm
c PubKeyAlgorithm
d EightOctetKeyId
e Bool
f
fromPkt :: Pkt -> OnePassSignature
fromPkt (OnePassSignaturePkt PacketVersion
a SigType
b HashAlgorithm
c PubKeyAlgorithm
d EightOctetKeyId
e Bool
f) = PacketVersion
-> SigType
-> HashAlgorithm
-> PubKeyAlgorithm
-> EightOctetKeyId
-> Bool
-> OnePassSignature
OnePassSignature PacketVersion
a SigType
b HashAlgorithm
c PubKeyAlgorithm
d EightOctetKeyId
e Bool
f
fromPkt Pkt
_ = String -> OnePassSignature
forall a. HasCallStack => String -> a
error String
"Cannot coerce non-OnePassSignature packet"
instance Pretty OnePassSignature where
pretty :: forall ann. OnePassSignature -> Doc ann
pretty = Pkt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Pkt -> Doc ann
pretty (Pkt -> Doc ann)
-> (OnePassSignature -> Pkt) -> OnePassSignature -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnePassSignature -> Pkt
forall a. Packet a => a -> Pkt
toPkt
data SecretKey =
SecretKey
{ SecretKey -> PKPayload
_secretKeyPKPayload :: PKPayload
, SecretKey -> SKAddendum
_secretKeySKAddendum :: SKAddendum
}
deriving (Typeable SecretKey
Typeable SecretKey
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SecretKey -> c SecretKey)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SecretKey)
-> (SecretKey -> Constr)
-> (SecretKey -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SecretKey))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SecretKey))
-> ((forall b. Data b => b -> b) -> SecretKey -> SecretKey)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SecretKey -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SecretKey -> r)
-> (forall u. (forall d. Data d => d -> u) -> SecretKey -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> SecretKey -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SecretKey -> m SecretKey)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SecretKey -> m SecretKey)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SecretKey -> m SecretKey)
-> Data SecretKey
SecretKey -> Constr
SecretKey -> DataType
(forall b. Data b => b -> b) -> SecretKey -> SecretKey
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SecretKey -> u
forall u. (forall d. Data d => d -> u) -> SecretKey -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SecretKey -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SecretKey -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SecretKey -> m SecretKey
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SecretKey -> m SecretKey
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SecretKey
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SecretKey -> c SecretKey
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SecretKey)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SecretKey)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SecretKey -> c SecretKey
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SecretKey -> c SecretKey
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SecretKey
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SecretKey
$ctoConstr :: SecretKey -> Constr
toConstr :: SecretKey -> Constr
$cdataTypeOf :: SecretKey -> DataType
dataTypeOf :: SecretKey -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SecretKey)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SecretKey)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SecretKey)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SecretKey)
$cgmapT :: (forall b. Data b => b -> b) -> SecretKey -> SecretKey
gmapT :: (forall b. Data b => b -> b) -> SecretKey -> SecretKey
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SecretKey -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SecretKey -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SecretKey -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SecretKey -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SecretKey -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> SecretKey -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SecretKey -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SecretKey -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SecretKey -> m SecretKey
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SecretKey -> m SecretKey
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SecretKey -> m SecretKey
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SecretKey -> m SecretKey
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SecretKey -> m SecretKey
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SecretKey -> m SecretKey
Data, SecretKey -> SecretKey -> Bool
(SecretKey -> SecretKey -> Bool)
-> (SecretKey -> SecretKey -> Bool) -> Eq SecretKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SecretKey -> SecretKey -> Bool
== :: SecretKey -> SecretKey -> Bool
$c/= :: SecretKey -> SecretKey -> Bool
/= :: SecretKey -> SecretKey -> Bool
Eq, Int -> SecretKey -> ShowS
[SecretKey] -> ShowS
SecretKey -> String
(Int -> SecretKey -> ShowS)
-> (SecretKey -> String)
-> ([SecretKey] -> ShowS)
-> Show SecretKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SecretKey -> ShowS
showsPrec :: Int -> SecretKey -> ShowS
$cshow :: SecretKey -> String
show :: SecretKey -> String
$cshowList :: [SecretKey] -> ShowS
showList :: [SecretKey] -> ShowS
Show, Typeable)
instance Packet SecretKey where
data PacketType SecretKey = SecretKeyType
deriving (Int -> PacketType SecretKey -> ShowS
[PacketType SecretKey] -> ShowS
PacketType SecretKey -> String
(Int -> PacketType SecretKey -> ShowS)
-> (PacketType SecretKey -> String)
-> ([PacketType SecretKey] -> ShowS)
-> Show (PacketType SecretKey)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PacketType SecretKey -> ShowS
showsPrec :: Int -> PacketType SecretKey -> ShowS
$cshow :: PacketType SecretKey -> String
show :: PacketType SecretKey -> String
$cshowList :: [PacketType SecretKey] -> ShowS
showList :: [PacketType SecretKey] -> ShowS
Show, PacketType SecretKey -> PacketType SecretKey -> Bool
(PacketType SecretKey -> PacketType SecretKey -> Bool)
-> (PacketType SecretKey -> PacketType SecretKey -> Bool)
-> Eq (PacketType SecretKey)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PacketType SecretKey -> PacketType SecretKey -> Bool
== :: PacketType SecretKey -> PacketType SecretKey -> Bool
$c/= :: PacketType SecretKey -> PacketType SecretKey -> Bool
/= :: PacketType SecretKey -> PacketType SecretKey -> Bool
Eq)
packetType :: SecretKey -> PacketType SecretKey
packetType SecretKey
_ = PacketType SecretKey
SecretKeyType
packetCode :: PacketType SecretKey -> PacketVersion
packetCode PacketType SecretKey
_ = PacketVersion
5
toPkt :: SecretKey -> Pkt
toPkt (SecretKey PKPayload
a SKAddendum
b) = PKPayload -> SKAddendum -> Pkt
SecretKeyPkt PKPayload
a SKAddendum
b
fromPkt :: Pkt -> SecretKey
fromPkt (SecretKeyPkt PKPayload
a SKAddendum
b) = PKPayload -> SKAddendum -> SecretKey
SecretKey PKPayload
a SKAddendum
b
fromPkt Pkt
_ = String -> SecretKey
forall a. HasCallStack => String -> a
error String
"Cannot coerce non-SecretKey packet"
instance Pretty SecretKey where
pretty :: forall ann. SecretKey -> Doc ann
pretty = Pkt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Pkt -> Doc ann
pretty (Pkt -> Doc ann) -> (SecretKey -> Pkt) -> SecretKey -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecretKey -> Pkt
forall a. Packet a => a -> Pkt
toPkt
newtype PublicKey =
PublicKey
{ PublicKey -> PKPayload
_publicKeyPKPayload :: PKPayload
}
deriving (Typeable PublicKey
Typeable PublicKey
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PublicKey -> c PublicKey)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PublicKey)
-> (PublicKey -> Constr)
-> (PublicKey -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PublicKey))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PublicKey))
-> ((forall b. Data b => b -> b) -> PublicKey -> PublicKey)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PublicKey -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PublicKey -> r)
-> (forall u. (forall d. Data d => d -> u) -> PublicKey -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> PublicKey -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PublicKey -> m PublicKey)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PublicKey -> m PublicKey)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PublicKey -> m PublicKey)
-> Data PublicKey
PublicKey -> Constr
PublicKey -> DataType
(forall b. Data b => b -> b) -> PublicKey -> PublicKey
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> PublicKey -> u
forall u. (forall d. Data d => d -> u) -> PublicKey -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PublicKey -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PublicKey -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PublicKey -> m PublicKey
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PublicKey -> m PublicKey
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PublicKey
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PublicKey -> c PublicKey
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PublicKey)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PublicKey)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PublicKey -> c PublicKey
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PublicKey -> c PublicKey
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PublicKey
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PublicKey
$ctoConstr :: PublicKey -> Constr
toConstr :: PublicKey -> Constr
$cdataTypeOf :: PublicKey -> DataType
dataTypeOf :: PublicKey -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PublicKey)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PublicKey)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PublicKey)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PublicKey)
$cgmapT :: (forall b. Data b => b -> b) -> PublicKey -> PublicKey
gmapT :: (forall b. Data b => b -> b) -> PublicKey -> PublicKey
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PublicKey -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PublicKey -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PublicKey -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PublicKey -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PublicKey -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> PublicKey -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PublicKey -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PublicKey -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PublicKey -> m PublicKey
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PublicKey -> m PublicKey
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PublicKey -> m PublicKey
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PublicKey -> m PublicKey
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PublicKey -> m PublicKey
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PublicKey -> m PublicKey
Data, PublicKey -> PublicKey -> Bool
(PublicKey -> PublicKey -> Bool)
-> (PublicKey -> PublicKey -> Bool) -> Eq PublicKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PublicKey -> PublicKey -> Bool
== :: PublicKey -> PublicKey -> Bool
$c/= :: PublicKey -> PublicKey -> Bool
/= :: PublicKey -> PublicKey -> Bool
Eq, Int -> PublicKey -> ShowS
[PublicKey] -> ShowS
PublicKey -> String
(Int -> PublicKey -> ShowS)
-> (PublicKey -> String)
-> ([PublicKey] -> ShowS)
-> Show PublicKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PublicKey -> ShowS
showsPrec :: Int -> PublicKey -> ShowS
$cshow :: PublicKey -> String
show :: PublicKey -> String
$cshowList :: [PublicKey] -> ShowS
showList :: [PublicKey] -> ShowS
Show, Typeable)
instance Packet PublicKey where
data PacketType PublicKey = PublicKeyType
deriving (Int -> PacketType PublicKey -> ShowS
[PacketType PublicKey] -> ShowS
PacketType PublicKey -> String
(Int -> PacketType PublicKey -> ShowS)
-> (PacketType PublicKey -> String)
-> ([PacketType PublicKey] -> ShowS)
-> Show (PacketType PublicKey)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PacketType PublicKey -> ShowS
showsPrec :: Int -> PacketType PublicKey -> ShowS
$cshow :: PacketType PublicKey -> String
show :: PacketType PublicKey -> String
$cshowList :: [PacketType PublicKey] -> ShowS
showList :: [PacketType PublicKey] -> ShowS
Show, PacketType PublicKey -> PacketType PublicKey -> Bool
(PacketType PublicKey -> PacketType PublicKey -> Bool)
-> (PacketType PublicKey -> PacketType PublicKey -> Bool)
-> Eq (PacketType PublicKey)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PacketType PublicKey -> PacketType PublicKey -> Bool
== :: PacketType PublicKey -> PacketType PublicKey -> Bool
$c/= :: PacketType PublicKey -> PacketType PublicKey -> Bool
/= :: PacketType PublicKey -> PacketType PublicKey -> Bool
Eq)
packetType :: PublicKey -> PacketType PublicKey
packetType PublicKey
_ = PacketType PublicKey
PublicKeyType
packetCode :: PacketType PublicKey -> PacketVersion
packetCode PacketType PublicKey
_ = PacketVersion
6
toPkt :: PublicKey -> Pkt
toPkt (PublicKey PKPayload
a) = PKPayload -> Pkt
PublicKeyPkt PKPayload
a
fromPkt :: Pkt -> PublicKey
fromPkt (PublicKeyPkt PKPayload
a) = PKPayload -> PublicKey
PublicKey PKPayload
a
fromPkt Pkt
_ = String -> PublicKey
forall a. HasCallStack => String -> a
error String
"Cannot coerce non-PublicKey packet"
instance Pretty PublicKey where
pretty :: forall ann. PublicKey -> Doc ann
pretty = Pkt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Pkt -> Doc ann
pretty (Pkt -> Doc ann) -> (PublicKey -> Pkt) -> PublicKey -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey -> Pkt
forall a. Packet a => a -> Pkt
toPkt
data SecretSubkey =
SecretSubkey
{ SecretSubkey -> PKPayload
_secretSubkeyPKPayload :: PKPayload
, SecretSubkey -> SKAddendum
_secretSubkeySKAddendum :: SKAddendum
}
deriving (Typeable SecretSubkey
Typeable SecretSubkey
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SecretSubkey -> c SecretSubkey)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SecretSubkey)
-> (SecretSubkey -> Constr)
-> (SecretSubkey -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SecretSubkey))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SecretSubkey))
-> ((forall b. Data b => b -> b) -> SecretSubkey -> SecretSubkey)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SecretSubkey -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SecretSubkey -> r)
-> (forall u. (forall d. Data d => d -> u) -> SecretSubkey -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> SecretSubkey -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SecretSubkey -> m SecretSubkey)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SecretSubkey -> m SecretSubkey)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SecretSubkey -> m SecretSubkey)
-> Data SecretSubkey
SecretSubkey -> Constr
SecretSubkey -> DataType
(forall b. Data b => b -> b) -> SecretSubkey -> SecretSubkey
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SecretSubkey -> u
forall u. (forall d. Data d => d -> u) -> SecretSubkey -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SecretSubkey -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SecretSubkey -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SecretSubkey -> m SecretSubkey
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SecretSubkey -> m SecretSubkey
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SecretSubkey
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SecretSubkey -> c SecretSubkey
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SecretSubkey)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SecretSubkey)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SecretSubkey -> c SecretSubkey
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SecretSubkey -> c SecretSubkey
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SecretSubkey
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SecretSubkey
$ctoConstr :: SecretSubkey -> Constr
toConstr :: SecretSubkey -> Constr
$cdataTypeOf :: SecretSubkey -> DataType
dataTypeOf :: SecretSubkey -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SecretSubkey)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SecretSubkey)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SecretSubkey)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SecretSubkey)
$cgmapT :: (forall b. Data b => b -> b) -> SecretSubkey -> SecretSubkey
gmapT :: (forall b. Data b => b -> b) -> SecretSubkey -> SecretSubkey
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SecretSubkey -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SecretSubkey -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SecretSubkey -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SecretSubkey -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SecretSubkey -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> SecretSubkey -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SecretSubkey -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SecretSubkey -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SecretSubkey -> m SecretSubkey
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SecretSubkey -> m SecretSubkey
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SecretSubkey -> m SecretSubkey
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SecretSubkey -> m SecretSubkey
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SecretSubkey -> m SecretSubkey
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SecretSubkey -> m SecretSubkey
Data, SecretSubkey -> SecretSubkey -> Bool
(SecretSubkey -> SecretSubkey -> Bool)
-> (SecretSubkey -> SecretSubkey -> Bool) -> Eq SecretSubkey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SecretSubkey -> SecretSubkey -> Bool
== :: SecretSubkey -> SecretSubkey -> Bool
$c/= :: SecretSubkey -> SecretSubkey -> Bool
/= :: SecretSubkey -> SecretSubkey -> Bool
Eq, Int -> SecretSubkey -> ShowS
[SecretSubkey] -> ShowS
SecretSubkey -> String
(Int -> SecretSubkey -> ShowS)
-> (SecretSubkey -> String)
-> ([SecretSubkey] -> ShowS)
-> Show SecretSubkey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SecretSubkey -> ShowS
showsPrec :: Int -> SecretSubkey -> ShowS
$cshow :: SecretSubkey -> String
show :: SecretSubkey -> String
$cshowList :: [SecretSubkey] -> ShowS
showList :: [SecretSubkey] -> ShowS
Show, Typeable)
instance Packet SecretSubkey where
data PacketType SecretSubkey = SecretSubkeyType
deriving (Int -> PacketType SecretSubkey -> ShowS
[PacketType SecretSubkey] -> ShowS
PacketType SecretSubkey -> String
(Int -> PacketType SecretSubkey -> ShowS)
-> (PacketType SecretSubkey -> String)
-> ([PacketType SecretSubkey] -> ShowS)
-> Show (PacketType SecretSubkey)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PacketType SecretSubkey -> ShowS
showsPrec :: Int -> PacketType SecretSubkey -> ShowS
$cshow :: PacketType SecretSubkey -> String
show :: PacketType SecretSubkey -> String
$cshowList :: [PacketType SecretSubkey] -> ShowS
showList :: [PacketType SecretSubkey] -> ShowS
Show, PacketType SecretSubkey -> PacketType SecretSubkey -> Bool
(PacketType SecretSubkey -> PacketType SecretSubkey -> Bool)
-> (PacketType SecretSubkey -> PacketType SecretSubkey -> Bool)
-> Eq (PacketType SecretSubkey)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PacketType SecretSubkey -> PacketType SecretSubkey -> Bool
== :: PacketType SecretSubkey -> PacketType SecretSubkey -> Bool
$c/= :: PacketType SecretSubkey -> PacketType SecretSubkey -> Bool
/= :: PacketType SecretSubkey -> PacketType SecretSubkey -> Bool
Eq)
packetType :: SecretSubkey -> PacketType SecretSubkey
packetType SecretSubkey
_ = PacketType SecretSubkey
SecretSubkeyType
packetCode :: PacketType SecretSubkey -> PacketVersion
packetCode PacketType SecretSubkey
_ = PacketVersion
7
toPkt :: SecretSubkey -> Pkt
toPkt (SecretSubkey PKPayload
a SKAddendum
b) = PKPayload -> SKAddendum -> Pkt
SecretSubkeyPkt PKPayload
a SKAddendum
b
fromPkt :: Pkt -> SecretSubkey
fromPkt (SecretSubkeyPkt PKPayload
a SKAddendum
b) = PKPayload -> SKAddendum -> SecretSubkey
SecretSubkey PKPayload
a SKAddendum
b
fromPkt Pkt
_ = String -> SecretSubkey
forall a. HasCallStack => String -> a
error String
"Cannot coerce non-SecretSubkey packet"
instance Pretty SecretSubkey where
pretty :: forall ann. SecretSubkey -> Doc ann
pretty = Pkt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Pkt -> Doc ann
pretty (Pkt -> Doc ann)
-> (SecretSubkey -> Pkt) -> SecretSubkey -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecretSubkey -> Pkt
forall a. Packet a => a -> Pkt
toPkt
data CompressedData =
CompressedData
{ CompressedData -> CompressionAlgorithm
_compressedDataCompressionAlgorithm :: CompressionAlgorithm
, CompressedData -> ByteString
_compressedDataPayload :: CompressedDataPayload
}
deriving (Typeable CompressedData
Typeable CompressedData
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CompressedData -> c CompressedData)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CompressedData)
-> (CompressedData -> Constr)
-> (CompressedData -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CompressedData))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CompressedData))
-> ((forall b. Data b => b -> b)
-> CompressedData -> CompressedData)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CompressedData -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CompressedData -> r)
-> (forall u.
(forall d. Data d => d -> u) -> CompressedData -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> CompressedData -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CompressedData -> m CompressedData)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CompressedData -> m CompressedData)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CompressedData -> m CompressedData)
-> Data CompressedData
CompressedData -> Constr
CompressedData -> DataType
(forall b. Data b => b -> b) -> CompressedData -> CompressedData
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> CompressedData -> u
forall u. (forall d. Data d => d -> u) -> CompressedData -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CompressedData -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CompressedData -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CompressedData -> m CompressedData
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CompressedData -> m CompressedData
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CompressedData
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CompressedData -> c CompressedData
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CompressedData)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CompressedData)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CompressedData -> c CompressedData
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CompressedData -> c CompressedData
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CompressedData
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CompressedData
$ctoConstr :: CompressedData -> Constr
toConstr :: CompressedData -> Constr
$cdataTypeOf :: CompressedData -> DataType
dataTypeOf :: CompressedData -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CompressedData)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CompressedData)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CompressedData)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CompressedData)
$cgmapT :: (forall b. Data b => b -> b) -> CompressedData -> CompressedData
gmapT :: (forall b. Data b => b -> b) -> CompressedData -> CompressedData
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CompressedData -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CompressedData -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CompressedData -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CompressedData -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CompressedData -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> CompressedData -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CompressedData -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CompressedData -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CompressedData -> m CompressedData
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CompressedData -> m CompressedData
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CompressedData -> m CompressedData
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CompressedData -> m CompressedData
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CompressedData -> m CompressedData
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CompressedData -> m CompressedData
Data, CompressedData -> CompressedData -> Bool
(CompressedData -> CompressedData -> Bool)
-> (CompressedData -> CompressedData -> Bool) -> Eq CompressedData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompressedData -> CompressedData -> Bool
== :: CompressedData -> CompressedData -> Bool
$c/= :: CompressedData -> CompressedData -> Bool
/= :: CompressedData -> CompressedData -> Bool
Eq, Int -> CompressedData -> ShowS
[CompressedData] -> ShowS
CompressedData -> String
(Int -> CompressedData -> ShowS)
-> (CompressedData -> String)
-> ([CompressedData] -> ShowS)
-> Show CompressedData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompressedData -> ShowS
showsPrec :: Int -> CompressedData -> ShowS
$cshow :: CompressedData -> String
show :: CompressedData -> String
$cshowList :: [CompressedData] -> ShowS
showList :: [CompressedData] -> ShowS
Show, Typeable)
instance Packet CompressedData where
data PacketType CompressedData = CompressedDataType
deriving (Int -> PacketType CompressedData -> ShowS
[PacketType CompressedData] -> ShowS
PacketType CompressedData -> String
(Int -> PacketType CompressedData -> ShowS)
-> (PacketType CompressedData -> String)
-> ([PacketType CompressedData] -> ShowS)
-> Show (PacketType CompressedData)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PacketType CompressedData -> ShowS
showsPrec :: Int -> PacketType CompressedData -> ShowS
$cshow :: PacketType CompressedData -> String
show :: PacketType CompressedData -> String
$cshowList :: [PacketType CompressedData] -> ShowS
showList :: [PacketType CompressedData] -> ShowS
Show, PacketType CompressedData -> PacketType CompressedData -> Bool
(PacketType CompressedData -> PacketType CompressedData -> Bool)
-> (PacketType CompressedData -> PacketType CompressedData -> Bool)
-> Eq (PacketType CompressedData)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PacketType CompressedData -> PacketType CompressedData -> Bool
== :: PacketType CompressedData -> PacketType CompressedData -> Bool
$c/= :: PacketType CompressedData -> PacketType CompressedData -> Bool
/= :: PacketType CompressedData -> PacketType CompressedData -> Bool
Eq)
packetType :: CompressedData -> PacketType CompressedData
packetType CompressedData
_ = PacketType CompressedData
CompressedDataType
packetCode :: PacketType CompressedData -> PacketVersion
packetCode PacketType CompressedData
_ = PacketVersion
8
toPkt :: CompressedData -> Pkt
toPkt (CompressedData CompressionAlgorithm
a ByteString
b) = CompressionAlgorithm -> ByteString -> Pkt
CompressedDataPkt CompressionAlgorithm
a ByteString
b
fromPkt :: Pkt -> CompressedData
fromPkt (CompressedDataPkt CompressionAlgorithm
a ByteString
b) = CompressionAlgorithm -> ByteString -> CompressedData
CompressedData CompressionAlgorithm
a ByteString
b
fromPkt Pkt
_ = String -> CompressedData
forall a. HasCallStack => String -> a
error String
"Cannot coerce non-CompressedData packet"
instance Pretty CompressedData where
pretty :: forall ann. CompressedData -> Doc ann
pretty = Pkt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Pkt -> Doc ann
pretty (Pkt -> Doc ann)
-> (CompressedData -> Pkt) -> CompressedData -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompressedData -> Pkt
forall a. Packet a => a -> Pkt
toPkt
newtype SymEncData =
SymEncData
{ SymEncData -> ByteString
_symEncDataPayload :: ByteString
}
deriving (Typeable SymEncData
Typeable SymEncData
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SymEncData -> c SymEncData)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SymEncData)
-> (SymEncData -> Constr)
-> (SymEncData -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SymEncData))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SymEncData))
-> ((forall b. Data b => b -> b) -> SymEncData -> SymEncData)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SymEncData -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SymEncData -> r)
-> (forall u. (forall d. Data d => d -> u) -> SymEncData -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> SymEncData -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SymEncData -> m SymEncData)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SymEncData -> m SymEncData)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SymEncData -> m SymEncData)
-> Data SymEncData
SymEncData -> Constr
SymEncData -> DataType
(forall b. Data b => b -> b) -> SymEncData -> SymEncData
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SymEncData -> u
forall u. (forall d. Data d => d -> u) -> SymEncData -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SymEncData -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SymEncData -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SymEncData -> m SymEncData
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SymEncData -> m SymEncData
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SymEncData
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SymEncData -> c SymEncData
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SymEncData)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SymEncData)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SymEncData -> c SymEncData
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SymEncData -> c SymEncData
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SymEncData
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SymEncData
$ctoConstr :: SymEncData -> Constr
toConstr :: SymEncData -> Constr
$cdataTypeOf :: SymEncData -> DataType
dataTypeOf :: SymEncData -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SymEncData)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SymEncData)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SymEncData)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SymEncData)
$cgmapT :: (forall b. Data b => b -> b) -> SymEncData -> SymEncData
gmapT :: (forall b. Data b => b -> b) -> SymEncData -> SymEncData
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SymEncData -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SymEncData -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SymEncData -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SymEncData -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SymEncData -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> SymEncData -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SymEncData -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SymEncData -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SymEncData -> m SymEncData
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SymEncData -> m SymEncData
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SymEncData -> m SymEncData
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SymEncData -> m SymEncData
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SymEncData -> m SymEncData
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SymEncData -> m SymEncData
Data, SymEncData -> SymEncData -> Bool
(SymEncData -> SymEncData -> Bool)
-> (SymEncData -> SymEncData -> Bool) -> Eq SymEncData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SymEncData -> SymEncData -> Bool
== :: SymEncData -> SymEncData -> Bool
$c/= :: SymEncData -> SymEncData -> Bool
/= :: SymEncData -> SymEncData -> Bool
Eq, Int -> SymEncData -> ShowS
[SymEncData] -> ShowS
SymEncData -> String
(Int -> SymEncData -> ShowS)
-> (SymEncData -> String)
-> ([SymEncData] -> ShowS)
-> Show SymEncData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SymEncData -> ShowS
showsPrec :: Int -> SymEncData -> ShowS
$cshow :: SymEncData -> String
show :: SymEncData -> String
$cshowList :: [SymEncData] -> ShowS
showList :: [SymEncData] -> ShowS
Show, Typeable)
instance Packet SymEncData where
data PacketType SymEncData = SymEncDataType
deriving (Int -> PacketType SymEncData -> ShowS
[PacketType SymEncData] -> ShowS
PacketType SymEncData -> String
(Int -> PacketType SymEncData -> ShowS)
-> (PacketType SymEncData -> String)
-> ([PacketType SymEncData] -> ShowS)
-> Show (PacketType SymEncData)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PacketType SymEncData -> ShowS
showsPrec :: Int -> PacketType SymEncData -> ShowS
$cshow :: PacketType SymEncData -> String
show :: PacketType SymEncData -> String
$cshowList :: [PacketType SymEncData] -> ShowS
showList :: [PacketType SymEncData] -> ShowS
Show, PacketType SymEncData -> PacketType SymEncData -> Bool
(PacketType SymEncData -> PacketType SymEncData -> Bool)
-> (PacketType SymEncData -> PacketType SymEncData -> Bool)
-> Eq (PacketType SymEncData)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PacketType SymEncData -> PacketType SymEncData -> Bool
== :: PacketType SymEncData -> PacketType SymEncData -> Bool
$c/= :: PacketType SymEncData -> PacketType SymEncData -> Bool
/= :: PacketType SymEncData -> PacketType SymEncData -> Bool
Eq)
packetType :: SymEncData -> PacketType SymEncData
packetType SymEncData
_ = PacketType SymEncData
SymEncDataType
packetCode :: PacketType SymEncData -> PacketVersion
packetCode PacketType SymEncData
_ = PacketVersion
9
toPkt :: SymEncData -> Pkt
toPkt (SymEncData ByteString
a) = ByteString -> Pkt
SymEncDataPkt ByteString
a
fromPkt :: Pkt -> SymEncData
fromPkt (SymEncDataPkt ByteString
a) = ByteString -> SymEncData
SymEncData ByteString
a
fromPkt Pkt
_ = String -> SymEncData
forall a. HasCallStack => String -> a
error String
"Cannot coerce non-SymEncData packet"
instance Pretty SymEncData where
pretty :: forall ann. SymEncData -> Doc ann
pretty = Pkt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Pkt -> Doc ann
pretty (Pkt -> Doc ann) -> (SymEncData -> Pkt) -> SymEncData -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SymEncData -> Pkt
forall a. Packet a => a -> Pkt
toPkt
newtype Marker =
Marker
{ Marker -> ByteString
_markerPayload :: ByteString
}
deriving (Typeable Marker
Typeable Marker
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Marker -> c Marker)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Marker)
-> (Marker -> Constr)
-> (Marker -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Marker))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Marker))
-> ((forall b. Data b => b -> b) -> Marker -> Marker)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Marker -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Marker -> r)
-> (forall u. (forall d. Data d => d -> u) -> Marker -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Marker -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Marker -> m Marker)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Marker -> m Marker)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Marker -> m Marker)
-> Data Marker
Marker -> Constr
Marker -> DataType
(forall b. Data b => b -> b) -> Marker -> Marker
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Marker -> u
forall u. (forall d. Data d => d -> u) -> Marker -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Marker -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Marker -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Marker -> m Marker
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Marker -> m Marker
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Marker
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Marker -> c Marker
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Marker)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Marker)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Marker -> c Marker
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Marker -> c Marker
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Marker
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Marker
$ctoConstr :: Marker -> Constr
toConstr :: Marker -> Constr
$cdataTypeOf :: Marker -> DataType
dataTypeOf :: Marker -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Marker)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Marker)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Marker)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Marker)
$cgmapT :: (forall b. Data b => b -> b) -> Marker -> Marker
gmapT :: (forall b. Data b => b -> b) -> Marker -> Marker
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Marker -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Marker -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Marker -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Marker -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Marker -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Marker -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Marker -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Marker -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Marker -> m Marker
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Marker -> m Marker
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Marker -> m Marker
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Marker -> m Marker
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Marker -> m Marker
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Marker -> m Marker
Data, Marker -> Marker -> Bool
(Marker -> Marker -> Bool)
-> (Marker -> Marker -> Bool) -> Eq Marker
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Marker -> Marker -> Bool
== :: Marker -> Marker -> Bool
$c/= :: Marker -> Marker -> Bool
/= :: Marker -> Marker -> Bool
Eq, Int -> Marker -> ShowS
[Marker] -> ShowS
Marker -> String
(Int -> Marker -> ShowS)
-> (Marker -> String) -> ([Marker] -> ShowS) -> Show Marker
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Marker -> ShowS
showsPrec :: Int -> Marker -> ShowS
$cshow :: Marker -> String
show :: Marker -> String
$cshowList :: [Marker] -> ShowS
showList :: [Marker] -> ShowS
Show, Typeable)
instance Packet Marker where
data PacketType Marker = MarkerType
deriving (Int -> PacketType Marker -> ShowS
[PacketType Marker] -> ShowS
PacketType Marker -> String
(Int -> PacketType Marker -> ShowS)
-> (PacketType Marker -> String)
-> ([PacketType Marker] -> ShowS)
-> Show (PacketType Marker)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PacketType Marker -> ShowS
showsPrec :: Int -> PacketType Marker -> ShowS
$cshow :: PacketType Marker -> String
show :: PacketType Marker -> String
$cshowList :: [PacketType Marker] -> ShowS
showList :: [PacketType Marker] -> ShowS
Show, PacketType Marker -> PacketType Marker -> Bool
(PacketType Marker -> PacketType Marker -> Bool)
-> (PacketType Marker -> PacketType Marker -> Bool)
-> Eq (PacketType Marker)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PacketType Marker -> PacketType Marker -> Bool
== :: PacketType Marker -> PacketType Marker -> Bool
$c/= :: PacketType Marker -> PacketType Marker -> Bool
/= :: PacketType Marker -> PacketType Marker -> Bool
Eq)
packetType :: Marker -> PacketType Marker
packetType Marker
_ = PacketType Marker
MarkerType
packetCode :: PacketType Marker -> PacketVersion
packetCode PacketType Marker
_ = PacketVersion
10
toPkt :: Marker -> Pkt
toPkt (Marker ByteString
a) = ByteString -> Pkt
MarkerPkt ByteString
a
fromPkt :: Pkt -> Marker
fromPkt (MarkerPkt ByteString
a) = ByteString -> Marker
Marker ByteString
a
fromPkt Pkt
_ = String -> Marker
forall a. HasCallStack => String -> a
error String
"Cannot coerce non-Marker packet"
instance Pretty Marker where
pretty :: forall ann. Marker -> Doc ann
pretty = Pkt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Pkt -> Doc ann
pretty (Pkt -> Doc ann) -> (Marker -> Pkt) -> Marker -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Marker -> Pkt
forall a. Packet a => a -> Pkt
toPkt
data LiteralData =
LiteralData
{ LiteralData -> DataType
_literalDataDataType :: DataType
, LiteralData -> ByteString
_literalDataFileName :: FileName
, LiteralData -> ThirtyTwoBitTimeStamp
_literalDataTimeStamp :: ThirtyTwoBitTimeStamp
, LiteralData -> ByteString
_literalDataPayload :: ByteString
}
deriving (Typeable LiteralData
Typeable LiteralData
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LiteralData -> c LiteralData)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LiteralData)
-> (LiteralData -> Constr)
-> (LiteralData -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LiteralData))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c LiteralData))
-> ((forall b. Data b => b -> b) -> LiteralData -> LiteralData)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LiteralData -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LiteralData -> r)
-> (forall u. (forall d. Data d => d -> u) -> LiteralData -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> LiteralData -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LiteralData -> m LiteralData)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LiteralData -> m LiteralData)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LiteralData -> m LiteralData)
-> Data LiteralData
LiteralData -> Constr
LiteralData -> DataType
(forall b. Data b => b -> b) -> LiteralData -> LiteralData
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> LiteralData -> u
forall u. (forall d. Data d => d -> u) -> LiteralData -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LiteralData -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LiteralData -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LiteralData -> m LiteralData
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LiteralData -> m LiteralData
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LiteralData
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LiteralData -> c LiteralData
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LiteralData)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c LiteralData)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LiteralData -> c LiteralData
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LiteralData -> c LiteralData
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LiteralData
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LiteralData
$ctoConstr :: LiteralData -> Constr
toConstr :: LiteralData -> Constr
$cdataTypeOf :: LiteralData -> DataType
dataTypeOf :: LiteralData -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LiteralData)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LiteralData)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c LiteralData)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c LiteralData)
$cgmapT :: (forall b. Data b => b -> b) -> LiteralData -> LiteralData
gmapT :: (forall b. Data b => b -> b) -> LiteralData -> LiteralData
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LiteralData -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LiteralData -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LiteralData -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LiteralData -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> LiteralData -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> LiteralData -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> LiteralData -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> LiteralData -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LiteralData -> m LiteralData
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LiteralData -> m LiteralData
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LiteralData -> m LiteralData
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LiteralData -> m LiteralData
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LiteralData -> m LiteralData
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LiteralData -> m LiteralData
Data, LiteralData -> LiteralData -> Bool
(LiteralData -> LiteralData -> Bool)
-> (LiteralData -> LiteralData -> Bool) -> Eq LiteralData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LiteralData -> LiteralData -> Bool
== :: LiteralData -> LiteralData -> Bool
$c/= :: LiteralData -> LiteralData -> Bool
/= :: LiteralData -> LiteralData -> Bool
Eq, Int -> LiteralData -> ShowS
[LiteralData] -> ShowS
LiteralData -> String
(Int -> LiteralData -> ShowS)
-> (LiteralData -> String)
-> ([LiteralData] -> ShowS)
-> Show LiteralData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LiteralData -> ShowS
showsPrec :: Int -> LiteralData -> ShowS
$cshow :: LiteralData -> String
show :: LiteralData -> String
$cshowList :: [LiteralData] -> ShowS
showList :: [LiteralData] -> ShowS
Show, Typeable)
instance Packet LiteralData where
data PacketType LiteralData = LiteralDataType
deriving (Int -> PacketType LiteralData -> ShowS
[PacketType LiteralData] -> ShowS
PacketType LiteralData -> String
(Int -> PacketType LiteralData -> ShowS)
-> (PacketType LiteralData -> String)
-> ([PacketType LiteralData] -> ShowS)
-> Show (PacketType LiteralData)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PacketType LiteralData -> ShowS
showsPrec :: Int -> PacketType LiteralData -> ShowS
$cshow :: PacketType LiteralData -> String
show :: PacketType LiteralData -> String
$cshowList :: [PacketType LiteralData] -> ShowS
showList :: [PacketType LiteralData] -> ShowS
Show, PacketType LiteralData -> PacketType LiteralData -> Bool
(PacketType LiteralData -> PacketType LiteralData -> Bool)
-> (PacketType LiteralData -> PacketType LiteralData -> Bool)
-> Eq (PacketType LiteralData)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PacketType LiteralData -> PacketType LiteralData -> Bool
== :: PacketType LiteralData -> PacketType LiteralData -> Bool
$c/= :: PacketType LiteralData -> PacketType LiteralData -> Bool
/= :: PacketType LiteralData -> PacketType LiteralData -> Bool
Eq)
packetType :: LiteralData -> PacketType LiteralData
packetType LiteralData
_ = PacketType LiteralData
LiteralDataType
packetCode :: PacketType LiteralData -> PacketVersion
packetCode PacketType LiteralData
_ = PacketVersion
11
toPkt :: LiteralData -> Pkt
toPkt (LiteralData DataType
a ByteString
b ThirtyTwoBitTimeStamp
c ByteString
d) = DataType
-> ByteString -> ThirtyTwoBitTimeStamp -> ByteString -> Pkt
LiteralDataPkt DataType
a ByteString
b ThirtyTwoBitTimeStamp
c ByteString
d
fromPkt :: Pkt -> LiteralData
fromPkt (LiteralDataPkt DataType
a ByteString
b ThirtyTwoBitTimeStamp
c ByteString
d) = DataType
-> ByteString -> ThirtyTwoBitTimeStamp -> ByteString -> LiteralData
LiteralData DataType
a ByteString
b ThirtyTwoBitTimeStamp
c ByteString
d
fromPkt Pkt
_ = String -> LiteralData
forall a. HasCallStack => String -> a
error String
"Cannot coerce non-LiteralData packet"
instance Pretty LiteralData where
pretty :: forall ann. LiteralData -> Doc ann
pretty = Pkt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Pkt -> Doc ann
pretty (Pkt -> Doc ann) -> (LiteralData -> Pkt) -> LiteralData -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LiteralData -> Pkt
forall a. Packet a => a -> Pkt
toPkt
newtype Trust =
Trust
{ Trust -> ByteString
_trustPayload :: ByteString
}
deriving (Typeable Trust
Typeable Trust
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Trust -> c Trust)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Trust)
-> (Trust -> Constr)
-> (Trust -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Trust))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Trust))
-> ((forall b. Data b => b -> b) -> Trust -> Trust)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Trust -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Trust -> r)
-> (forall u. (forall d. Data d => d -> u) -> Trust -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Trust -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Trust -> m Trust)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Trust -> m Trust)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Trust -> m Trust)
-> Data Trust
Trust -> Constr
Trust -> DataType
(forall b. Data b => b -> b) -> Trust -> Trust
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Trust -> u
forall u. (forall d. Data d => d -> u) -> Trust -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Trust -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Trust -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Trust -> m Trust
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Trust -> m Trust
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Trust
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Trust -> c Trust
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Trust)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Trust)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Trust -> c Trust
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Trust -> c Trust
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Trust
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Trust
$ctoConstr :: Trust -> Constr
toConstr :: Trust -> Constr
$cdataTypeOf :: Trust -> DataType
dataTypeOf :: Trust -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Trust)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Trust)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Trust)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Trust)
$cgmapT :: (forall b. Data b => b -> b) -> Trust -> Trust
gmapT :: (forall b. Data b => b -> b) -> Trust -> Trust
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Trust -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Trust -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Trust -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Trust -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Trust -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Trust -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Trust -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Trust -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Trust -> m Trust
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Trust -> m Trust
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Trust -> m Trust
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Trust -> m Trust
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Trust -> m Trust
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Trust -> m Trust
Data, Trust -> Trust -> Bool
(Trust -> Trust -> Bool) -> (Trust -> Trust -> Bool) -> Eq Trust
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Trust -> Trust -> Bool
== :: Trust -> Trust -> Bool
$c/= :: Trust -> Trust -> Bool
/= :: Trust -> Trust -> Bool
Eq, Int -> Trust -> ShowS
[Trust] -> ShowS
Trust -> String
(Int -> Trust -> ShowS)
-> (Trust -> String) -> ([Trust] -> ShowS) -> Show Trust
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Trust -> ShowS
showsPrec :: Int -> Trust -> ShowS
$cshow :: Trust -> String
show :: Trust -> String
$cshowList :: [Trust] -> ShowS
showList :: [Trust] -> ShowS
Show, Typeable)
instance Packet Trust where
data PacketType Trust = TrustType
deriving (Int -> PacketType Trust -> ShowS
[PacketType Trust] -> ShowS
PacketType Trust -> String
(Int -> PacketType Trust -> ShowS)
-> (PacketType Trust -> String)
-> ([PacketType Trust] -> ShowS)
-> Show (PacketType Trust)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PacketType Trust -> ShowS
showsPrec :: Int -> PacketType Trust -> ShowS
$cshow :: PacketType Trust -> String
show :: PacketType Trust -> String
$cshowList :: [PacketType Trust] -> ShowS
showList :: [PacketType Trust] -> ShowS
Show, PacketType Trust -> PacketType Trust -> Bool
(PacketType Trust -> PacketType Trust -> Bool)
-> (PacketType Trust -> PacketType Trust -> Bool)
-> Eq (PacketType Trust)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PacketType Trust -> PacketType Trust -> Bool
== :: PacketType Trust -> PacketType Trust -> Bool
$c/= :: PacketType Trust -> PacketType Trust -> Bool
/= :: PacketType Trust -> PacketType Trust -> Bool
Eq)
packetType :: Trust -> PacketType Trust
packetType Trust
_ = PacketType Trust
TrustType
packetCode :: PacketType Trust -> PacketVersion
packetCode PacketType Trust
_ = PacketVersion
12
toPkt :: Trust -> Pkt
toPkt (Trust ByteString
a) = ByteString -> Pkt
TrustPkt ByteString
a
fromPkt :: Pkt -> Trust
fromPkt (TrustPkt ByteString
a) = ByteString -> Trust
Trust ByteString
a
fromPkt Pkt
_ = String -> Trust
forall a. HasCallStack => String -> a
error String
"Cannot coerce non-Trust packet"
instance Pretty Trust where
pretty :: forall ann. Trust -> Doc ann
pretty = Pkt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Pkt -> Doc ann
pretty (Pkt -> Doc ann) -> (Trust -> Pkt) -> Trust -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trust -> Pkt
forall a. Packet a => a -> Pkt
toPkt
newtype UserId =
UserId
{ UserId -> Text
_userIdPayload :: Text
}
deriving (Typeable UserId
Typeable UserId
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UserId -> c UserId)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UserId)
-> (UserId -> Constr)
-> (UserId -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UserId))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UserId))
-> ((forall b. Data b => b -> b) -> UserId -> UserId)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UserId -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UserId -> r)
-> (forall u. (forall d. Data d => d -> u) -> UserId -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> UserId -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UserId -> m UserId)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UserId -> m UserId)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UserId -> m UserId)
-> Data UserId
UserId -> Constr
UserId -> DataType
(forall b. Data b => b -> b) -> UserId -> UserId
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> UserId -> u
forall u. (forall d. Data d => d -> u) -> UserId -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UserId -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UserId -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UserId -> m UserId
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UserId -> m UserId
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UserId
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UserId -> c UserId
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UserId)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UserId)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UserId -> c UserId
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UserId -> c UserId
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UserId
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UserId
$ctoConstr :: UserId -> Constr
toConstr :: UserId -> Constr
$cdataTypeOf :: UserId -> DataType
dataTypeOf :: UserId -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UserId)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UserId)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UserId)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UserId)
$cgmapT :: (forall b. Data b => b -> b) -> UserId -> UserId
gmapT :: (forall b. Data b => b -> b) -> UserId -> UserId
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UserId -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UserId -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UserId -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UserId -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> UserId -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> UserId -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UserId -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UserId -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UserId -> m UserId
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UserId -> m UserId
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UserId -> m UserId
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UserId -> m UserId
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UserId -> m UserId
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UserId -> m UserId
Data, UserId -> UserId -> Bool
(UserId -> UserId -> Bool)
-> (UserId -> UserId -> Bool) -> Eq UserId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserId -> UserId -> Bool
== :: UserId -> UserId -> Bool
$c/= :: UserId -> UserId -> Bool
/= :: UserId -> UserId -> Bool
Eq, Int -> UserId -> ShowS
[UserId] -> ShowS
UserId -> String
(Int -> UserId -> ShowS)
-> (UserId -> String) -> ([UserId] -> ShowS) -> Show UserId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserId -> ShowS
showsPrec :: Int -> UserId -> ShowS
$cshow :: UserId -> String
show :: UserId -> String
$cshowList :: [UserId] -> ShowS
showList :: [UserId] -> ShowS
Show, Typeable)
instance Packet UserId where
data PacketType UserId = UserIdType
deriving (Int -> PacketType UserId -> ShowS
[PacketType UserId] -> ShowS
PacketType UserId -> String
(Int -> PacketType UserId -> ShowS)
-> (PacketType UserId -> String)
-> ([PacketType UserId] -> ShowS)
-> Show (PacketType UserId)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PacketType UserId -> ShowS
showsPrec :: Int -> PacketType UserId -> ShowS
$cshow :: PacketType UserId -> String
show :: PacketType UserId -> String
$cshowList :: [PacketType UserId] -> ShowS
showList :: [PacketType UserId] -> ShowS
Show, PacketType UserId -> PacketType UserId -> Bool
(PacketType UserId -> PacketType UserId -> Bool)
-> (PacketType UserId -> PacketType UserId -> Bool)
-> Eq (PacketType UserId)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PacketType UserId -> PacketType UserId -> Bool
== :: PacketType UserId -> PacketType UserId -> Bool
$c/= :: PacketType UserId -> PacketType UserId -> Bool
/= :: PacketType UserId -> PacketType UserId -> Bool
Eq)
packetType :: UserId -> PacketType UserId
packetType UserId
_ = PacketType UserId
UserIdType
packetCode :: PacketType UserId -> PacketVersion
packetCode PacketType UserId
_ = PacketVersion
13
toPkt :: UserId -> Pkt
toPkt (UserId Text
a) = Text -> Pkt
UserIdPkt Text
a
fromPkt :: Pkt -> UserId
fromPkt (UserIdPkt Text
a) = Text -> UserId
UserId Text
a
fromPkt Pkt
_ = String -> UserId
forall a. HasCallStack => String -> a
error String
"Cannot coerce non-UserId packet"
instance Pretty UserId where
pretty :: forall ann. UserId -> Doc ann
pretty = Pkt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Pkt -> Doc ann
pretty (Pkt -> Doc ann) -> (UserId -> Pkt) -> UserId -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserId -> Pkt
forall a. Packet a => a -> Pkt
toPkt
newtype PublicSubkey =
PublicSubkey
{ PublicSubkey -> PKPayload
_publicSubkeyPKPayload :: PKPayload
}
deriving (Typeable PublicSubkey
Typeable PublicSubkey
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PublicSubkey -> c PublicSubkey)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PublicSubkey)
-> (PublicSubkey -> Constr)
-> (PublicSubkey -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PublicSubkey))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PublicSubkey))
-> ((forall b. Data b => b -> b) -> PublicSubkey -> PublicSubkey)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PublicSubkey -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PublicSubkey -> r)
-> (forall u. (forall d. Data d => d -> u) -> PublicSubkey -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> PublicSubkey -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PublicSubkey -> m PublicSubkey)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PublicSubkey -> m PublicSubkey)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PublicSubkey -> m PublicSubkey)
-> Data PublicSubkey
PublicSubkey -> Constr
PublicSubkey -> DataType
(forall b. Data b => b -> b) -> PublicSubkey -> PublicSubkey
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> PublicSubkey -> u
forall u. (forall d. Data d => d -> u) -> PublicSubkey -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PublicSubkey -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PublicSubkey -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PublicSubkey -> m PublicSubkey
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PublicSubkey -> m PublicSubkey
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PublicSubkey
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PublicSubkey -> c PublicSubkey
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PublicSubkey)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PublicSubkey)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PublicSubkey -> c PublicSubkey
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PublicSubkey -> c PublicSubkey
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PublicSubkey
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PublicSubkey
$ctoConstr :: PublicSubkey -> Constr
toConstr :: PublicSubkey -> Constr
$cdataTypeOf :: PublicSubkey -> DataType
dataTypeOf :: PublicSubkey -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PublicSubkey)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PublicSubkey)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PublicSubkey)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PublicSubkey)
$cgmapT :: (forall b. Data b => b -> b) -> PublicSubkey -> PublicSubkey
gmapT :: (forall b. Data b => b -> b) -> PublicSubkey -> PublicSubkey
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PublicSubkey -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PublicSubkey -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PublicSubkey -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PublicSubkey -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PublicSubkey -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> PublicSubkey -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PublicSubkey -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PublicSubkey -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PublicSubkey -> m PublicSubkey
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PublicSubkey -> m PublicSubkey
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PublicSubkey -> m PublicSubkey
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PublicSubkey -> m PublicSubkey
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PublicSubkey -> m PublicSubkey
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PublicSubkey -> m PublicSubkey
Data, PublicSubkey -> PublicSubkey -> Bool
(PublicSubkey -> PublicSubkey -> Bool)
-> (PublicSubkey -> PublicSubkey -> Bool) -> Eq PublicSubkey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PublicSubkey -> PublicSubkey -> Bool
== :: PublicSubkey -> PublicSubkey -> Bool
$c/= :: PublicSubkey -> PublicSubkey -> Bool
/= :: PublicSubkey -> PublicSubkey -> Bool
Eq, Int -> PublicSubkey -> ShowS
[PublicSubkey] -> ShowS
PublicSubkey -> String
(Int -> PublicSubkey -> ShowS)
-> (PublicSubkey -> String)
-> ([PublicSubkey] -> ShowS)
-> Show PublicSubkey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PublicSubkey -> ShowS
showsPrec :: Int -> PublicSubkey -> ShowS
$cshow :: PublicSubkey -> String
show :: PublicSubkey -> String
$cshowList :: [PublicSubkey] -> ShowS
showList :: [PublicSubkey] -> ShowS
Show, Typeable)
instance Packet PublicSubkey where
data PacketType PublicSubkey = PublicSubkeyType
deriving (Int -> PacketType PublicSubkey -> ShowS
[PacketType PublicSubkey] -> ShowS
PacketType PublicSubkey -> String
(Int -> PacketType PublicSubkey -> ShowS)
-> (PacketType PublicSubkey -> String)
-> ([PacketType PublicSubkey] -> ShowS)
-> Show (PacketType PublicSubkey)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PacketType PublicSubkey -> ShowS
showsPrec :: Int -> PacketType PublicSubkey -> ShowS
$cshow :: PacketType PublicSubkey -> String
show :: PacketType PublicSubkey -> String
$cshowList :: [PacketType PublicSubkey] -> ShowS
showList :: [PacketType PublicSubkey] -> ShowS
Show, PacketType PublicSubkey -> PacketType PublicSubkey -> Bool
(PacketType PublicSubkey -> PacketType PublicSubkey -> Bool)
-> (PacketType PublicSubkey -> PacketType PublicSubkey -> Bool)
-> Eq (PacketType PublicSubkey)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PacketType PublicSubkey -> PacketType PublicSubkey -> Bool
== :: PacketType PublicSubkey -> PacketType PublicSubkey -> Bool
$c/= :: PacketType PublicSubkey -> PacketType PublicSubkey -> Bool
/= :: PacketType PublicSubkey -> PacketType PublicSubkey -> Bool
Eq)
packetType :: PublicSubkey -> PacketType PublicSubkey
packetType PublicSubkey
_ = PacketType PublicSubkey
PublicSubkeyType
packetCode :: PacketType PublicSubkey -> PacketVersion
packetCode PacketType PublicSubkey
_ = PacketVersion
14
toPkt :: PublicSubkey -> Pkt
toPkt (PublicSubkey PKPayload
a) = PKPayload -> Pkt
PublicSubkeyPkt PKPayload
a
fromPkt :: Pkt -> PublicSubkey
fromPkt (PublicSubkeyPkt PKPayload
a) = PKPayload -> PublicSubkey
PublicSubkey PKPayload
a
fromPkt Pkt
_ = String -> PublicSubkey
forall a. HasCallStack => String -> a
error String
"Cannot coerce non-PublicSubkey packet"
instance Pretty PublicSubkey where
pretty :: forall ann. PublicSubkey -> Doc ann
pretty = Pkt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Pkt -> Doc ann
pretty (Pkt -> Doc ann)
-> (PublicSubkey -> Pkt) -> PublicSubkey -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicSubkey -> Pkt
forall a. Packet a => a -> Pkt
toPkt
newtype UserAttribute =
UserAttribute
{ UserAttribute -> [UserAttrSubPacket]
_userAttributeSubPackets :: [UserAttrSubPacket]
}
deriving (Typeable UserAttribute
Typeable UserAttribute
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UserAttribute -> c UserAttribute)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UserAttribute)
-> (UserAttribute -> Constr)
-> (UserAttribute -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UserAttribute))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UserAttribute))
-> ((forall b. Data b => b -> b) -> UserAttribute -> UserAttribute)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UserAttribute -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UserAttribute -> r)
-> (forall u. (forall d. Data d => d -> u) -> UserAttribute -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> UserAttribute -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UserAttribute -> m UserAttribute)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UserAttribute -> m UserAttribute)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UserAttribute -> m UserAttribute)
-> Data UserAttribute
UserAttribute -> Constr
UserAttribute -> DataType
(forall b. Data b => b -> b) -> UserAttribute -> UserAttribute
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> UserAttribute -> u
forall u. (forall d. Data d => d -> u) -> UserAttribute -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UserAttribute -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UserAttribute -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UserAttribute -> m UserAttribute
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UserAttribute -> m UserAttribute
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UserAttribute
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UserAttribute -> c UserAttribute
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UserAttribute)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UserAttribute)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UserAttribute -> c UserAttribute
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UserAttribute -> c UserAttribute
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UserAttribute
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UserAttribute
$ctoConstr :: UserAttribute -> Constr
toConstr :: UserAttribute -> Constr
$cdataTypeOf :: UserAttribute -> DataType
dataTypeOf :: UserAttribute -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UserAttribute)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UserAttribute)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UserAttribute)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UserAttribute)
$cgmapT :: (forall b. Data b => b -> b) -> UserAttribute -> UserAttribute
gmapT :: (forall b. Data b => b -> b) -> UserAttribute -> UserAttribute
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UserAttribute -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UserAttribute -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UserAttribute -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UserAttribute -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> UserAttribute -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> UserAttribute -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UserAttribute -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UserAttribute -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UserAttribute -> m UserAttribute
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UserAttribute -> m UserAttribute
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UserAttribute -> m UserAttribute
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UserAttribute -> m UserAttribute
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UserAttribute -> m UserAttribute
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UserAttribute -> m UserAttribute
Data, UserAttribute -> UserAttribute -> Bool
(UserAttribute -> UserAttribute -> Bool)
-> (UserAttribute -> UserAttribute -> Bool) -> Eq UserAttribute
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserAttribute -> UserAttribute -> Bool
== :: UserAttribute -> UserAttribute -> Bool
$c/= :: UserAttribute -> UserAttribute -> Bool
/= :: UserAttribute -> UserAttribute -> Bool
Eq, Int -> UserAttribute -> ShowS
[UserAttribute] -> ShowS
UserAttribute -> String
(Int -> UserAttribute -> ShowS)
-> (UserAttribute -> String)
-> ([UserAttribute] -> ShowS)
-> Show UserAttribute
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserAttribute -> ShowS
showsPrec :: Int -> UserAttribute -> ShowS
$cshow :: UserAttribute -> String
show :: UserAttribute -> String
$cshowList :: [UserAttribute] -> ShowS
showList :: [UserAttribute] -> ShowS
Show, Typeable)
instance Packet UserAttribute where
data PacketType UserAttribute = UserAttributeType
deriving (Int -> PacketType UserAttribute -> ShowS
[PacketType UserAttribute] -> ShowS
PacketType UserAttribute -> String
(Int -> PacketType UserAttribute -> ShowS)
-> (PacketType UserAttribute -> String)
-> ([PacketType UserAttribute] -> ShowS)
-> Show (PacketType UserAttribute)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PacketType UserAttribute -> ShowS
showsPrec :: Int -> PacketType UserAttribute -> ShowS
$cshow :: PacketType UserAttribute -> String
show :: PacketType UserAttribute -> String
$cshowList :: [PacketType UserAttribute] -> ShowS
showList :: [PacketType UserAttribute] -> ShowS
Show, PacketType UserAttribute -> PacketType UserAttribute -> Bool
(PacketType UserAttribute -> PacketType UserAttribute -> Bool)
-> (PacketType UserAttribute -> PacketType UserAttribute -> Bool)
-> Eq (PacketType UserAttribute)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PacketType UserAttribute -> PacketType UserAttribute -> Bool
== :: PacketType UserAttribute -> PacketType UserAttribute -> Bool
$c/= :: PacketType UserAttribute -> PacketType UserAttribute -> Bool
/= :: PacketType UserAttribute -> PacketType UserAttribute -> Bool
Eq)
packetType :: UserAttribute -> PacketType UserAttribute
packetType UserAttribute
_ = PacketType UserAttribute
UserAttributeType
packetCode :: PacketType UserAttribute -> PacketVersion
packetCode PacketType UserAttribute
_ = PacketVersion
17
toPkt :: UserAttribute -> Pkt
toPkt (UserAttribute [UserAttrSubPacket]
a) = [UserAttrSubPacket] -> Pkt
UserAttributePkt [UserAttrSubPacket]
a
fromPkt :: Pkt -> UserAttribute
fromPkt (UserAttributePkt [UserAttrSubPacket]
a) = [UserAttrSubPacket] -> UserAttribute
UserAttribute [UserAttrSubPacket]
a
fromPkt Pkt
_ = String -> UserAttribute
forall a. HasCallStack => String -> a
error String
"Cannot coerce non-UserAttribute packet"
instance Pretty UserAttribute where
pretty :: forall ann. UserAttribute -> Doc ann
pretty = Pkt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Pkt -> Doc ann
pretty (Pkt -> Doc ann)
-> (UserAttribute -> Pkt) -> UserAttribute -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserAttribute -> Pkt
forall a. Packet a => a -> Pkt
toPkt
data SymEncIntegrityProtectedData =
SymEncIntegrityProtectedData
{ SymEncIntegrityProtectedData -> PacketVersion
_symEncIntegrityProtectedDataPacketVersion :: PacketVersion
, SymEncIntegrityProtectedData -> ByteString
_symEncIntegrityProtectedDataPayload :: ByteString
}
deriving (Typeable SymEncIntegrityProtectedData
Typeable SymEncIntegrityProtectedData
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SymEncIntegrityProtectedData
-> c SymEncIntegrityProtectedData)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c SymEncIntegrityProtectedData)
-> (SymEncIntegrityProtectedData -> Constr)
-> (SymEncIntegrityProtectedData -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c SymEncIntegrityProtectedData))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SymEncIntegrityProtectedData))
-> ((forall b. Data b => b -> b)
-> SymEncIntegrityProtectedData -> SymEncIntegrityProtectedData)
-> (forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> SymEncIntegrityProtectedData
-> r)
-> (forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> SymEncIntegrityProtectedData
-> r)
-> (forall u.
(forall d. Data d => d -> u)
-> SymEncIntegrityProtectedData -> [u])
-> (forall u.
Int
-> (forall d. Data d => d -> u)
-> SymEncIntegrityProtectedData
-> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SymEncIntegrityProtectedData -> m SymEncIntegrityProtectedData)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SymEncIntegrityProtectedData -> m SymEncIntegrityProtectedData)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SymEncIntegrityProtectedData -> m SymEncIntegrityProtectedData)
-> Data SymEncIntegrityProtectedData
SymEncIntegrityProtectedData -> Constr
SymEncIntegrityProtectedData -> DataType
(forall b. Data b => b -> b)
-> SymEncIntegrityProtectedData -> SymEncIntegrityProtectedData
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> SymEncIntegrityProtectedData
-> u
forall u.
(forall d. Data d => d -> u) -> SymEncIntegrityProtectedData -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> SymEncIntegrityProtectedData
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> SymEncIntegrityProtectedData
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SymEncIntegrityProtectedData -> m SymEncIntegrityProtectedData
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SymEncIntegrityProtectedData -> m SymEncIntegrityProtectedData
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SymEncIntegrityProtectedData
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SymEncIntegrityProtectedData
-> c SymEncIntegrityProtectedData
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c SymEncIntegrityProtectedData)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SymEncIntegrityProtectedData)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SymEncIntegrityProtectedData
-> c SymEncIntegrityProtectedData
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SymEncIntegrityProtectedData
-> c SymEncIntegrityProtectedData
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SymEncIntegrityProtectedData
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SymEncIntegrityProtectedData
$ctoConstr :: SymEncIntegrityProtectedData -> Constr
toConstr :: SymEncIntegrityProtectedData -> Constr
$cdataTypeOf :: SymEncIntegrityProtectedData -> DataType
dataTypeOf :: SymEncIntegrityProtectedData -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c SymEncIntegrityProtectedData)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c SymEncIntegrityProtectedData)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SymEncIntegrityProtectedData)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SymEncIntegrityProtectedData)
$cgmapT :: (forall b. Data b => b -> b)
-> SymEncIntegrityProtectedData -> SymEncIntegrityProtectedData
gmapT :: (forall b. Data b => b -> b)
-> SymEncIntegrityProtectedData -> SymEncIntegrityProtectedData
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> SymEncIntegrityProtectedData
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> SymEncIntegrityProtectedData
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> SymEncIntegrityProtectedData
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> SymEncIntegrityProtectedData
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> SymEncIntegrityProtectedData -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> SymEncIntegrityProtectedData -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> SymEncIntegrityProtectedData
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> SymEncIntegrityProtectedData
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SymEncIntegrityProtectedData -> m SymEncIntegrityProtectedData
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SymEncIntegrityProtectedData -> m SymEncIntegrityProtectedData
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SymEncIntegrityProtectedData -> m SymEncIntegrityProtectedData
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SymEncIntegrityProtectedData -> m SymEncIntegrityProtectedData
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SymEncIntegrityProtectedData -> m SymEncIntegrityProtectedData
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SymEncIntegrityProtectedData -> m SymEncIntegrityProtectedData
Data, SymEncIntegrityProtectedData
-> SymEncIntegrityProtectedData -> Bool
(SymEncIntegrityProtectedData
-> SymEncIntegrityProtectedData -> Bool)
-> (SymEncIntegrityProtectedData
-> SymEncIntegrityProtectedData -> Bool)
-> Eq SymEncIntegrityProtectedData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SymEncIntegrityProtectedData
-> SymEncIntegrityProtectedData -> Bool
== :: SymEncIntegrityProtectedData
-> SymEncIntegrityProtectedData -> Bool
$c/= :: SymEncIntegrityProtectedData
-> SymEncIntegrityProtectedData -> Bool
/= :: SymEncIntegrityProtectedData
-> SymEncIntegrityProtectedData -> Bool
Eq, Int -> SymEncIntegrityProtectedData -> ShowS
[SymEncIntegrityProtectedData] -> ShowS
SymEncIntegrityProtectedData -> String
(Int -> SymEncIntegrityProtectedData -> ShowS)
-> (SymEncIntegrityProtectedData -> String)
-> ([SymEncIntegrityProtectedData] -> ShowS)
-> Show SymEncIntegrityProtectedData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SymEncIntegrityProtectedData -> ShowS
showsPrec :: Int -> SymEncIntegrityProtectedData -> ShowS
$cshow :: SymEncIntegrityProtectedData -> String
show :: SymEncIntegrityProtectedData -> String
$cshowList :: [SymEncIntegrityProtectedData] -> ShowS
showList :: [SymEncIntegrityProtectedData] -> ShowS
Show, Typeable)
instance Packet SymEncIntegrityProtectedData where
data PacketType
SymEncIntegrityProtectedData = SymEncIntegrityProtectedDataType
deriving (Int -> PacketType SymEncIntegrityProtectedData -> ShowS
[PacketType SymEncIntegrityProtectedData] -> ShowS
PacketType SymEncIntegrityProtectedData -> String
(Int -> PacketType SymEncIntegrityProtectedData -> ShowS)
-> (PacketType SymEncIntegrityProtectedData -> String)
-> ([PacketType SymEncIntegrityProtectedData] -> ShowS)
-> Show (PacketType SymEncIntegrityProtectedData)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PacketType SymEncIntegrityProtectedData -> ShowS
showsPrec :: Int -> PacketType SymEncIntegrityProtectedData -> ShowS
$cshow :: PacketType SymEncIntegrityProtectedData -> String
show :: PacketType SymEncIntegrityProtectedData -> String
$cshowList :: [PacketType SymEncIntegrityProtectedData] -> ShowS
showList :: [PacketType SymEncIntegrityProtectedData] -> ShowS
Show, PacketType SymEncIntegrityProtectedData
-> PacketType SymEncIntegrityProtectedData -> Bool
(PacketType SymEncIntegrityProtectedData
-> PacketType SymEncIntegrityProtectedData -> Bool)
-> (PacketType SymEncIntegrityProtectedData
-> PacketType SymEncIntegrityProtectedData -> Bool)
-> Eq (PacketType SymEncIntegrityProtectedData)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PacketType SymEncIntegrityProtectedData
-> PacketType SymEncIntegrityProtectedData -> Bool
== :: PacketType SymEncIntegrityProtectedData
-> PacketType SymEncIntegrityProtectedData -> Bool
$c/= :: PacketType SymEncIntegrityProtectedData
-> PacketType SymEncIntegrityProtectedData -> Bool
/= :: PacketType SymEncIntegrityProtectedData
-> PacketType SymEncIntegrityProtectedData -> Bool
Eq)
packetType :: SymEncIntegrityProtectedData
-> PacketType SymEncIntegrityProtectedData
packetType SymEncIntegrityProtectedData
_ = PacketType SymEncIntegrityProtectedData
SymEncIntegrityProtectedDataType
packetCode :: PacketType SymEncIntegrityProtectedData -> PacketVersion
packetCode PacketType SymEncIntegrityProtectedData
_ = PacketVersion
18
toPkt :: SymEncIntegrityProtectedData -> Pkt
toPkt (SymEncIntegrityProtectedData PacketVersion
a ByteString
b) = PacketVersion -> ByteString -> Pkt
SymEncIntegrityProtectedDataPkt PacketVersion
a ByteString
b
fromPkt :: Pkt -> SymEncIntegrityProtectedData
fromPkt (SymEncIntegrityProtectedDataPkt PacketVersion
a ByteString
b) =
PacketVersion -> ByteString -> SymEncIntegrityProtectedData
SymEncIntegrityProtectedData PacketVersion
a ByteString
b
fromPkt Pkt
_ = String -> SymEncIntegrityProtectedData
forall a. HasCallStack => String -> a
error String
"Cannot coerce non-SymEncIntegrityProtectedData packet"
instance Pretty SymEncIntegrityProtectedData where
pretty :: forall ann. SymEncIntegrityProtectedData -> Doc ann
pretty = Pkt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Pkt -> Doc ann
pretty (Pkt -> Doc ann)
-> (SymEncIntegrityProtectedData -> Pkt)
-> SymEncIntegrityProtectedData
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SymEncIntegrityProtectedData -> Pkt
forall a. Packet a => a -> Pkt
toPkt
newtype ModificationDetectionCode =
ModificationDetectionCode
{ ModificationDetectionCode -> ByteString
_modificationDetectionCodePayload :: ByteString
}
deriving (Typeable ModificationDetectionCode
Typeable ModificationDetectionCode
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ModificationDetectionCode
-> c ModificationDetectionCode)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ModificationDetectionCode)
-> (ModificationDetectionCode -> Constr)
-> (ModificationDetectionCode -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ModificationDetectionCode))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ModificationDetectionCode))
-> ((forall b. Data b => b -> b)
-> ModificationDetectionCode -> ModificationDetectionCode)
-> (forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ModificationDetectionCode
-> r)
-> (forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ModificationDetectionCode
-> r)
-> (forall u.
(forall d. Data d => d -> u) -> ModificationDetectionCode -> [u])
-> (forall u.
Int
-> (forall d. Data d => d -> u) -> ModificationDetectionCode -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ModificationDetectionCode -> m ModificationDetectionCode)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ModificationDetectionCode -> m ModificationDetectionCode)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ModificationDetectionCode -> m ModificationDetectionCode)
-> Data ModificationDetectionCode
ModificationDetectionCode -> Constr
ModificationDetectionCode -> DataType
(forall b. Data b => b -> b)
-> ModificationDetectionCode -> ModificationDetectionCode
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u) -> ModificationDetectionCode -> u
forall u.
(forall d. Data d => d -> u) -> ModificationDetectionCode -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ModificationDetectionCode
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ModificationDetectionCode
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ModificationDetectionCode -> m ModificationDetectionCode
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ModificationDetectionCode -> m ModificationDetectionCode
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ModificationDetectionCode
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ModificationDetectionCode
-> c ModificationDetectionCode
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ModificationDetectionCode)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ModificationDetectionCode)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ModificationDetectionCode
-> c ModificationDetectionCode
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ModificationDetectionCode
-> c ModificationDetectionCode
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ModificationDetectionCode
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ModificationDetectionCode
$ctoConstr :: ModificationDetectionCode -> Constr
toConstr :: ModificationDetectionCode -> Constr
$cdataTypeOf :: ModificationDetectionCode -> DataType
dataTypeOf :: ModificationDetectionCode -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ModificationDetectionCode)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ModificationDetectionCode)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ModificationDetectionCode)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ModificationDetectionCode)
$cgmapT :: (forall b. Data b => b -> b)
-> ModificationDetectionCode -> ModificationDetectionCode
gmapT :: (forall b. Data b => b -> b)
-> ModificationDetectionCode -> ModificationDetectionCode
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ModificationDetectionCode
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ModificationDetectionCode
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ModificationDetectionCode
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ModificationDetectionCode
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> ModificationDetectionCode -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> ModificationDetectionCode -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> ModificationDetectionCode -> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> ModificationDetectionCode -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ModificationDetectionCode -> m ModificationDetectionCode
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ModificationDetectionCode -> m ModificationDetectionCode
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ModificationDetectionCode -> m ModificationDetectionCode
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ModificationDetectionCode -> m ModificationDetectionCode
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ModificationDetectionCode -> m ModificationDetectionCode
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ModificationDetectionCode -> m ModificationDetectionCode
Data, ModificationDetectionCode -> ModificationDetectionCode -> Bool
(ModificationDetectionCode -> ModificationDetectionCode -> Bool)
-> (ModificationDetectionCode -> ModificationDetectionCode -> Bool)
-> Eq ModificationDetectionCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModificationDetectionCode -> ModificationDetectionCode -> Bool
== :: ModificationDetectionCode -> ModificationDetectionCode -> Bool
$c/= :: ModificationDetectionCode -> ModificationDetectionCode -> Bool
/= :: ModificationDetectionCode -> ModificationDetectionCode -> Bool
Eq, Int -> ModificationDetectionCode -> ShowS
[ModificationDetectionCode] -> ShowS
ModificationDetectionCode -> String
(Int -> ModificationDetectionCode -> ShowS)
-> (ModificationDetectionCode -> String)
-> ([ModificationDetectionCode] -> ShowS)
-> Show ModificationDetectionCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModificationDetectionCode -> ShowS
showsPrec :: Int -> ModificationDetectionCode -> ShowS
$cshow :: ModificationDetectionCode -> String
show :: ModificationDetectionCode -> String
$cshowList :: [ModificationDetectionCode] -> ShowS
showList :: [ModificationDetectionCode] -> ShowS
Show, Typeable)
instance Packet ModificationDetectionCode where
data PacketType
ModificationDetectionCode = ModificationDetectionCodeType
deriving (Int -> PacketType ModificationDetectionCode -> ShowS
[PacketType ModificationDetectionCode] -> ShowS
PacketType ModificationDetectionCode -> String
(Int -> PacketType ModificationDetectionCode -> ShowS)
-> (PacketType ModificationDetectionCode -> String)
-> ([PacketType ModificationDetectionCode] -> ShowS)
-> Show (PacketType ModificationDetectionCode)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PacketType ModificationDetectionCode -> ShowS
showsPrec :: Int -> PacketType ModificationDetectionCode -> ShowS
$cshow :: PacketType ModificationDetectionCode -> String
show :: PacketType ModificationDetectionCode -> String
$cshowList :: [PacketType ModificationDetectionCode] -> ShowS
showList :: [PacketType ModificationDetectionCode] -> ShowS
Show, PacketType ModificationDetectionCode
-> PacketType ModificationDetectionCode -> Bool
(PacketType ModificationDetectionCode
-> PacketType ModificationDetectionCode -> Bool)
-> (PacketType ModificationDetectionCode
-> PacketType ModificationDetectionCode -> Bool)
-> Eq (PacketType ModificationDetectionCode)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PacketType ModificationDetectionCode
-> PacketType ModificationDetectionCode -> Bool
== :: PacketType ModificationDetectionCode
-> PacketType ModificationDetectionCode -> Bool
$c/= :: PacketType ModificationDetectionCode
-> PacketType ModificationDetectionCode -> Bool
/= :: PacketType ModificationDetectionCode
-> PacketType ModificationDetectionCode -> Bool
Eq)
packetType :: ModificationDetectionCode -> PacketType ModificationDetectionCode
packetType ModificationDetectionCode
_ = PacketType ModificationDetectionCode
ModificationDetectionCodeType
packetCode :: PacketType ModificationDetectionCode -> PacketVersion
packetCode PacketType ModificationDetectionCode
_ = PacketVersion
19
toPkt :: ModificationDetectionCode -> Pkt
toPkt (ModificationDetectionCode ByteString
a) = ByteString -> Pkt
ModificationDetectionCodePkt ByteString
a
fromPkt :: Pkt -> ModificationDetectionCode
fromPkt (ModificationDetectionCodePkt ByteString
a) = ByteString -> ModificationDetectionCode
ModificationDetectionCode ByteString
a
fromPkt Pkt
_ = String -> ModificationDetectionCode
forall a. HasCallStack => String -> a
error String
"Cannot coerce non-ModificationDetectionCode packet"
instance Pretty ModificationDetectionCode where
pretty :: forall ann. ModificationDetectionCode -> Doc ann
pretty = Pkt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Pkt -> Doc ann
pretty (Pkt -> Doc ann)
-> (ModificationDetectionCode -> Pkt)
-> ModificationDetectionCode
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModificationDetectionCode -> Pkt
forall a. Packet a => a -> Pkt
toPkt
data OtherPacket =
OtherPacket
{ OtherPacket -> PacketVersion
_otherPacketType :: Word8
, OtherPacket -> ByteString
_otherPacketPayload :: ByteString
}
deriving (Typeable OtherPacket
Typeable OtherPacket
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OtherPacket -> c OtherPacket)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OtherPacket)
-> (OtherPacket -> Constr)
-> (OtherPacket -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OtherPacket))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OtherPacket))
-> ((forall b. Data b => b -> b) -> OtherPacket -> OtherPacket)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OtherPacket -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OtherPacket -> r)
-> (forall u. (forall d. Data d => d -> u) -> OtherPacket -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> OtherPacket -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OtherPacket -> m OtherPacket)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OtherPacket -> m OtherPacket)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OtherPacket -> m OtherPacket)
-> Data OtherPacket
OtherPacket -> Constr
OtherPacket -> DataType
(forall b. Data b => b -> b) -> OtherPacket -> OtherPacket
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> OtherPacket -> u
forall u. (forall d. Data d => d -> u) -> OtherPacket -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OtherPacket -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OtherPacket -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OtherPacket -> m OtherPacket
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OtherPacket -> m OtherPacket
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OtherPacket
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OtherPacket -> c OtherPacket
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OtherPacket)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OtherPacket)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OtherPacket -> c OtherPacket
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OtherPacket -> c OtherPacket
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OtherPacket
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OtherPacket
$ctoConstr :: OtherPacket -> Constr
toConstr :: OtherPacket -> Constr
$cdataTypeOf :: OtherPacket -> DataType
dataTypeOf :: OtherPacket -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OtherPacket)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OtherPacket)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OtherPacket)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OtherPacket)
$cgmapT :: (forall b. Data b => b -> b) -> OtherPacket -> OtherPacket
gmapT :: (forall b. Data b => b -> b) -> OtherPacket -> OtherPacket
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OtherPacket -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OtherPacket -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OtherPacket -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OtherPacket -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> OtherPacket -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> OtherPacket -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OtherPacket -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OtherPacket -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OtherPacket -> m OtherPacket
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OtherPacket -> m OtherPacket
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OtherPacket -> m OtherPacket
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OtherPacket -> m OtherPacket
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OtherPacket -> m OtherPacket
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OtherPacket -> m OtherPacket
Data, OtherPacket -> OtherPacket -> Bool
(OtherPacket -> OtherPacket -> Bool)
-> (OtherPacket -> OtherPacket -> Bool) -> Eq OtherPacket
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OtherPacket -> OtherPacket -> Bool
== :: OtherPacket -> OtherPacket -> Bool
$c/= :: OtherPacket -> OtherPacket -> Bool
/= :: OtherPacket -> OtherPacket -> Bool
Eq, Int -> OtherPacket -> ShowS
[OtherPacket] -> ShowS
OtherPacket -> String
(Int -> OtherPacket -> ShowS)
-> (OtherPacket -> String)
-> ([OtherPacket] -> ShowS)
-> Show OtherPacket
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OtherPacket -> ShowS
showsPrec :: Int -> OtherPacket -> ShowS
$cshow :: OtherPacket -> String
show :: OtherPacket -> String
$cshowList :: [OtherPacket] -> ShowS
showList :: [OtherPacket] -> ShowS
Show, Typeable)
instance Packet OtherPacket where
data PacketType OtherPacket = OtherPacketType
deriving (Int -> PacketType OtherPacket -> ShowS
[PacketType OtherPacket] -> ShowS
PacketType OtherPacket -> String
(Int -> PacketType OtherPacket -> ShowS)
-> (PacketType OtherPacket -> String)
-> ([PacketType OtherPacket] -> ShowS)
-> Show (PacketType OtherPacket)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PacketType OtherPacket -> ShowS
showsPrec :: Int -> PacketType OtherPacket -> ShowS
$cshow :: PacketType OtherPacket -> String
show :: PacketType OtherPacket -> String
$cshowList :: [PacketType OtherPacket] -> ShowS
showList :: [PacketType OtherPacket] -> ShowS
Show, PacketType OtherPacket -> PacketType OtherPacket -> Bool
(PacketType OtherPacket -> PacketType OtherPacket -> Bool)
-> (PacketType OtherPacket -> PacketType OtherPacket -> Bool)
-> Eq (PacketType OtherPacket)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PacketType OtherPacket -> PacketType OtherPacket -> Bool
== :: PacketType OtherPacket -> PacketType OtherPacket -> Bool
$c/= :: PacketType OtherPacket -> PacketType OtherPacket -> Bool
/= :: PacketType OtherPacket -> PacketType OtherPacket -> Bool
Eq)
packetType :: OtherPacket -> PacketType OtherPacket
packetType OtherPacket
_ = PacketType OtherPacket
OtherPacketType
packetCode :: PacketType OtherPacket -> PacketVersion
packetCode PacketType OtherPacket
_ = PacketVersion
forall a. HasCallStack => a
undefined
toPkt :: OtherPacket -> Pkt
toPkt (OtherPacket PacketVersion
a ByteString
b) = PacketVersion -> ByteString -> Pkt
OtherPacketPkt PacketVersion
a ByteString
b
fromPkt :: Pkt -> OtherPacket
fromPkt (OtherPacketPkt PacketVersion
a ByteString
b) = PacketVersion -> ByteString -> OtherPacket
OtherPacket PacketVersion
a ByteString
b
fromPkt Pkt
_ = String -> OtherPacket
forall a. HasCallStack => String -> a
error String
"Cannot coerce non-OtherPacket packet"
instance Pretty OtherPacket where
pretty :: forall ann. OtherPacket -> Doc ann
pretty = Pkt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Pkt -> Doc ann
pretty (Pkt -> Doc ann) -> (OtherPacket -> Pkt) -> OtherPacket -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OtherPacket -> Pkt
forall a. Packet a => a -> Pkt
toPkt
data BrokenPacket =
BrokenPacket
{ BrokenPacket -> String
_brokenPacketParseError :: String
, BrokenPacket -> PacketVersion
_brokenPacketType :: Word8
, BrokenPacket -> ByteString
_brokenPacketPayload :: ByteString
}
deriving (Typeable BrokenPacket
Typeable BrokenPacket
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BrokenPacket -> c BrokenPacket)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BrokenPacket)
-> (BrokenPacket -> Constr)
-> (BrokenPacket -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BrokenPacket))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c BrokenPacket))
-> ((forall b. Data b => b -> b) -> BrokenPacket -> BrokenPacket)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BrokenPacket -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BrokenPacket -> r)
-> (forall u. (forall d. Data d => d -> u) -> BrokenPacket -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> BrokenPacket -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BrokenPacket -> m BrokenPacket)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BrokenPacket -> m BrokenPacket)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BrokenPacket -> m BrokenPacket)
-> Data BrokenPacket
BrokenPacket -> Constr
BrokenPacket -> DataType
(forall b. Data b => b -> b) -> BrokenPacket -> BrokenPacket
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> BrokenPacket -> u
forall u. (forall d. Data d => d -> u) -> BrokenPacket -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BrokenPacket -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BrokenPacket -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BrokenPacket -> m BrokenPacket
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BrokenPacket -> m BrokenPacket
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BrokenPacket
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BrokenPacket -> c BrokenPacket
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BrokenPacket)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c BrokenPacket)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BrokenPacket -> c BrokenPacket
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BrokenPacket -> c BrokenPacket
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BrokenPacket
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BrokenPacket
$ctoConstr :: BrokenPacket -> Constr
toConstr :: BrokenPacket -> Constr
$cdataTypeOf :: BrokenPacket -> DataType
dataTypeOf :: BrokenPacket -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BrokenPacket)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BrokenPacket)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c BrokenPacket)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c BrokenPacket)
$cgmapT :: (forall b. Data b => b -> b) -> BrokenPacket -> BrokenPacket
gmapT :: (forall b. Data b => b -> b) -> BrokenPacket -> BrokenPacket
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BrokenPacket -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BrokenPacket -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BrokenPacket -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BrokenPacket -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> BrokenPacket -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> BrokenPacket -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BrokenPacket -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BrokenPacket -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BrokenPacket -> m BrokenPacket
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BrokenPacket -> m BrokenPacket
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BrokenPacket -> m BrokenPacket
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BrokenPacket -> m BrokenPacket
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BrokenPacket -> m BrokenPacket
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BrokenPacket -> m BrokenPacket
Data, BrokenPacket -> BrokenPacket -> Bool
(BrokenPacket -> BrokenPacket -> Bool)
-> (BrokenPacket -> BrokenPacket -> Bool) -> Eq BrokenPacket
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BrokenPacket -> BrokenPacket -> Bool
== :: BrokenPacket -> BrokenPacket -> Bool
$c/= :: BrokenPacket -> BrokenPacket -> Bool
/= :: BrokenPacket -> BrokenPacket -> Bool
Eq, Int -> BrokenPacket -> ShowS
[BrokenPacket] -> ShowS
BrokenPacket -> String
(Int -> BrokenPacket -> ShowS)
-> (BrokenPacket -> String)
-> ([BrokenPacket] -> ShowS)
-> Show BrokenPacket
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BrokenPacket -> ShowS
showsPrec :: Int -> BrokenPacket -> ShowS
$cshow :: BrokenPacket -> String
show :: BrokenPacket -> String
$cshowList :: [BrokenPacket] -> ShowS
showList :: [BrokenPacket] -> ShowS
Show, Typeable)
instance Packet BrokenPacket where
data PacketType BrokenPacket = BrokenPacketType
deriving (Int -> PacketType BrokenPacket -> ShowS
[PacketType BrokenPacket] -> ShowS
PacketType BrokenPacket -> String
(Int -> PacketType BrokenPacket -> ShowS)
-> (PacketType BrokenPacket -> String)
-> ([PacketType BrokenPacket] -> ShowS)
-> Show (PacketType BrokenPacket)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PacketType BrokenPacket -> ShowS
showsPrec :: Int -> PacketType BrokenPacket -> ShowS
$cshow :: PacketType BrokenPacket -> String
show :: PacketType BrokenPacket -> String
$cshowList :: [PacketType BrokenPacket] -> ShowS
showList :: [PacketType BrokenPacket] -> ShowS
Show, PacketType BrokenPacket -> PacketType BrokenPacket -> Bool
(PacketType BrokenPacket -> PacketType BrokenPacket -> Bool)
-> (PacketType BrokenPacket -> PacketType BrokenPacket -> Bool)
-> Eq (PacketType BrokenPacket)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PacketType BrokenPacket -> PacketType BrokenPacket -> Bool
== :: PacketType BrokenPacket -> PacketType BrokenPacket -> Bool
$c/= :: PacketType BrokenPacket -> PacketType BrokenPacket -> Bool
/= :: PacketType BrokenPacket -> PacketType BrokenPacket -> Bool
Eq)
packetType :: BrokenPacket -> PacketType BrokenPacket
packetType BrokenPacket
_ = PacketType BrokenPacket
BrokenPacketType
packetCode :: PacketType BrokenPacket -> PacketVersion
packetCode PacketType BrokenPacket
_ = PacketVersion
forall a. HasCallStack => a
undefined
toPkt :: BrokenPacket -> Pkt
toPkt (BrokenPacket String
a PacketVersion
b ByteString
c) = String -> PacketVersion -> ByteString -> Pkt
BrokenPacketPkt String
a PacketVersion
b ByteString
c
fromPkt :: Pkt -> BrokenPacket
fromPkt (BrokenPacketPkt String
a PacketVersion
b ByteString
c) = String -> PacketVersion -> ByteString -> BrokenPacket
BrokenPacket String
a PacketVersion
b ByteString
c
fromPkt Pkt
_ = String -> BrokenPacket
forall a. HasCallStack => String -> a
error String
"Cannot coerce non-BrokenPacket packet"
instance Pretty BrokenPacket where
pretty :: forall ann. BrokenPacket -> Doc ann
pretty = Pkt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Pkt -> Doc ann
pretty (Pkt -> Doc ann)
-> (BrokenPacket -> Pkt) -> BrokenPacket -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BrokenPacket -> Pkt
forall a. Packet a => a -> Pkt
toPkt
$(makeLenses ''PKESK)
$(makeLenses ''Signature)
$(makeLenses ''SKESK)
$(makeLenses ''OnePassSignature)
$(makeLenses ''SecretKey)
$(makeLenses ''PKPayload)
$(makeLenses ''PublicKey)
$(makeLenses ''SecretSubkey)
$(makeLenses ''CompressedData)
$(makeLenses ''SymEncData)
$(makeLenses ''Marker)
$(makeLenses ''LiteralData)
$(makeLenses ''Trust)
$(makeLenses ''UserId)
$(makeLenses ''PublicSubkey)
$(makeLenses ''UserAttribute)
$(makeLenses ''SymEncIntegrityProtectedData)
$(makeLenses ''ModificationDetectionCode)
$(makeLenses ''OtherPacket)
$(makeLenses ''BrokenPacket)