{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# LANGUAGE NoImplicitPrelude           #-}
{-# LANGUAGE TemplateHaskell             #-}
{-# LANGUAGE RecordWildCards             #-}

-- |
-- Module:      SwiftNav.SBP.Signing
-- Copyright:   Copyright (C) 2015-2021 Swift Navigation, Inc.
-- License:     MIT
-- Contact:     https://support.swiftnav.com
-- Stability:   experimental
-- Portability: portable
--
-- \< Messages relating to signatures \>

module SwiftNav.SBP.Signing
  ( module SwiftNav.SBP.Signing
  ) where

import BasicPrelude
import Control.Lens
import Control.Monad.Loops
import Data.Binary
import Data.Binary.Get
import Data.Binary.IEEE754
import Data.Binary.Put
import Data.ByteString.Lazy    hiding (ByteString)
import Data.Int
import Data.Word
import SwiftNav.SBP.TH
import SwiftNav.SBP.Types

{-# ANN module ("HLint: ignore Use camelCase"::String) #-}
{-# ANN module ("HLint: ignore Redundant do"::String) #-}
{-# ANN module ("HLint: ignore Use newtype instead of data"::String) #-}


data UtcTime = UtcTime
  { UtcTime -> Word16
_utcTime_year  :: !Word16
    -- ^ Year
  , UtcTime -> Word8
_utcTime_month :: !Word8
    -- ^ Month (range 1 .. 12)
  , UtcTime -> Word8
_utcTime_day   :: !Word8
    -- ^ days in the month (range 1-31)
  , UtcTime -> Word8
_utcTime_hours :: !Word8
    -- ^ hours of day (range 0-23)
  , UtcTime -> Word8
_utcTime_minutes :: !Word8
    -- ^ minutes of hour (range 0-59)
  , UtcTime -> Word8
_utcTime_seconds :: !Word8
    -- ^ seconds of minute (range 0-60) rounded down
  , UtcTime -> Word32
_utcTime_ns    :: !Word32
    -- ^ nanoseconds of second (range 0-999999999)
  } deriving ( Int -> UtcTime -> ShowS
[UtcTime] -> ShowS
UtcTime -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UtcTime] -> ShowS
$cshowList :: [UtcTime] -> ShowS
show :: UtcTime -> String
$cshow :: UtcTime -> String
showsPrec :: Int -> UtcTime -> ShowS
$cshowsPrec :: Int -> UtcTime -> ShowS
Show, ReadPrec [UtcTime]
ReadPrec UtcTime
Int -> ReadS UtcTime
ReadS [UtcTime]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UtcTime]
$creadListPrec :: ReadPrec [UtcTime]
readPrec :: ReadPrec UtcTime
$creadPrec :: ReadPrec UtcTime
readList :: ReadS [UtcTime]
$creadList :: ReadS [UtcTime]
readsPrec :: Int -> ReadS UtcTime
$creadsPrec :: Int -> ReadS UtcTime
Read, UtcTime -> UtcTime -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UtcTime -> UtcTime -> Bool
$c/= :: UtcTime -> UtcTime -> Bool
== :: UtcTime -> UtcTime -> Bool
$c== :: UtcTime -> UtcTime -> Bool
Eq )

instance Binary UtcTime where
  get :: Get UtcTime
get = do
    Word16
_utcTime_year <- Get Word16
getWord16le
    Word8
_utcTime_month <- Get Word8
getWord8
    Word8
_utcTime_day <- Get Word8
getWord8
    Word8
_utcTime_hours <- Get Word8
getWord8
    Word8
_utcTime_minutes <- Get Word8
getWord8
    Word8
_utcTime_seconds <- Get Word8
getWord8
    Word32
_utcTime_ns <- Get Word32
getWord32le
    forall (f :: * -> *) a. Applicative f => a -> f a
pure UtcTime {Word8
Word16
Word32
_utcTime_ns :: Word32
_utcTime_seconds :: Word8
_utcTime_minutes :: Word8
_utcTime_hours :: Word8
_utcTime_day :: Word8
_utcTime_month :: Word8
_utcTime_year :: Word16
_utcTime_ns :: Word32
_utcTime_seconds :: Word8
_utcTime_minutes :: Word8
_utcTime_hours :: Word8
_utcTime_day :: Word8
_utcTime_month :: Word8
_utcTime_year :: Word16
..}

  put :: UtcTime -> Put
put UtcTime {Word8
Word16
Word32
_utcTime_ns :: Word32
_utcTime_seconds :: Word8
_utcTime_minutes :: Word8
_utcTime_hours :: Word8
_utcTime_day :: Word8
_utcTime_month :: Word8
_utcTime_year :: Word16
_utcTime_ns :: UtcTime -> Word32
_utcTime_seconds :: UtcTime -> Word8
_utcTime_minutes :: UtcTime -> Word8
_utcTime_hours :: UtcTime -> Word8
_utcTime_day :: UtcTime -> Word8
_utcTime_month :: UtcTime -> Word8
_utcTime_year :: UtcTime -> Word16
..} = do
    Word16 -> Put
putWord16le Word16
_utcTime_year
    Word8 -> Put
putWord8 Word8
_utcTime_month
    Word8 -> Put
putWord8 Word8
_utcTime_day
    Word8 -> Put
putWord8 Word8
_utcTime_hours
    Word8 -> Put
putWord8 Word8
_utcTime_minutes
    Word8 -> Put
putWord8 Word8
_utcTime_seconds
    Word32 -> Put
putWord32le Word32
_utcTime_ns

$(makeJSON "_utcTime_" ''UtcTime)
$(makeLenses ''UtcTime)

data ECDSASignature = ECDSASignature
  { ECDSASignature -> Word8
_eCDSASignature_len :: !Word8
    -- ^ Number of bytes to use of the signature field.  The DER encoded
    -- signature has a maximum size of 72 bytes but can vary between 70 and 72
    -- bytes in length.
  , ECDSASignature -> [Word8]
_eCDSASignature_data :: ![Word8]
    -- ^ DER encoded ECDSA signature for the messages using SHA-256 as the
    -- digest algorithm.
  } deriving ( Int -> ECDSASignature -> ShowS
[ECDSASignature] -> ShowS
ECDSASignature -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ECDSASignature] -> ShowS
$cshowList :: [ECDSASignature] -> ShowS
show :: ECDSASignature -> String
$cshow :: ECDSASignature -> String
showsPrec :: Int -> ECDSASignature -> ShowS
$cshowsPrec :: Int -> ECDSASignature -> ShowS
Show, ReadPrec [ECDSASignature]
ReadPrec ECDSASignature
Int -> ReadS ECDSASignature
ReadS [ECDSASignature]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ECDSASignature]
$creadListPrec :: ReadPrec [ECDSASignature]
readPrec :: ReadPrec ECDSASignature
$creadPrec :: ReadPrec ECDSASignature
readList :: ReadS [ECDSASignature]
$creadList :: ReadS [ECDSASignature]
readsPrec :: Int -> ReadS ECDSASignature
$creadsPrec :: Int -> ReadS ECDSASignature
Read, ECDSASignature -> ECDSASignature -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ECDSASignature -> ECDSASignature -> Bool
$c/= :: ECDSASignature -> ECDSASignature -> Bool
== :: ECDSASignature -> ECDSASignature -> Bool
$c== :: ECDSASignature -> ECDSASignature -> Bool
Eq )

instance Binary ECDSASignature where
  get :: Get ECDSASignature
get = do
    Word8
_eCDSASignature_len <- Get Word8
getWord8
    [Word8]
_eCDSASignature_data <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
72 Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure ECDSASignature {[Word8]
Word8
_eCDSASignature_data :: [Word8]
_eCDSASignature_len :: Word8
_eCDSASignature_data :: [Word8]
_eCDSASignature_len :: Word8
..}

  put :: ECDSASignature -> Put
put ECDSASignature {[Word8]
Word8
_eCDSASignature_data :: [Word8]
_eCDSASignature_len :: Word8
_eCDSASignature_data :: ECDSASignature -> [Word8]
_eCDSASignature_len :: ECDSASignature -> Word8
..} = do
    Word8 -> Put
putWord8 Word8
_eCDSASignature_len
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word8 -> Put
putWord8 [Word8]
_eCDSASignature_data

$(makeJSON "_eCDSASignature_" ''ECDSASignature)
$(makeLenses ''ECDSASignature)

msgEcdsaCertificate :: Word16
msgEcdsaCertificate :: Word16
msgEcdsaCertificate = Word16
0x0C04

-- | SBP class for message MSG_ECDSA_CERTIFICATE (0x0C04).
--
-- A DER encoded x.509 ECDSA-256 certificate (using curve secp256r1).
data MsgEcdsaCertificate = MsgEcdsaCertificate
  { MsgEcdsaCertificate -> Word8
_msgEcdsaCertificate_n_msg           :: !Word8
    -- ^ Total number messages that make up the certificate. The first nibble
    -- (mask 0xF0 or left shifted by 4 bits) is the size of the sequence (n),
    -- second nibble (mask 0x0F) is the zero-indexed counter (ith packet of
    -- n).
  , MsgEcdsaCertificate -> [Word8]
_msgEcdsaCertificate_certificate_id  :: ![Word8]
    -- ^ The last 4 bytes of the certificate's SHA-1 fingerprint
  , MsgEcdsaCertificate -> Word8
_msgEcdsaCertificate_flags           :: !Word8
  , MsgEcdsaCertificate -> [Word8]
_msgEcdsaCertificate_certificate_bytes :: ![Word8]
    -- ^ DER encoded x.509 ECDSA certificate bytes
  } deriving ( Int -> MsgEcdsaCertificate -> ShowS
[MsgEcdsaCertificate] -> ShowS
MsgEcdsaCertificate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgEcdsaCertificate] -> ShowS
$cshowList :: [MsgEcdsaCertificate] -> ShowS
show :: MsgEcdsaCertificate -> String
$cshow :: MsgEcdsaCertificate -> String
showsPrec :: Int -> MsgEcdsaCertificate -> ShowS
$cshowsPrec :: Int -> MsgEcdsaCertificate -> ShowS
Show, ReadPrec [MsgEcdsaCertificate]
ReadPrec MsgEcdsaCertificate
Int -> ReadS MsgEcdsaCertificate
ReadS [MsgEcdsaCertificate]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgEcdsaCertificate]
$creadListPrec :: ReadPrec [MsgEcdsaCertificate]
readPrec :: ReadPrec MsgEcdsaCertificate
$creadPrec :: ReadPrec MsgEcdsaCertificate
readList :: ReadS [MsgEcdsaCertificate]
$creadList :: ReadS [MsgEcdsaCertificate]
readsPrec :: Int -> ReadS MsgEcdsaCertificate
$creadsPrec :: Int -> ReadS MsgEcdsaCertificate
Read, MsgEcdsaCertificate -> MsgEcdsaCertificate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgEcdsaCertificate -> MsgEcdsaCertificate -> Bool
$c/= :: MsgEcdsaCertificate -> MsgEcdsaCertificate -> Bool
== :: MsgEcdsaCertificate -> MsgEcdsaCertificate -> Bool
$c== :: MsgEcdsaCertificate -> MsgEcdsaCertificate -> Bool
Eq )

instance Binary MsgEcdsaCertificate where
  get :: Get MsgEcdsaCertificate
get = do
    Word8
_msgEcdsaCertificate_n_msg <- Get Word8
getWord8
    [Word8]
_msgEcdsaCertificate_certificate_id <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
4 Get Word8
getWord8
    Word8
_msgEcdsaCertificate_flags <- Get Word8
getWord8
    [Word8]
_msgEcdsaCertificate_certificate_bytes <- forall (m :: * -> *) a. Monad m => m Bool -> m a -> m [a]
whileM (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Bool
isEmpty) Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgEcdsaCertificate {[Word8]
Word8
_msgEcdsaCertificate_certificate_bytes :: [Word8]
_msgEcdsaCertificate_flags :: Word8
_msgEcdsaCertificate_certificate_id :: [Word8]
_msgEcdsaCertificate_n_msg :: Word8
_msgEcdsaCertificate_certificate_bytes :: [Word8]
_msgEcdsaCertificate_flags :: Word8
_msgEcdsaCertificate_certificate_id :: [Word8]
_msgEcdsaCertificate_n_msg :: Word8
..}

  put :: MsgEcdsaCertificate -> Put
put MsgEcdsaCertificate {[Word8]
Word8
_msgEcdsaCertificate_certificate_bytes :: [Word8]
_msgEcdsaCertificate_flags :: Word8
_msgEcdsaCertificate_certificate_id :: [Word8]
_msgEcdsaCertificate_n_msg :: Word8
_msgEcdsaCertificate_certificate_bytes :: MsgEcdsaCertificate -> [Word8]
_msgEcdsaCertificate_flags :: MsgEcdsaCertificate -> Word8
_msgEcdsaCertificate_certificate_id :: MsgEcdsaCertificate -> [Word8]
_msgEcdsaCertificate_n_msg :: MsgEcdsaCertificate -> Word8
..} = do
    Word8 -> Put
putWord8 Word8
_msgEcdsaCertificate_n_msg
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word8 -> Put
putWord8 [Word8]
_msgEcdsaCertificate_certificate_id
    Word8 -> Put
putWord8 Word8
_msgEcdsaCertificate_flags
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word8 -> Put
putWord8 [Word8]
_msgEcdsaCertificate_certificate_bytes

$(makeSBP 'msgEcdsaCertificate ''MsgEcdsaCertificate)
$(makeJSON "_msgEcdsaCertificate_" ''MsgEcdsaCertificate)
$(makeLenses ''MsgEcdsaCertificate)

msgCertificateChain :: Word16
msgCertificateChain :: Word16
msgCertificateChain = Word16
0x0C09

data MsgCertificateChain = MsgCertificateChain
  { MsgCertificateChain -> [Word8]
_msgCertificateChain_root_certificate       :: ![Word8]
    -- ^ SHA-1 fingerprint of the root certificate
  , MsgCertificateChain -> [Word8]
_msgCertificateChain_intermediate_certificate :: ![Word8]
    -- ^ SHA-1 fingerprint of the intermediate certificate
  , MsgCertificateChain -> [Word8]
_msgCertificateChain_corrections_certificate :: ![Word8]
    -- ^ SHA-1 fingerprint of the corrections certificate
  , MsgCertificateChain -> UtcTime
_msgCertificateChain_expiration             :: !UtcTime
    -- ^ The time after which the signature given is no longer valid.
    -- Implementors should consult a time source (such as GNSS) to check if
    -- the current time is later than the expiration time, if the condition is
    -- true, signatures in the stream should not be considered valid.
  , MsgCertificateChain -> ECDSASignature
_msgCertificateChain_signature              :: !ECDSASignature
    -- ^ Signature (created by the root certificate) over the concatenation of
    -- the SBP payload bytes preceding this field. That is, the concatenation
    -- of `root_certificate`, `intermediate_certificate`,
    -- `corrections_certificate` and `expiration`.  This certificate chain
    -- (allow list) can also be validated by fetching it from
    -- `http(s)://certs.swiftnav.com/chain`.
  } deriving ( Int -> MsgCertificateChain -> ShowS
[MsgCertificateChain] -> ShowS
MsgCertificateChain -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgCertificateChain] -> ShowS
$cshowList :: [MsgCertificateChain] -> ShowS
show :: MsgCertificateChain -> String
$cshow :: MsgCertificateChain -> String
showsPrec :: Int -> MsgCertificateChain -> ShowS
$cshowsPrec :: Int -> MsgCertificateChain -> ShowS
Show, ReadPrec [MsgCertificateChain]
ReadPrec MsgCertificateChain
Int -> ReadS MsgCertificateChain
ReadS [MsgCertificateChain]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgCertificateChain]
$creadListPrec :: ReadPrec [MsgCertificateChain]
readPrec :: ReadPrec MsgCertificateChain
$creadPrec :: ReadPrec MsgCertificateChain
readList :: ReadS [MsgCertificateChain]
$creadList :: ReadS [MsgCertificateChain]
readsPrec :: Int -> ReadS MsgCertificateChain
$creadsPrec :: Int -> ReadS MsgCertificateChain
Read, MsgCertificateChain -> MsgCertificateChain -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgCertificateChain -> MsgCertificateChain -> Bool
$c/= :: MsgCertificateChain -> MsgCertificateChain -> Bool
== :: MsgCertificateChain -> MsgCertificateChain -> Bool
$c== :: MsgCertificateChain -> MsgCertificateChain -> Bool
Eq )

instance Binary MsgCertificateChain where
  get :: Get MsgCertificateChain
get = do
    [Word8]
_msgCertificateChain_root_certificate <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
20 Get Word8
getWord8
    [Word8]
_msgCertificateChain_intermediate_certificate <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
20 Get Word8
getWord8
    [Word8]
_msgCertificateChain_corrections_certificate <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
20 Get Word8
getWord8
    UtcTime
_msgCertificateChain_expiration <- forall t. Binary t => Get t
get
    ECDSASignature
_msgCertificateChain_signature <- forall t. Binary t => Get t
get
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgCertificateChain {[Word8]
UtcTime
ECDSASignature
_msgCertificateChain_signature :: ECDSASignature
_msgCertificateChain_expiration :: UtcTime
_msgCertificateChain_corrections_certificate :: [Word8]
_msgCertificateChain_intermediate_certificate :: [Word8]
_msgCertificateChain_root_certificate :: [Word8]
_msgCertificateChain_signature :: ECDSASignature
_msgCertificateChain_expiration :: UtcTime
_msgCertificateChain_corrections_certificate :: [Word8]
_msgCertificateChain_intermediate_certificate :: [Word8]
_msgCertificateChain_root_certificate :: [Word8]
..}

  put :: MsgCertificateChain -> Put
put MsgCertificateChain {[Word8]
UtcTime
ECDSASignature
_msgCertificateChain_signature :: ECDSASignature
_msgCertificateChain_expiration :: UtcTime
_msgCertificateChain_corrections_certificate :: [Word8]
_msgCertificateChain_intermediate_certificate :: [Word8]
_msgCertificateChain_root_certificate :: [Word8]
_msgCertificateChain_signature :: MsgCertificateChain -> ECDSASignature
_msgCertificateChain_expiration :: MsgCertificateChain -> UtcTime
_msgCertificateChain_corrections_certificate :: MsgCertificateChain -> [Word8]
_msgCertificateChain_intermediate_certificate :: MsgCertificateChain -> [Word8]
_msgCertificateChain_root_certificate :: MsgCertificateChain -> [Word8]
..} = do
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word8 -> Put
putWord8 [Word8]
_msgCertificateChain_root_certificate
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word8 -> Put
putWord8 [Word8]
_msgCertificateChain_intermediate_certificate
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word8 -> Put
putWord8 [Word8]
_msgCertificateChain_corrections_certificate
    forall t. Binary t => t -> Put
put UtcTime
_msgCertificateChain_expiration
    forall t. Binary t => t -> Put
put ECDSASignature
_msgCertificateChain_signature

$(makeSBP 'msgCertificateChain ''MsgCertificateChain)
$(makeJSON "_msgCertificateChain_" ''MsgCertificateChain)
$(makeLenses ''MsgCertificateChain)

msgCertificateChainDep :: Word16
msgCertificateChainDep :: Word16
msgCertificateChainDep = Word16
0x0C05

-- | SBP class for message MSG_CERTIFICATE_CHAIN_DEP (0x0C05).
--
-- Deprecated.
data MsgCertificateChainDep = MsgCertificateChainDep
  { MsgCertificateChainDep -> [Word8]
_msgCertificateChainDep_root_certificate       :: ![Word8]
    -- ^ SHA-1 fingerprint of the root certificate
  , MsgCertificateChainDep -> [Word8]
_msgCertificateChainDep_intermediate_certificate :: ![Word8]
    -- ^ SHA-1 fingerprint of the intermediate certificate
  , MsgCertificateChainDep -> [Word8]
_msgCertificateChainDep_corrections_certificate :: ![Word8]
    -- ^ SHA-1 fingerprint of the corrections certificate
  , MsgCertificateChainDep -> UtcTime
_msgCertificateChainDep_expiration             :: !UtcTime
    -- ^ The certificate chain comprised of three fingerprints: root
    -- certificate, intermediate certificate and corrections certificate.
  , MsgCertificateChainDep -> [Word8]
_msgCertificateChainDep_signature              :: ![Word8]
    -- ^ An ECDSA signature (created by the root certificate) over the
    -- concatenation of the SBP payload bytes preceding this field. That is,
    -- the concatenation of `root_certificate`, `intermediate_certificate`,
    -- `corrections_certificate` and `expiration`.  This certificate chain
    -- (allow list) can also be validated by fetching it from
    -- `http(s)://certs.swiftnav.com/chain`.
  } deriving ( Int -> MsgCertificateChainDep -> ShowS
[MsgCertificateChainDep] -> ShowS
MsgCertificateChainDep -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgCertificateChainDep] -> ShowS
$cshowList :: [MsgCertificateChainDep] -> ShowS
show :: MsgCertificateChainDep -> String
$cshow :: MsgCertificateChainDep -> String
showsPrec :: Int -> MsgCertificateChainDep -> ShowS
$cshowsPrec :: Int -> MsgCertificateChainDep -> ShowS
Show, ReadPrec [MsgCertificateChainDep]
ReadPrec MsgCertificateChainDep
Int -> ReadS MsgCertificateChainDep
ReadS [MsgCertificateChainDep]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgCertificateChainDep]
$creadListPrec :: ReadPrec [MsgCertificateChainDep]
readPrec :: ReadPrec MsgCertificateChainDep
$creadPrec :: ReadPrec MsgCertificateChainDep
readList :: ReadS [MsgCertificateChainDep]
$creadList :: ReadS [MsgCertificateChainDep]
readsPrec :: Int -> ReadS MsgCertificateChainDep
$creadsPrec :: Int -> ReadS MsgCertificateChainDep
Read, MsgCertificateChainDep -> MsgCertificateChainDep -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgCertificateChainDep -> MsgCertificateChainDep -> Bool
$c/= :: MsgCertificateChainDep -> MsgCertificateChainDep -> Bool
== :: MsgCertificateChainDep -> MsgCertificateChainDep -> Bool
$c== :: MsgCertificateChainDep -> MsgCertificateChainDep -> Bool
Eq )

instance Binary MsgCertificateChainDep where
  get :: Get MsgCertificateChainDep
get = do
    [Word8]
_msgCertificateChainDep_root_certificate <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
20 Get Word8
getWord8
    [Word8]
_msgCertificateChainDep_intermediate_certificate <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
20 Get Word8
getWord8
    [Word8]
_msgCertificateChainDep_corrections_certificate <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
20 Get Word8
getWord8
    UtcTime
_msgCertificateChainDep_expiration <- forall t. Binary t => Get t
get
    [Word8]
_msgCertificateChainDep_signature <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
64 Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgCertificateChainDep {[Word8]
UtcTime
_msgCertificateChainDep_signature :: [Word8]
_msgCertificateChainDep_expiration :: UtcTime
_msgCertificateChainDep_corrections_certificate :: [Word8]
_msgCertificateChainDep_intermediate_certificate :: [Word8]
_msgCertificateChainDep_root_certificate :: [Word8]
_msgCertificateChainDep_signature :: [Word8]
_msgCertificateChainDep_expiration :: UtcTime
_msgCertificateChainDep_corrections_certificate :: [Word8]
_msgCertificateChainDep_intermediate_certificate :: [Word8]
_msgCertificateChainDep_root_certificate :: [Word8]
..}

  put :: MsgCertificateChainDep -> Put
put MsgCertificateChainDep {[Word8]
UtcTime
_msgCertificateChainDep_signature :: [Word8]
_msgCertificateChainDep_expiration :: UtcTime
_msgCertificateChainDep_corrections_certificate :: [Word8]
_msgCertificateChainDep_intermediate_certificate :: [Word8]
_msgCertificateChainDep_root_certificate :: [Word8]
_msgCertificateChainDep_signature :: MsgCertificateChainDep -> [Word8]
_msgCertificateChainDep_expiration :: MsgCertificateChainDep -> UtcTime
_msgCertificateChainDep_corrections_certificate :: MsgCertificateChainDep -> [Word8]
_msgCertificateChainDep_intermediate_certificate :: MsgCertificateChainDep -> [Word8]
_msgCertificateChainDep_root_certificate :: MsgCertificateChainDep -> [Word8]
..} = do
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word8 -> Put
putWord8 [Word8]
_msgCertificateChainDep_root_certificate
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word8 -> Put
putWord8 [Word8]
_msgCertificateChainDep_intermediate_certificate
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word8 -> Put
putWord8 [Word8]
_msgCertificateChainDep_corrections_certificate
    forall t. Binary t => t -> Put
put UtcTime
_msgCertificateChainDep_expiration
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word8 -> Put
putWord8 [Word8]
_msgCertificateChainDep_signature

$(makeSBP 'msgCertificateChainDep ''MsgCertificateChainDep)
$(makeJSON "_msgCertificateChainDep_" ''MsgCertificateChainDep)
$(makeLenses ''MsgCertificateChainDep)

msgEcdsaSignature :: Word16
msgEcdsaSignature :: Word16
msgEcdsaSignature = Word16
0x0C08

-- | SBP class for message MSG_ECDSA_SIGNATURE (0x0C08).
--
-- An ECDSA-256 signature using SHA-256 as the message digest algorithm.
data MsgEcdsaSignature = MsgEcdsaSignature
  { MsgEcdsaSignature -> Word8
_msgEcdsaSignature_flags           :: !Word8
    -- ^ Describes the format of the `signed\_messages` field below.
  , MsgEcdsaSignature -> Word8
_msgEcdsaSignature_stream_counter  :: !Word8
    -- ^ Signature message counter. Zero indexed and incremented with each
    -- signature message.  The counter will not increment if this message was
    -- in response to an on demand request.  The counter will roll over after
    -- 256 messages. Upon connection, the value of the counter may not
    -- initially be zero.
  , MsgEcdsaSignature -> Word8
_msgEcdsaSignature_on_demand_counter :: !Word8
    -- ^ On demand message counter. Zero indexed and incremented with each
    -- signature message sent in response to an on demand message. The counter
    -- will roll over after 256 messages.  Upon connection, the value of the
    -- counter may not initially be zero.
  , MsgEcdsaSignature -> [Word8]
_msgEcdsaSignature_certificate_id  :: ![Word8]
    -- ^ The last 4 bytes of the certificate's SHA-1 fingerprint
  , MsgEcdsaSignature -> ECDSASignature
_msgEcdsaSignature_signature       :: !ECDSASignature
    -- ^ Signature over the frames of this message group.
  , MsgEcdsaSignature -> [Word8]
_msgEcdsaSignature_signed_messages :: ![Word8]
    -- ^ CRCs of the messages covered by this signature.  For Skylark, which
    -- delivers SBP messages wrapped in Swift's proprietary RTCM message,
    -- these are the 24-bit CRCs from the RTCM message framing. For SBP only
    -- streams, this will be 16-bit CRCs from the SBP framing.  See the
    -- `flags` field to determine the type of CRCs covered.
  } deriving ( Int -> MsgEcdsaSignature -> ShowS
[MsgEcdsaSignature] -> ShowS
MsgEcdsaSignature -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgEcdsaSignature] -> ShowS
$cshowList :: [MsgEcdsaSignature] -> ShowS
show :: MsgEcdsaSignature -> String
$cshow :: MsgEcdsaSignature -> String
showsPrec :: Int -> MsgEcdsaSignature -> ShowS
$cshowsPrec :: Int -> MsgEcdsaSignature -> ShowS
Show, ReadPrec [MsgEcdsaSignature]
ReadPrec MsgEcdsaSignature
Int -> ReadS MsgEcdsaSignature
ReadS [MsgEcdsaSignature]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgEcdsaSignature]
$creadListPrec :: ReadPrec [MsgEcdsaSignature]
readPrec :: ReadPrec MsgEcdsaSignature
$creadPrec :: ReadPrec MsgEcdsaSignature
readList :: ReadS [MsgEcdsaSignature]
$creadList :: ReadS [MsgEcdsaSignature]
readsPrec :: Int -> ReadS MsgEcdsaSignature
$creadsPrec :: Int -> ReadS MsgEcdsaSignature
Read, MsgEcdsaSignature -> MsgEcdsaSignature -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgEcdsaSignature -> MsgEcdsaSignature -> Bool
$c/= :: MsgEcdsaSignature -> MsgEcdsaSignature -> Bool
== :: MsgEcdsaSignature -> MsgEcdsaSignature -> Bool
$c== :: MsgEcdsaSignature -> MsgEcdsaSignature -> Bool
Eq )

instance Binary MsgEcdsaSignature where
  get :: Get MsgEcdsaSignature
get = do
    Word8
_msgEcdsaSignature_flags <- Get Word8
getWord8
    Word8
_msgEcdsaSignature_stream_counter <- Get Word8
getWord8
    Word8
_msgEcdsaSignature_on_demand_counter <- Get Word8
getWord8
    [Word8]
_msgEcdsaSignature_certificate_id <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
4 Get Word8
getWord8
    ECDSASignature
_msgEcdsaSignature_signature <- forall t. Binary t => Get t
get
    [Word8]
_msgEcdsaSignature_signed_messages <- forall (m :: * -> *) a. Monad m => m Bool -> m a -> m [a]
whileM (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Bool
isEmpty) Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgEcdsaSignature {[Word8]
Word8
ECDSASignature
_msgEcdsaSignature_signed_messages :: [Word8]
_msgEcdsaSignature_signature :: ECDSASignature
_msgEcdsaSignature_certificate_id :: [Word8]
_msgEcdsaSignature_on_demand_counter :: Word8
_msgEcdsaSignature_stream_counter :: Word8
_msgEcdsaSignature_flags :: Word8
_msgEcdsaSignature_signed_messages :: [Word8]
_msgEcdsaSignature_signature :: ECDSASignature
_msgEcdsaSignature_certificate_id :: [Word8]
_msgEcdsaSignature_on_demand_counter :: Word8
_msgEcdsaSignature_stream_counter :: Word8
_msgEcdsaSignature_flags :: Word8
..}

  put :: MsgEcdsaSignature -> Put
put MsgEcdsaSignature {[Word8]
Word8
ECDSASignature
_msgEcdsaSignature_signed_messages :: [Word8]
_msgEcdsaSignature_signature :: ECDSASignature
_msgEcdsaSignature_certificate_id :: [Word8]
_msgEcdsaSignature_on_demand_counter :: Word8
_msgEcdsaSignature_stream_counter :: Word8
_msgEcdsaSignature_flags :: Word8
_msgEcdsaSignature_signed_messages :: MsgEcdsaSignature -> [Word8]
_msgEcdsaSignature_signature :: MsgEcdsaSignature -> ECDSASignature
_msgEcdsaSignature_certificate_id :: MsgEcdsaSignature -> [Word8]
_msgEcdsaSignature_on_demand_counter :: MsgEcdsaSignature -> Word8
_msgEcdsaSignature_stream_counter :: MsgEcdsaSignature -> Word8
_msgEcdsaSignature_flags :: MsgEcdsaSignature -> Word8
..} = do
    Word8 -> Put
putWord8 Word8
_msgEcdsaSignature_flags
    Word8 -> Put
putWord8 Word8
_msgEcdsaSignature_stream_counter
    Word8 -> Put
putWord8 Word8
_msgEcdsaSignature_on_demand_counter
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word8 -> Put
putWord8 [Word8]
_msgEcdsaSignature_certificate_id
    forall t. Binary t => t -> Put
put ECDSASignature
_msgEcdsaSignature_signature
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word8 -> Put
putWord8 [Word8]
_msgEcdsaSignature_signed_messages

$(makeSBP 'msgEcdsaSignature ''MsgEcdsaSignature)
$(makeJSON "_msgEcdsaSignature_" ''MsgEcdsaSignature)
$(makeLenses ''MsgEcdsaSignature)

msgEcdsaSignatureDepB :: Word16
msgEcdsaSignatureDepB :: Word16
msgEcdsaSignatureDepB = Word16
0x0C07

-- | SBP class for message MSG_ECDSA_SIGNATURE_DEP_B (0x0C07).
--
-- Deprecated.
data MsgEcdsaSignatureDepB = MsgEcdsaSignatureDepB
  { MsgEcdsaSignatureDepB -> Word8
_msgEcdsaSignatureDepB_flags           :: !Word8
    -- ^ Describes the format of the `signed\_messages` field below.
  , MsgEcdsaSignatureDepB -> Word8
_msgEcdsaSignatureDepB_stream_counter  :: !Word8
    -- ^ Signature message counter. Zero indexed and incremented with each
    -- signature message.  The counter will not increment if this message was
    -- in response to an on demand request.  The counter will roll over after
    -- 256 messages. Upon connection, the value of the counter may not
    -- initially be zero.
  , MsgEcdsaSignatureDepB -> Word8
_msgEcdsaSignatureDepB_on_demand_counter :: !Word8
    -- ^ On demand message counter. Zero indexed and incremented with each
    -- signature message sent in response to an on demand message. The counter
    -- will roll over after 256 messages.  Upon connection, the value of the
    -- counter may not initially be zero.
  , MsgEcdsaSignatureDepB -> [Word8]
_msgEcdsaSignatureDepB_certificate_id  :: ![Word8]
    -- ^ The last 4 bytes of the certificate's SHA-1 fingerprint
  , MsgEcdsaSignatureDepB -> Word8
_msgEcdsaSignatureDepB_n_signature_bytes :: !Word8
    -- ^ Number of bytes to use of the signature field.  The DER encoded
    -- signature has a maximum size of 72 bytes but can vary between 70 and 72
    -- bytes in length.
  , MsgEcdsaSignatureDepB -> [Word8]
_msgEcdsaSignatureDepB_signature       :: ![Word8]
    -- ^ DER encoded ECDSA signature for the messages using SHA-256 as the
    -- digest algorithm.
  , MsgEcdsaSignatureDepB -> [Word8]
_msgEcdsaSignatureDepB_signed_messages :: ![Word8]
    -- ^ CRCs of the messages covered by this signature.  For Skylark, which
    -- delivers SBP messages wrapped in Swift's proprietary RTCM message,
    -- these are the 24-bit CRCs from the RTCM message framing. For SBP only
    -- streams, this will be 16-bit CRCs from the SBP framing.  See the
    -- `flags` field to determine the type of CRCs covered.
  } deriving ( Int -> MsgEcdsaSignatureDepB -> ShowS
[MsgEcdsaSignatureDepB] -> ShowS
MsgEcdsaSignatureDepB -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgEcdsaSignatureDepB] -> ShowS
$cshowList :: [MsgEcdsaSignatureDepB] -> ShowS
show :: MsgEcdsaSignatureDepB -> String
$cshow :: MsgEcdsaSignatureDepB -> String
showsPrec :: Int -> MsgEcdsaSignatureDepB -> ShowS
$cshowsPrec :: Int -> MsgEcdsaSignatureDepB -> ShowS
Show, ReadPrec [MsgEcdsaSignatureDepB]
ReadPrec MsgEcdsaSignatureDepB
Int -> ReadS MsgEcdsaSignatureDepB
ReadS [MsgEcdsaSignatureDepB]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgEcdsaSignatureDepB]
$creadListPrec :: ReadPrec [MsgEcdsaSignatureDepB]
readPrec :: ReadPrec MsgEcdsaSignatureDepB
$creadPrec :: ReadPrec MsgEcdsaSignatureDepB
readList :: ReadS [MsgEcdsaSignatureDepB]
$creadList :: ReadS [MsgEcdsaSignatureDepB]
readsPrec :: Int -> ReadS MsgEcdsaSignatureDepB
$creadsPrec :: Int -> ReadS MsgEcdsaSignatureDepB
Read, MsgEcdsaSignatureDepB -> MsgEcdsaSignatureDepB -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgEcdsaSignatureDepB -> MsgEcdsaSignatureDepB -> Bool
$c/= :: MsgEcdsaSignatureDepB -> MsgEcdsaSignatureDepB -> Bool
== :: MsgEcdsaSignatureDepB -> MsgEcdsaSignatureDepB -> Bool
$c== :: MsgEcdsaSignatureDepB -> MsgEcdsaSignatureDepB -> Bool
Eq )

instance Binary MsgEcdsaSignatureDepB where
  get :: Get MsgEcdsaSignatureDepB
get = do
    Word8
_msgEcdsaSignatureDepB_flags <- Get Word8
getWord8
    Word8
_msgEcdsaSignatureDepB_stream_counter <- Get Word8
getWord8
    Word8
_msgEcdsaSignatureDepB_on_demand_counter <- Get Word8
getWord8
    [Word8]
_msgEcdsaSignatureDepB_certificate_id <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
4 Get Word8
getWord8
    Word8
_msgEcdsaSignatureDepB_n_signature_bytes <- Get Word8
getWord8
    [Word8]
_msgEcdsaSignatureDepB_signature <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
72 Get Word8
getWord8
    [Word8]
_msgEcdsaSignatureDepB_signed_messages <- forall (m :: * -> *) a. Monad m => m Bool -> m a -> m [a]
whileM (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Bool
isEmpty) Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgEcdsaSignatureDepB {[Word8]
Word8
_msgEcdsaSignatureDepB_signed_messages :: [Word8]
_msgEcdsaSignatureDepB_signature :: [Word8]
_msgEcdsaSignatureDepB_n_signature_bytes :: Word8
_msgEcdsaSignatureDepB_certificate_id :: [Word8]
_msgEcdsaSignatureDepB_on_demand_counter :: Word8
_msgEcdsaSignatureDepB_stream_counter :: Word8
_msgEcdsaSignatureDepB_flags :: Word8
_msgEcdsaSignatureDepB_signed_messages :: [Word8]
_msgEcdsaSignatureDepB_signature :: [Word8]
_msgEcdsaSignatureDepB_n_signature_bytes :: Word8
_msgEcdsaSignatureDepB_certificate_id :: [Word8]
_msgEcdsaSignatureDepB_on_demand_counter :: Word8
_msgEcdsaSignatureDepB_stream_counter :: Word8
_msgEcdsaSignatureDepB_flags :: Word8
..}

  put :: MsgEcdsaSignatureDepB -> Put
put MsgEcdsaSignatureDepB {[Word8]
Word8
_msgEcdsaSignatureDepB_signed_messages :: [Word8]
_msgEcdsaSignatureDepB_signature :: [Word8]
_msgEcdsaSignatureDepB_n_signature_bytes :: Word8
_msgEcdsaSignatureDepB_certificate_id :: [Word8]
_msgEcdsaSignatureDepB_on_demand_counter :: Word8
_msgEcdsaSignatureDepB_stream_counter :: Word8
_msgEcdsaSignatureDepB_flags :: Word8
_msgEcdsaSignatureDepB_signed_messages :: MsgEcdsaSignatureDepB -> [Word8]
_msgEcdsaSignatureDepB_signature :: MsgEcdsaSignatureDepB -> [Word8]
_msgEcdsaSignatureDepB_n_signature_bytes :: MsgEcdsaSignatureDepB -> Word8
_msgEcdsaSignatureDepB_certificate_id :: MsgEcdsaSignatureDepB -> [Word8]
_msgEcdsaSignatureDepB_on_demand_counter :: MsgEcdsaSignatureDepB -> Word8
_msgEcdsaSignatureDepB_stream_counter :: MsgEcdsaSignatureDepB -> Word8
_msgEcdsaSignatureDepB_flags :: MsgEcdsaSignatureDepB -> Word8
..} = do
    Word8 -> Put
putWord8 Word8
_msgEcdsaSignatureDepB_flags
    Word8 -> Put
putWord8 Word8
_msgEcdsaSignatureDepB_stream_counter
    Word8 -> Put
putWord8 Word8
_msgEcdsaSignatureDepB_on_demand_counter
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word8 -> Put
putWord8 [Word8]
_msgEcdsaSignatureDepB_certificate_id
    Word8 -> Put
putWord8 Word8
_msgEcdsaSignatureDepB_n_signature_bytes
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word8 -> Put
putWord8 [Word8]
_msgEcdsaSignatureDepB_signature
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word8 -> Put
putWord8 [Word8]
_msgEcdsaSignatureDepB_signed_messages

$(makeSBP 'msgEcdsaSignatureDepB ''MsgEcdsaSignatureDepB)
$(makeJSON "_msgEcdsaSignatureDepB_" ''MsgEcdsaSignatureDepB)
$(makeLenses ''MsgEcdsaSignatureDepB)

msgEcdsaSignatureDepA :: Word16
msgEcdsaSignatureDepA :: Word16
msgEcdsaSignatureDepA = Word16
0x0C06

-- | SBP class for message MSG_ECDSA_SIGNATURE_DEP_A (0x0C06).
--
-- Deprecated.
data MsgEcdsaSignatureDepA = MsgEcdsaSignatureDepA
  { MsgEcdsaSignatureDepA -> Word8
_msgEcdsaSignatureDepA_flags           :: !Word8
    -- ^ Describes the format of the `signed\_messages` field below.
  , MsgEcdsaSignatureDepA -> Word8
_msgEcdsaSignatureDepA_stream_counter  :: !Word8
    -- ^ Signature message counter. Zero indexed and incremented with each
    -- signature message.  The counter will not increment if this message was
    -- in response to an on demand request.  The counter will roll over after
    -- 256 messages. Upon connection, the value of the counter may not
    -- initially be zero.
  , MsgEcdsaSignatureDepA -> Word8
_msgEcdsaSignatureDepA_on_demand_counter :: !Word8
    -- ^ On demand message counter. Zero indexed and incremented with each
    -- signature message sent in response to an on demand message. The counter
    -- will roll over after 256 messages.  Upon connection, the value of the
    -- counter may not initially be zero.
  , MsgEcdsaSignatureDepA -> [Word8]
_msgEcdsaSignatureDepA_certificate_id  :: ![Word8]
    -- ^ The last 4 bytes of the certificate's SHA-1 fingerprint
  , MsgEcdsaSignatureDepA -> [Word8]
_msgEcdsaSignatureDepA_signature       :: ![Word8]
    -- ^ ECDSA signature for the messages using SHA-256 as the digest algorithm.
  , MsgEcdsaSignatureDepA -> [Word8]
_msgEcdsaSignatureDepA_signed_messages :: ![Word8]
    -- ^ CRCs of the messages covered by this signature.  For Skylark, which
    -- delivers SBP messages wrapped in Swift's proprietary RTCM message,
    -- these are the 24-bit CRCs from the RTCM message framing. For SBP only
    -- streams, this will be 16-bit CRCs from the SBP framing.  See the
    -- `flags` field to determine the type of CRCs covered.
  } deriving ( Int -> MsgEcdsaSignatureDepA -> ShowS
[MsgEcdsaSignatureDepA] -> ShowS
MsgEcdsaSignatureDepA -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgEcdsaSignatureDepA] -> ShowS
$cshowList :: [MsgEcdsaSignatureDepA] -> ShowS
show :: MsgEcdsaSignatureDepA -> String
$cshow :: MsgEcdsaSignatureDepA -> String
showsPrec :: Int -> MsgEcdsaSignatureDepA -> ShowS
$cshowsPrec :: Int -> MsgEcdsaSignatureDepA -> ShowS
Show, ReadPrec [MsgEcdsaSignatureDepA]
ReadPrec MsgEcdsaSignatureDepA
Int -> ReadS MsgEcdsaSignatureDepA
ReadS [MsgEcdsaSignatureDepA]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgEcdsaSignatureDepA]
$creadListPrec :: ReadPrec [MsgEcdsaSignatureDepA]
readPrec :: ReadPrec MsgEcdsaSignatureDepA
$creadPrec :: ReadPrec MsgEcdsaSignatureDepA
readList :: ReadS [MsgEcdsaSignatureDepA]
$creadList :: ReadS [MsgEcdsaSignatureDepA]
readsPrec :: Int -> ReadS MsgEcdsaSignatureDepA
$creadsPrec :: Int -> ReadS MsgEcdsaSignatureDepA
Read, MsgEcdsaSignatureDepA -> MsgEcdsaSignatureDepA -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgEcdsaSignatureDepA -> MsgEcdsaSignatureDepA -> Bool
$c/= :: MsgEcdsaSignatureDepA -> MsgEcdsaSignatureDepA -> Bool
== :: MsgEcdsaSignatureDepA -> MsgEcdsaSignatureDepA -> Bool
$c== :: MsgEcdsaSignatureDepA -> MsgEcdsaSignatureDepA -> Bool
Eq )

instance Binary MsgEcdsaSignatureDepA where
  get :: Get MsgEcdsaSignatureDepA
get = do
    Word8
_msgEcdsaSignatureDepA_flags <- Get Word8
getWord8
    Word8
_msgEcdsaSignatureDepA_stream_counter <- Get Word8
getWord8
    Word8
_msgEcdsaSignatureDepA_on_demand_counter <- Get Word8
getWord8
    [Word8]
_msgEcdsaSignatureDepA_certificate_id <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
4 Get Word8
getWord8
    [Word8]
_msgEcdsaSignatureDepA_signature <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
64 Get Word8
getWord8
    [Word8]
_msgEcdsaSignatureDepA_signed_messages <- forall (m :: * -> *) a. Monad m => m Bool -> m a -> m [a]
whileM (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Bool
isEmpty) Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgEcdsaSignatureDepA {[Word8]
Word8
_msgEcdsaSignatureDepA_signed_messages :: [Word8]
_msgEcdsaSignatureDepA_signature :: [Word8]
_msgEcdsaSignatureDepA_certificate_id :: [Word8]
_msgEcdsaSignatureDepA_on_demand_counter :: Word8
_msgEcdsaSignatureDepA_stream_counter :: Word8
_msgEcdsaSignatureDepA_flags :: Word8
_msgEcdsaSignatureDepA_signed_messages :: [Word8]
_msgEcdsaSignatureDepA_signature :: [Word8]
_msgEcdsaSignatureDepA_certificate_id :: [Word8]
_msgEcdsaSignatureDepA_on_demand_counter :: Word8
_msgEcdsaSignatureDepA_stream_counter :: Word8
_msgEcdsaSignatureDepA_flags :: Word8
..}

  put :: MsgEcdsaSignatureDepA -> Put
put MsgEcdsaSignatureDepA {[Word8]
Word8
_msgEcdsaSignatureDepA_signed_messages :: [Word8]
_msgEcdsaSignatureDepA_signature :: [Word8]
_msgEcdsaSignatureDepA_certificate_id :: [Word8]
_msgEcdsaSignatureDepA_on_demand_counter :: Word8
_msgEcdsaSignatureDepA_stream_counter :: Word8
_msgEcdsaSignatureDepA_flags :: Word8
_msgEcdsaSignatureDepA_signed_messages :: MsgEcdsaSignatureDepA -> [Word8]
_msgEcdsaSignatureDepA_signature :: MsgEcdsaSignatureDepA -> [Word8]
_msgEcdsaSignatureDepA_certificate_id :: MsgEcdsaSignatureDepA -> [Word8]
_msgEcdsaSignatureDepA_on_demand_counter :: MsgEcdsaSignatureDepA -> Word8
_msgEcdsaSignatureDepA_stream_counter :: MsgEcdsaSignatureDepA -> Word8
_msgEcdsaSignatureDepA_flags :: MsgEcdsaSignatureDepA -> Word8
..} = do
    Word8 -> Put
putWord8 Word8
_msgEcdsaSignatureDepA_flags
    Word8 -> Put
putWord8 Word8
_msgEcdsaSignatureDepA_stream_counter
    Word8 -> Put
putWord8 Word8
_msgEcdsaSignatureDepA_on_demand_counter
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word8 -> Put
putWord8 [Word8]
_msgEcdsaSignatureDepA_certificate_id
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word8 -> Put
putWord8 [Word8]
_msgEcdsaSignatureDepA_signature
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word8 -> Put
putWord8 [Word8]
_msgEcdsaSignatureDepA_signed_messages

$(makeSBP 'msgEcdsaSignatureDepA ''MsgEcdsaSignatureDepA)
$(makeJSON "_msgEcdsaSignatureDepA_" ''MsgEcdsaSignatureDepA)
$(makeLenses ''MsgEcdsaSignatureDepA)

msgEd25519CertificateDep :: Word16
msgEd25519CertificateDep :: Word16
msgEd25519CertificateDep = Word16
0x0C02

-- | SBP class for message MSG_ED25519_CERTIFICATE_DEP (0x0C02).
--
-- Deprecated.
data MsgEd25519CertificateDep = MsgEd25519CertificateDep
  { MsgEd25519CertificateDep -> Word8
_msgEd25519CertificateDep_n_msg           :: !Word8
    -- ^ Total number messages that make up the certificate. First nibble is the
    -- size of the sequence (n), second nibble is the zero-indexed counter
    -- (ith packet of n)
  , MsgEd25519CertificateDep -> [Word8]
_msgEd25519CertificateDep_fingerprint     :: ![Word8]
    -- ^ SHA-1 fingerprint of the associated certificate.
  , MsgEd25519CertificateDep -> [Word8]
_msgEd25519CertificateDep_certificate_bytes :: ![Word8]
    -- ^ ED25519 certificate bytes.
  } deriving ( Int -> MsgEd25519CertificateDep -> ShowS
[MsgEd25519CertificateDep] -> ShowS
MsgEd25519CertificateDep -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgEd25519CertificateDep] -> ShowS
$cshowList :: [MsgEd25519CertificateDep] -> ShowS
show :: MsgEd25519CertificateDep -> String
$cshow :: MsgEd25519CertificateDep -> String
showsPrec :: Int -> MsgEd25519CertificateDep -> ShowS
$cshowsPrec :: Int -> MsgEd25519CertificateDep -> ShowS
Show, ReadPrec [MsgEd25519CertificateDep]
ReadPrec MsgEd25519CertificateDep
Int -> ReadS MsgEd25519CertificateDep
ReadS [MsgEd25519CertificateDep]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgEd25519CertificateDep]
$creadListPrec :: ReadPrec [MsgEd25519CertificateDep]
readPrec :: ReadPrec MsgEd25519CertificateDep
$creadPrec :: ReadPrec MsgEd25519CertificateDep
readList :: ReadS [MsgEd25519CertificateDep]
$creadList :: ReadS [MsgEd25519CertificateDep]
readsPrec :: Int -> ReadS MsgEd25519CertificateDep
$creadsPrec :: Int -> ReadS MsgEd25519CertificateDep
Read, MsgEd25519CertificateDep -> MsgEd25519CertificateDep -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgEd25519CertificateDep -> MsgEd25519CertificateDep -> Bool
$c/= :: MsgEd25519CertificateDep -> MsgEd25519CertificateDep -> Bool
== :: MsgEd25519CertificateDep -> MsgEd25519CertificateDep -> Bool
$c== :: MsgEd25519CertificateDep -> MsgEd25519CertificateDep -> Bool
Eq )

instance Binary MsgEd25519CertificateDep where
  get :: Get MsgEd25519CertificateDep
get = do
    Word8
_msgEd25519CertificateDep_n_msg <- Get Word8
getWord8
    [Word8]
_msgEd25519CertificateDep_fingerprint <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
20 Get Word8
getWord8
    [Word8]
_msgEd25519CertificateDep_certificate_bytes <- forall (m :: * -> *) a. Monad m => m Bool -> m a -> m [a]
whileM (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Bool
isEmpty) Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgEd25519CertificateDep {[Word8]
Word8
_msgEd25519CertificateDep_certificate_bytes :: [Word8]
_msgEd25519CertificateDep_fingerprint :: [Word8]
_msgEd25519CertificateDep_n_msg :: Word8
_msgEd25519CertificateDep_certificate_bytes :: [Word8]
_msgEd25519CertificateDep_fingerprint :: [Word8]
_msgEd25519CertificateDep_n_msg :: Word8
..}

  put :: MsgEd25519CertificateDep -> Put
put MsgEd25519CertificateDep {[Word8]
Word8
_msgEd25519CertificateDep_certificate_bytes :: [Word8]
_msgEd25519CertificateDep_fingerprint :: [Word8]
_msgEd25519CertificateDep_n_msg :: Word8
_msgEd25519CertificateDep_certificate_bytes :: MsgEd25519CertificateDep -> [Word8]
_msgEd25519CertificateDep_fingerprint :: MsgEd25519CertificateDep -> [Word8]
_msgEd25519CertificateDep_n_msg :: MsgEd25519CertificateDep -> Word8
..} = do
    Word8 -> Put
putWord8 Word8
_msgEd25519CertificateDep_n_msg
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word8 -> Put
putWord8 [Word8]
_msgEd25519CertificateDep_fingerprint
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word8 -> Put
putWord8 [Word8]
_msgEd25519CertificateDep_certificate_bytes

$(makeSBP 'msgEd25519CertificateDep ''MsgEd25519CertificateDep)
$(makeJSON "_msgEd25519CertificateDep_" ''MsgEd25519CertificateDep)
$(makeLenses ''MsgEd25519CertificateDep)

msgEd25519SignatureDepA :: Word16
msgEd25519SignatureDepA :: Word16
msgEd25519SignatureDepA = Word16
0x0C01

-- | SBP class for message MSG_ED25519_SIGNATURE_DEP_A (0x0C01).
--
-- Deprecated.
data MsgEd25519SignatureDepA = MsgEd25519SignatureDepA
  { MsgEd25519SignatureDepA -> [Word8]
_msgEd25519SignatureDepA_signature     :: ![Word8]
    -- ^ ED25519 signature for messages.
  , MsgEd25519SignatureDepA -> [Word8]
_msgEd25519SignatureDepA_fingerprint   :: ![Word8]
    -- ^ SHA-1 fingerprint of the associated certificate.
  , MsgEd25519SignatureDepA -> [Word32]
_msgEd25519SignatureDepA_signed_messages :: ![Word32]
    -- ^ CRCs of signed messages.
  } deriving ( Int -> MsgEd25519SignatureDepA -> ShowS
[MsgEd25519SignatureDepA] -> ShowS
MsgEd25519SignatureDepA -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgEd25519SignatureDepA] -> ShowS
$cshowList :: [MsgEd25519SignatureDepA] -> ShowS
show :: MsgEd25519SignatureDepA -> String
$cshow :: MsgEd25519SignatureDepA -> String
showsPrec :: Int -> MsgEd25519SignatureDepA -> ShowS
$cshowsPrec :: Int -> MsgEd25519SignatureDepA -> ShowS
Show, ReadPrec [MsgEd25519SignatureDepA]
ReadPrec MsgEd25519SignatureDepA
Int -> ReadS MsgEd25519SignatureDepA
ReadS [MsgEd25519SignatureDepA]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgEd25519SignatureDepA]
$creadListPrec :: ReadPrec [MsgEd25519SignatureDepA]
readPrec :: ReadPrec MsgEd25519SignatureDepA
$creadPrec :: ReadPrec MsgEd25519SignatureDepA
readList :: ReadS [MsgEd25519SignatureDepA]
$creadList :: ReadS [MsgEd25519SignatureDepA]
readsPrec :: Int -> ReadS MsgEd25519SignatureDepA
$creadsPrec :: Int -> ReadS MsgEd25519SignatureDepA
Read, MsgEd25519SignatureDepA -> MsgEd25519SignatureDepA -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgEd25519SignatureDepA -> MsgEd25519SignatureDepA -> Bool
$c/= :: MsgEd25519SignatureDepA -> MsgEd25519SignatureDepA -> Bool
== :: MsgEd25519SignatureDepA -> MsgEd25519SignatureDepA -> Bool
$c== :: MsgEd25519SignatureDepA -> MsgEd25519SignatureDepA -> Bool
Eq )

instance Binary MsgEd25519SignatureDepA where
  get :: Get MsgEd25519SignatureDepA
get = do
    [Word8]
_msgEd25519SignatureDepA_signature <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
64 Get Word8
getWord8
    [Word8]
_msgEd25519SignatureDepA_fingerprint <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
20 Get Word8
getWord8
    [Word32]
_msgEd25519SignatureDepA_signed_messages <- forall (m :: * -> *) a. Monad m => m Bool -> m a -> m [a]
whileM (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Bool
isEmpty) Get Word32
getWord32le
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgEd25519SignatureDepA {[Word8]
[Word32]
_msgEd25519SignatureDepA_signed_messages :: [Word32]
_msgEd25519SignatureDepA_fingerprint :: [Word8]
_msgEd25519SignatureDepA_signature :: [Word8]
_msgEd25519SignatureDepA_signed_messages :: [Word32]
_msgEd25519SignatureDepA_fingerprint :: [Word8]
_msgEd25519SignatureDepA_signature :: [Word8]
..}

  put :: MsgEd25519SignatureDepA -> Put
put MsgEd25519SignatureDepA {[Word8]
[Word32]
_msgEd25519SignatureDepA_signed_messages :: [Word32]
_msgEd25519SignatureDepA_fingerprint :: [Word8]
_msgEd25519SignatureDepA_signature :: [Word8]
_msgEd25519SignatureDepA_signed_messages :: MsgEd25519SignatureDepA -> [Word32]
_msgEd25519SignatureDepA_fingerprint :: MsgEd25519SignatureDepA -> [Word8]
_msgEd25519SignatureDepA_signature :: MsgEd25519SignatureDepA -> [Word8]
..} = do
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word8 -> Put
putWord8 [Word8]
_msgEd25519SignatureDepA_signature
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word8 -> Put
putWord8 [Word8]
_msgEd25519SignatureDepA_fingerprint
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word32 -> Put
putWord32le [Word32]
_msgEd25519SignatureDepA_signed_messages

$(makeSBP 'msgEd25519SignatureDepA ''MsgEd25519SignatureDepA)
$(makeJSON "_msgEd25519SignatureDepA_" ''MsgEd25519SignatureDepA)
$(makeLenses ''MsgEd25519SignatureDepA)

msgEd25519SignatureDepB :: Word16
msgEd25519SignatureDepB :: Word16
msgEd25519SignatureDepB = Word16
0x0C03

-- | SBP class for message MSG_ED25519_SIGNATURE_DEP_B (0x0C03).
--
-- Deprecated.
data MsgEd25519SignatureDepB = MsgEd25519SignatureDepB
  { MsgEd25519SignatureDepB -> Word8
_msgEd25519SignatureDepB_stream_counter  :: !Word8
    -- ^ Signature message counter. Zero indexed and incremented with each
    -- signature message.  The counter will not increment if this message was
    -- in response to an on demand request.  The counter will roll over after
    -- 256 messages. Upon connection, the value of the counter may not
    -- initially be zero.
  , MsgEd25519SignatureDepB -> Word8
_msgEd25519SignatureDepB_on_demand_counter :: !Word8
    -- ^ On demand message counter. Zero indexed and incremented with each
    -- signature message sent in response to an on demand message. The counter
    -- will roll over after 256 messages.  Upon connection, the value of the
    -- counter may not initially be zero.
  , MsgEd25519SignatureDepB -> [Word8]
_msgEd25519SignatureDepB_signature       :: ![Word8]
    -- ^ ED25519 signature for messages.
  , MsgEd25519SignatureDepB -> [Word8]
_msgEd25519SignatureDepB_fingerprint     :: ![Word8]
    -- ^ SHA-1 fingerprint of the associated certificate.
  , MsgEd25519SignatureDepB -> [Word32]
_msgEd25519SignatureDepB_signed_messages :: ![Word32]
    -- ^ CRCs of signed messages.
  } deriving ( Int -> MsgEd25519SignatureDepB -> ShowS
[MsgEd25519SignatureDepB] -> ShowS
MsgEd25519SignatureDepB -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgEd25519SignatureDepB] -> ShowS
$cshowList :: [MsgEd25519SignatureDepB] -> ShowS
show :: MsgEd25519SignatureDepB -> String
$cshow :: MsgEd25519SignatureDepB -> String
showsPrec :: Int -> MsgEd25519SignatureDepB -> ShowS
$cshowsPrec :: Int -> MsgEd25519SignatureDepB -> ShowS
Show, ReadPrec [MsgEd25519SignatureDepB]
ReadPrec MsgEd25519SignatureDepB
Int -> ReadS MsgEd25519SignatureDepB
ReadS [MsgEd25519SignatureDepB]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgEd25519SignatureDepB]
$creadListPrec :: ReadPrec [MsgEd25519SignatureDepB]
readPrec :: ReadPrec MsgEd25519SignatureDepB
$creadPrec :: ReadPrec MsgEd25519SignatureDepB
readList :: ReadS [MsgEd25519SignatureDepB]
$creadList :: ReadS [MsgEd25519SignatureDepB]
readsPrec :: Int -> ReadS MsgEd25519SignatureDepB
$creadsPrec :: Int -> ReadS MsgEd25519SignatureDepB
Read, MsgEd25519SignatureDepB -> MsgEd25519SignatureDepB -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgEd25519SignatureDepB -> MsgEd25519SignatureDepB -> Bool
$c/= :: MsgEd25519SignatureDepB -> MsgEd25519SignatureDepB -> Bool
== :: MsgEd25519SignatureDepB -> MsgEd25519SignatureDepB -> Bool
$c== :: MsgEd25519SignatureDepB -> MsgEd25519SignatureDepB -> Bool
Eq )

instance Binary MsgEd25519SignatureDepB where
  get :: Get MsgEd25519SignatureDepB
get = do
    Word8
_msgEd25519SignatureDepB_stream_counter <- Get Word8
getWord8
    Word8
_msgEd25519SignatureDepB_on_demand_counter <- Get Word8
getWord8
    [Word8]
_msgEd25519SignatureDepB_signature <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
64 Get Word8
getWord8
    [Word8]
_msgEd25519SignatureDepB_fingerprint <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
20 Get Word8
getWord8
    [Word32]
_msgEd25519SignatureDepB_signed_messages <- forall (m :: * -> *) a. Monad m => m Bool -> m a -> m [a]
whileM (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Bool
isEmpty) Get Word32
getWord32le
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgEd25519SignatureDepB {[Word8]
[Word32]
Word8
_msgEd25519SignatureDepB_signed_messages :: [Word32]
_msgEd25519SignatureDepB_fingerprint :: [Word8]
_msgEd25519SignatureDepB_signature :: [Word8]
_msgEd25519SignatureDepB_on_demand_counter :: Word8
_msgEd25519SignatureDepB_stream_counter :: Word8
_msgEd25519SignatureDepB_signed_messages :: [Word32]
_msgEd25519SignatureDepB_fingerprint :: [Word8]
_msgEd25519SignatureDepB_signature :: [Word8]
_msgEd25519SignatureDepB_on_demand_counter :: Word8
_msgEd25519SignatureDepB_stream_counter :: Word8
..}

  put :: MsgEd25519SignatureDepB -> Put
put MsgEd25519SignatureDepB {[Word8]
[Word32]
Word8
_msgEd25519SignatureDepB_signed_messages :: [Word32]
_msgEd25519SignatureDepB_fingerprint :: [Word8]
_msgEd25519SignatureDepB_signature :: [Word8]
_msgEd25519SignatureDepB_on_demand_counter :: Word8
_msgEd25519SignatureDepB_stream_counter :: Word8
_msgEd25519SignatureDepB_signed_messages :: MsgEd25519SignatureDepB -> [Word32]
_msgEd25519SignatureDepB_fingerprint :: MsgEd25519SignatureDepB -> [Word8]
_msgEd25519SignatureDepB_signature :: MsgEd25519SignatureDepB -> [Word8]
_msgEd25519SignatureDepB_on_demand_counter :: MsgEd25519SignatureDepB -> Word8
_msgEd25519SignatureDepB_stream_counter :: MsgEd25519SignatureDepB -> Word8
..} = do
    Word8 -> Put
putWord8 Word8
_msgEd25519SignatureDepB_stream_counter
    Word8 -> Put
putWord8 Word8
_msgEd25519SignatureDepB_on_demand_counter
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word8 -> Put
putWord8 [Word8]
_msgEd25519SignatureDepB_signature
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word8 -> Put
putWord8 [Word8]
_msgEd25519SignatureDepB_fingerprint
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word32 -> Put
putWord32le [Word32]
_msgEd25519SignatureDepB_signed_messages

$(makeSBP 'msgEd25519SignatureDepB ''MsgEd25519SignatureDepB)
$(makeJSON "_msgEd25519SignatureDepB_" ''MsgEd25519SignatureDepB)
$(makeLenses ''MsgEd25519SignatureDepB)