{-# LANGUAGE DerivingStrategies   #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE NamedFieldPuns       #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE PatternSynonyms      #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE StandaloneDeriving   #-}
{-# LANGUAGE TypeOperators        #-}
{-# LANGUAGE UndecidableInstances #-}

module DMQ.Protocol.SigSubmission.Type
  ( -- * Data types
    SigHash (..)
  , SigId (..)
  , SigBody (..)
  , SigKESSignature (..)
  , SigOpCertificate (..)
  , SigColdKey (..)
  , SigRaw (..)
  , SigRawWithSignedBytes (..)
  , Sig (Sig, SigWithBytes, sigRawWithSignedBytes, sigRawBytes, sigId, sigBody, sigExpiresAt, sigOpCertificate, sigKESPeriod, sigKESSignature, sigColdKey, sigSignedBytes, sigBytes)
  , validateSig
    -- * `TxSubmission` mini-protocol
  , SigSubmission
  , module SigSubmission
  , POSIXTime
    -- * Utilities
  , CBORBytes (..)
    -- * Re-exports from `kes-agent`
  , KESPeriod (..)
  ) where

import Data.Aeson
import Data.Bifunctor (first)
import Data.ByteString (ByteString)
import Data.ByteString.Base16 as BS.Base16
import Data.ByteString.Base16.Lazy as LBS.Base16
import Data.ByteString.Lazy qualified as LBS
import Data.ByteString.Lazy.Char8 qualified as LBS.Char8
import Data.Text.Encoding qualified as Text
import Data.Time.Clock.POSIX (POSIXTime)
import Data.Typeable
import Data.Word (Word64)

import Cardano.Crypto.DSIGN.Class (ContextDSIGN, DSIGNAlgorithm, VerKeyDSIGN)
import Cardano.Crypto.DSIGN.Class qualified as DSIGN
import Cardano.Crypto.KES.Class (KESAlgorithm (..), Signable)
import Cardano.KESAgent.KES.Crypto as KES
import Cardano.KESAgent.KES.OCert (KESPeriod (..), OCert (..), OCertSignable,
           validateOCert)

import Ouroboros.Network.Protocol.TxSubmission2.Type as SigSubmission hiding
           (TxSubmission2)
import Ouroboros.Network.Protocol.TxSubmission2.Type as TxSubmission2
import Ouroboros.Network.Util.ShowProxy


newtype SigHash = SigHash { SigHash -> ByteString
getSigHash :: ByteString }
  deriving stock (Int -> SigHash -> ShowS
[SigHash] -> ShowS
SigHash -> String
(Int -> SigHash -> ShowS)
-> (SigHash -> String) -> ([SigHash] -> ShowS) -> Show SigHash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SigHash -> ShowS
showsPrec :: Int -> SigHash -> ShowS
$cshow :: SigHash -> String
show :: SigHash -> String
$cshowList :: [SigHash] -> ShowS
showList :: [SigHash] -> ShowS
Show, SigHash -> SigHash -> Bool
(SigHash -> SigHash -> Bool)
-> (SigHash -> SigHash -> Bool) -> Eq SigHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SigHash -> SigHash -> Bool
== :: SigHash -> SigHash -> Bool
$c/= :: SigHash -> SigHash -> Bool
/= :: SigHash -> SigHash -> Bool
Eq, Eq SigHash
Eq SigHash =>
(SigHash -> SigHash -> Ordering)
-> (SigHash -> SigHash -> Bool)
-> (SigHash -> SigHash -> Bool)
-> (SigHash -> SigHash -> Bool)
-> (SigHash -> SigHash -> Bool)
-> (SigHash -> SigHash -> SigHash)
-> (SigHash -> SigHash -> SigHash)
-> Ord SigHash
SigHash -> SigHash -> Bool
SigHash -> SigHash -> Ordering
SigHash -> SigHash -> SigHash
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SigHash -> SigHash -> Ordering
compare :: SigHash -> SigHash -> Ordering
$c< :: SigHash -> SigHash -> Bool
< :: SigHash -> SigHash -> Bool
$c<= :: SigHash -> SigHash -> Bool
<= :: SigHash -> SigHash -> Bool
$c> :: SigHash -> SigHash -> Bool
> :: SigHash -> SigHash -> Bool
$c>= :: SigHash -> SigHash -> Bool
>= :: SigHash -> SigHash -> Bool
$cmax :: SigHash -> SigHash -> SigHash
max :: SigHash -> SigHash -> SigHash
$cmin :: SigHash -> SigHash -> SigHash
min :: SigHash -> SigHash -> SigHash
Ord)

newtype SigId = SigId { SigId -> SigHash
getSigId :: SigHash }
  deriving stock (Int -> SigId -> ShowS
[SigId] -> ShowS
SigId -> String
(Int -> SigId -> ShowS)
-> (SigId -> String) -> ([SigId] -> ShowS) -> Show SigId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SigId -> ShowS
showsPrec :: Int -> SigId -> ShowS
$cshow :: SigId -> String
show :: SigId -> String
$cshowList :: [SigId] -> ShowS
showList :: [SigId] -> ShowS
Show, SigId -> SigId -> Bool
(SigId -> SigId -> Bool) -> (SigId -> SigId -> Bool) -> Eq SigId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SigId -> SigId -> Bool
== :: SigId -> SigId -> Bool
$c/= :: SigId -> SigId -> Bool
/= :: SigId -> SigId -> Bool
Eq, Eq SigId
Eq SigId =>
(SigId -> SigId -> Ordering)
-> (SigId -> SigId -> Bool)
-> (SigId -> SigId -> Bool)
-> (SigId -> SigId -> Bool)
-> (SigId -> SigId -> Bool)
-> (SigId -> SigId -> SigId)
-> (SigId -> SigId -> SigId)
-> Ord SigId
SigId -> SigId -> Bool
SigId -> SigId -> Ordering
SigId -> SigId -> SigId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SigId -> SigId -> Ordering
compare :: SigId -> SigId -> Ordering
$c< :: SigId -> SigId -> Bool
< :: SigId -> SigId -> Bool
$c<= :: SigId -> SigId -> Bool
<= :: SigId -> SigId -> Bool
$c> :: SigId -> SigId -> Bool
> :: SigId -> SigId -> Bool
$c>= :: SigId -> SigId -> Bool
>= :: SigId -> SigId -> Bool
$cmax :: SigId -> SigId -> SigId
max :: SigId -> SigId -> SigId
$cmin :: SigId -> SigId -> SigId
min :: SigId -> SigId -> SigId
Ord)

instance ToJSON SigId where
  toJSON :: SigId -> Value
toJSON (SigId (SigHash ByteString
bs)) =
    Text -> Value
String (ByteString -> Text
Text.decodeUtf8Lenient (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BS.Base16.encode (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString
bs)

instance ShowProxy SigId where

newtype SigBody = SigBody { SigBody -> ByteString
getSigBody :: ByteString }
  deriving stock (Int -> SigBody -> ShowS
[SigBody] -> ShowS
SigBody -> String
(Int -> SigBody -> ShowS)
-> (SigBody -> String) -> ([SigBody] -> ShowS) -> Show SigBody
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SigBody -> ShowS
showsPrec :: Int -> SigBody -> ShowS
$cshow :: SigBody -> String
show :: SigBody -> String
$cshowList :: [SigBody] -> ShowS
showList :: [SigBody] -> ShowS
Show, SigBody -> SigBody -> Bool
(SigBody -> SigBody -> Bool)
-> (SigBody -> SigBody -> Bool) -> Eq SigBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SigBody -> SigBody -> Bool
== :: SigBody -> SigBody -> Bool
$c/= :: SigBody -> SigBody -> Bool
/= :: SigBody -> SigBody -> Bool
Eq)


newtype SigKESSignature crypto = SigKESSignature { forall crypto. SigKESSignature crypto -> SigKES (KES crypto)
getSigKESSignature :: SigKES (KES crypto) }

deriving instance Show (SigKES (KES crypto))
               => Show (SigKESSignature crypto)
deriving instance Eq (SigKES (KES crypto))
               => Eq (SigKESSignature crypto)

newtype SigOpCertificate crypto = SigOpCertificate { forall crypto. SigOpCertificate crypto -> OCert crypto
getSigOpCertificate :: OCert crypto }

deriving instance ( DSIGNAlgorithm (KES.DSIGN crypto)
                  , Show (VerKeyKES (KES crypto))
                  )
                => Show (SigOpCertificate crypto)
deriving instance ( DSIGNAlgorithm (KES.DSIGN crypto)
                  , Eq (VerKeyKES (KES crypto))
                  ) => Eq (SigOpCertificate crypto)


newtype SigColdKey crypto = SigColdKey { forall crypto. SigColdKey crypto -> VerKeyDSIGN (DSIGN crypto)
getSigColdKey :: VerKeyDSIGN (KES.DSIGN crypto) }

deriving instance Show (VerKeyDSIGN (KES.DSIGN crypto))
               => Show (SigColdKey crypto)

deriving instance Eq (VerKeyDSIGN (KES.DSIGN crypto))
               => Eq (SigColdKey crypto)

-- | Sig type consists of payload and its KES signature.
--
-- TODO: add signed bytes.
data SigRaw crypto = SigRaw {
    forall crypto. SigRaw crypto -> SigId
sigRawId            :: SigId,
    forall crypto. SigRaw crypto -> SigBody
sigRawBody          :: SigBody,
    forall crypto. SigRaw crypto -> KESPeriod
sigRawKESPeriod     :: KESPeriod,
    -- ^ KES period when this signature was created.
    --
    -- NOTE: `kes-agent` library is using `Word` for KES period, CIP-137
    -- requires `Word64`, thus we're only supporting 64-bit architectures.
    forall crypto. SigRaw crypto -> SigOpCertificate crypto
sigRawOpCertificate :: SigOpCertificate crypto,
    forall crypto. SigRaw crypto -> SigColdKey crypto
sigRawColdKey       :: SigColdKey crypto,
    forall crypto. SigRaw crypto -> POSIXTime
sigRawExpiresAt     :: POSIXTime,
    forall crypto. SigRaw crypto -> SigKESSignature crypto
sigRawKESSignature  :: SigKESSignature crypto
    -- ^ KES signature of all previous fields.
    --
    -- NOTE: this field must be lazy, otetherwise tests will fail.
  }

deriving instance ( DSIGNAlgorithm (KES.DSIGN crypto)
                  , Show (VerKeyKES (KES crypto))
                  , Show (SigKES (KES crypto))
                  )
               => Show (SigRaw crypto)
deriving instance ( DSIGNAlgorithm (KES.DSIGN crypto)
                  , Eq (VerKeyKES (KES crypto))
                  , Eq (SigKES (KES crypto))
                  )
               => Eq (SigRaw crypto)

instance Crypto crypto
      => ToJSON (SigRaw crypto) where
  -- TODO: it is too verbose, we need verbosity levels for these JSON fields
  toJSON :: SigRaw crypto -> Value
toJSON SigRaw { SigId
sigRawId :: forall crypto. SigRaw crypto -> SigId
sigRawId :: SigId
sigRawId
             {- , sigRawBody
                , sigRawKESPeriod
                , sigRawExpiresAt
                , sigRawKESSignature
                , sigRawOpCertificate
                , sigRawColdKey -}
                } =
    [Pair] -> Value
object [ Key
"id"            Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ByteString -> String
forall a. Show a => a -> String
show (SigHash -> ByteString
getSigHash (SigId -> SigHash
getSigId SigId
sigRawId))
        {- , "body"          .= show (getSigBody sigRawBody)
           , "kesPeriod"     .= sigRawKESPeriod
           , "expiresAt"     .= show sigRawExpiresAt
           , "kesSignature"  .= show (getSigKESSignature sigRawKESSignature)

           , "opCertificate" .= show (getSignableRepresentation signable)
           , "coldKey"       .= show (getSigColdKey sigRawColdKey) -}
           ]
        {-
        where
          ocert    = getSigOpCertificate sigRawOpCertificate
          signable :: OCertSignable crypto
          signable = OCertSignable (ocertVkHot ocert) (ocertN ocert) (ocertKESPeriod ocert)
        -}

data SigRawWithSignedBytes crypto = SigRawWithSignedBytes {
    forall crypto. SigRawWithSignedBytes crypto -> ByteString
sigRawSignedBytes :: LBS.ByteString,
    -- ^ bytes signed by the KES key
    forall crypto. SigRawWithSignedBytes crypto -> SigRaw crypto
sigRaw            :: SigRaw crypto
    -- ^ the `SigRaw` data type
  }

deriving instance ( DSIGNAlgorithm (KES.DSIGN crypto)
                  , Show (VerKeyKES (KES crypto))
                  , Show (SigKES (KES crypto))
                  )
               => Show (SigRawWithSignedBytes crypto)
deriving instance ( DSIGNAlgorithm (KES.DSIGN crypto)
                  , Eq (VerKeyKES (KES crypto))
                  , Eq (SigKES (KES crypto))
                  )
               => Eq (SigRawWithSignedBytes crypto)

instance Crypto crypto
      => ToJSON (SigRawWithSignedBytes crypto) where
  toJSON :: SigRawWithSignedBytes crypto -> Value
toJSON SigRawWithSignedBytes {SigRaw crypto
sigRaw :: forall crypto. SigRawWithSignedBytes crypto -> SigRaw crypto
sigRaw :: SigRaw crypto
sigRaw} = SigRaw crypto -> Value
forall a. ToJSON a => a -> Value
toJSON SigRaw crypto
sigRaw


data Sig crypto = SigWithBytes {
    forall crypto. Sig crypto -> ByteString
sigRawBytes           :: LBS.ByteString,
    -- ^ encoded `SigRaw` data type
    forall crypto. Sig crypto -> SigRawWithSignedBytes crypto
sigRawWithSignedBytes :: SigRawWithSignedBytes crypto
    -- ^ the `SigRaw` data type along with signed bytes
  }

deriving instance ( DSIGNAlgorithm (KES.DSIGN crypto)
                  , Show (VerKeyKES (KES crypto))
                  , Show (SigKES (KES crypto))
                  )
               => Show (Sig crypto)
deriving instance ( DSIGNAlgorithm (KES.DSIGN crypto)
                  , Eq (VerKeyKES (KES crypto))
                  , Eq (SigKES (KES crypto))
                  )
               => Eq (Sig crypto)

instance Crypto crypto
      => ToJSON (Sig crypto) where
  toJSON :: Sig crypto -> Value
toJSON SigWithBytes {SigRawWithSignedBytes crypto
sigRawWithSignedBytes :: forall crypto. Sig crypto -> SigRawWithSignedBytes crypto
sigRawWithSignedBytes :: SigRawWithSignedBytes crypto
sigRawWithSignedBytes} = SigRawWithSignedBytes crypto -> Value
forall a. ToJSON a => a -> Value
toJSON SigRawWithSignedBytes crypto
sigRawWithSignedBytes

-- | A convenient bidirectional pattern synonym for the `Sig` type.
--
pattern Sig
  :: SigId
  -> SigBody
  -> SigKESSignature crypto
  -> KESPeriod
  -> SigOpCertificate crypto
  -> SigColdKey crypto
  -> POSIXTime
  -> LBS.ByteString
  -> LBS.ByteString
  -> Sig crypto
pattern
    $mSig :: forall {r} {crypto}.
Sig crypto
-> (SigId
    -> SigBody
    -> SigKESSignature crypto
    -> KESPeriod
    -> SigOpCertificate crypto
    -> SigColdKey crypto
    -> POSIXTime
    -> ByteString
    -> ByteString
    -> r)
-> ((# #) -> r)
-> r
$bSig :: forall crypto.
SigId
-> SigBody
-> SigKESSignature crypto
-> KESPeriod
-> SigOpCertificate crypto
-> SigColdKey crypto
-> POSIXTime
-> ByteString
-> ByteString
-> Sig crypto
Sig { forall crypto. Sig crypto -> SigId
sigId,
          forall crypto. Sig crypto -> SigBody
sigBody,
          forall crypto. Sig crypto -> SigKESSignature crypto
sigKESSignature,
          forall crypto. Sig crypto -> KESPeriod
sigKESPeriod,
          forall crypto. Sig crypto -> SigOpCertificate crypto
sigOpCertificate,
          forall crypto. Sig crypto -> SigColdKey crypto
sigColdKey,
          forall crypto. Sig crypto -> POSIXTime
sigExpiresAt,
          forall crypto. Sig crypto -> ByteString
sigSignedBytes,
          forall crypto. Sig crypto -> ByteString
sigBytes
        }
    <-
    SigWithBytes {
      sigRawBytes = sigBytes,
      sigRawWithSignedBytes =
        SigRawWithSignedBytes {
          sigRawSignedBytes = sigSignedBytes,
          sigRaw = SigRaw {
            sigRawId            = sigId,
            sigRawBody          = sigBody,
            sigRawKESSignature  = sigKESSignature,
            sigRawKESPeriod     = sigKESPeriod,
            sigRawOpCertificate = sigOpCertificate,
            sigRawColdKey       = sigColdKey,
            sigRawExpiresAt     = sigExpiresAt
          }
        }
      }
  where
    Sig SigId
sigRawId
        SigBody
sigRawBody
        SigKESSignature crypto
sigRawKESSignature
        KESPeriod
sigRawKESPeriod
        SigOpCertificate crypto
sigRawOpCertificate
        SigColdKey crypto
sigRawColdKey
        POSIXTime
sigRawExpiresAt
        ByteString
sigRawSignedBytes
        ByteString
sigRawBytes
      =
      SigWithBytes {
        sigRawBytes :: ByteString
sigRawBytes = ByteString
sigRawBytes,
        sigRawWithSignedBytes :: SigRawWithSignedBytes crypto
sigRawWithSignedBytes = SigRawWithSignedBytes {
          ByteString
sigRawSignedBytes :: ByteString
sigRawSignedBytes :: ByteString
sigRawSignedBytes,
          sigRaw :: SigRaw crypto
sigRaw = SigRaw {
            SigId
sigRawId :: SigId
sigRawId :: SigId
sigRawId,
            SigBody
sigRawBody :: SigBody
sigRawBody :: SigBody
sigRawBody,
            KESPeriod
sigRawKESPeriod :: KESPeriod
sigRawKESPeriod :: KESPeriod
sigRawKESPeriod,
            SigKESSignature crypto
sigRawKESSignature :: SigKESSignature crypto
sigRawKESSignature :: SigKESSignature crypto
sigRawKESSignature,
            SigOpCertificate crypto
sigRawOpCertificate :: SigOpCertificate crypto
sigRawOpCertificate :: SigOpCertificate crypto
sigRawOpCertificate,
            SigColdKey crypto
sigRawColdKey :: SigColdKey crypto
sigRawColdKey :: SigColdKey crypto
sigRawColdKey,
            POSIXTime
sigRawExpiresAt :: POSIXTime
sigRawExpiresAt :: POSIXTime
sigRawExpiresAt
          }
        }
      }
{-# COMPLETE Sig #-}

instance Typeable crypto => ShowProxy (Sig crypto) where


data SigValidationError =
    InvalidKESSignature KESPeriod KESPeriod String
  | InvalidSignatureOCERT
      !Word64    -- OCert counter
      !KESPeriod -- OCert KES period
      !String    -- DSIGN error message
  | KESBeforeStartOCERT KESPeriod KESPeriod
  | KESAfterEndOCERT KESPeriod KESPeriod
  deriving Int -> SigValidationError -> ShowS
[SigValidationError] -> ShowS
SigValidationError -> String
(Int -> SigValidationError -> ShowS)
-> (SigValidationError -> String)
-> ([SigValidationError] -> ShowS)
-> Show SigValidationError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SigValidationError -> ShowS
showsPrec :: Int -> SigValidationError -> ShowS
$cshow :: SigValidationError -> String
show :: SigValidationError -> String
$cshowList :: [SigValidationError] -> ShowS
showList :: [SigValidationError] -> ShowS
Show

validateSig :: forall crypto.
               ( Crypto crypto
               , ContextDSIGN (KES.DSIGN crypto) ~ ()
               , DSIGN.Signable (DSIGN crypto) (OCertSignable crypto)
               , ContextKES (KES crypto) ~ ()
               , Signable (KES crypto) ByteString
               )
            => Sig crypto
            -> Either SigValidationError ()
validateSig :: forall crypto.
(Crypto crypto, ContextDSIGN (DSIGN crypto) ~ (),
 Signable (DSIGN crypto) (OCertSignable crypto),
 ContextKES (KES crypto) ~ (), Signable (KES crypto) ByteString) =>
Sig crypto -> Either SigValidationError ()
validateSig Sig { sigSignedBytes :: forall crypto. Sig crypto -> ByteString
sigSignedBytes = ByteString
signedBytes,
                  KESPeriod
sigKESPeriod :: forall crypto. Sig crypto -> KESPeriod
sigKESPeriod :: KESPeriod
sigKESPeriod,
                  sigOpCertificate :: forall crypto. Sig crypto -> SigOpCertificate crypto
sigOpCertificate = SigOpCertificate ocert :: OCert crypto
ocert@OCert {
                      KESPeriod
ocertKESPeriod :: KESPeriod
ocertKESPeriod :: forall c. OCert c -> KESPeriod
ocertKESPeriod,
                      VerKeyKES (KES crypto)
ocertVkHot :: VerKeyKES (KES crypto)
ocertVkHot :: forall c. OCert c -> VerKeyKES (KES c)
ocertVkHot,
                      Word64
ocertN :: Word64
ocertN :: forall c. OCert c -> Word64
ocertN
                  },
                  sigColdKey :: forall crypto. Sig crypto -> SigColdKey crypto
sigColdKey = SigColdKey VerKeyDSIGN (DSIGN crypto)
coldKey,
                  sigKESSignature :: forall crypto. Sig crypto -> SigKESSignature crypto
sigKESSignature = SigKESSignature SigKES (KES crypto)
kesSig
                }
            = do
            KESPeriod
sigKESPeriod KESPeriod -> KESPeriod -> Bool
forall a. Ord a => a -> a -> Bool
< KESPeriod
endKESPeriod
              Bool -> SigValidationError -> Either SigValidationError ()
forall e. Bool -> e -> Either e ()
?!  KESPeriod -> KESPeriod -> SigValidationError
KESAfterEndOCERT KESPeriod
endKESPeriod KESPeriod
sigKESPeriod
            KESPeriod
sigKESPeriod KESPeriod -> KESPeriod -> Bool
forall a. Ord a => a -> a -> Bool
>= KESPeriod
startKESPeriod
              Bool -> SigValidationError -> Either SigValidationError ()
forall e. Bool -> e -> Either e ()
?!  KESPeriod -> KESPeriod -> SigValidationError
KESBeforeStartOCERT KESPeriod
startKESPeriod KESPeriod
sigKESPeriod

            -- validate OCert, which includes verifying its signature
            VerKeyDSIGN (DSIGN crypto)
-> VerKeyKES (KES crypto) -> OCert crypto -> Either String ()
forall c.
(Crypto c, ContextDSIGN (DSIGN c) ~ (),
 Signable (DSIGN c) (OCertSignable c)) =>
VerKeyDSIGN (DSIGN c)
-> VerKeyKES (KES c) -> OCert c -> Either String ()
validateOCert VerKeyDSIGN (DSIGN crypto)
coldKey VerKeyKES (KES crypto)
ocertVkHot OCert crypto
ocert
              Either String ()
-> (String -> SigValidationError) -> Either SigValidationError ()
forall e1 a e2. Either e1 a -> (e1 -> e2) -> Either e2 a
?!: Word64 -> KESPeriod -> String -> SigValidationError
InvalidSignatureOCERT Word64
ocertN KESPeriod
sigKESPeriod
            -- validate KES signature of the payload
            ContextKES (KES crypto)
-> VerKeyKES (KES crypto)
-> Word
-> ByteString
-> SigKES (KES crypto)
-> Either String ()
forall v a.
(KESAlgorithm v, Signable v a, HasCallStack) =>
ContextKES v
-> VerKeyKES v -> Word -> a -> SigKES v -> Either String ()
forall a.
(Signable (KES crypto) a, HasCallStack) =>
ContextKES (KES crypto)
-> VerKeyKES (KES crypto)
-> Word
-> a
-> SigKES (KES crypto)
-> Either String ()
verifyKES () VerKeyKES (KES crypto)
ocertVkHot
                         (KESPeriod -> Word
unKESPeriod KESPeriod
sigKESPeriod Word -> Word -> Word
forall a. Num a => a -> a -> a
- KESPeriod -> Word
unKESPeriod KESPeriod
startKESPeriod)
                         (ByteString -> ByteString
LBS.toStrict ByteString
signedBytes)
                         SigKES (KES crypto)
kesSig
              Either String ()
-> (String -> SigValidationError) -> Either SigValidationError ()
forall e1 a e2. Either e1 a -> (e1 -> e2) -> Either e2 a
?!: KESPeriod -> KESPeriod -> String -> SigValidationError
InvalidKESSignature KESPeriod
ocertKESPeriod KESPeriod
sigKESPeriod
  where
    startKESPeriod, endKESPeriod :: KESPeriod

    startKESPeriod :: KESPeriod
startKESPeriod = KESPeriod
ocertKESPeriod
    -- TODO: is `totalPeriodsKES` the same as `praosMaxKESEvo`
    -- or `sgMaxKESEvolution` in the genesis file?
    endKESPeriod :: KESPeriod
endKESPeriod   = Word -> KESPeriod
KESPeriod (Word -> KESPeriod) -> Word -> KESPeriod
forall a b. (a -> b) -> a -> b
$ KESPeriod -> Word
unKESPeriod KESPeriod
startKESPeriod
                               Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Proxy (KES crypto) -> Word
forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> Word
forall (proxy :: * -> *). proxy (KES crypto) -> Word
totalPeriodsKES (Proxy (KES crypto)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (KES crypto))

type SigSubmission crypto = TxSubmission2.TxSubmission2 SigId (Sig crypto)


--
-- Utilities
--

-- | A newtype wrapper to show CBOR bytes in hex format.
--
newtype CBORBytes = CBORBytes { CBORBytes -> ByteString
getCBORBytes :: LBS.ByteString }
  deriving CBORBytes -> CBORBytes -> Bool
(CBORBytes -> CBORBytes -> Bool)
-> (CBORBytes -> CBORBytes -> Bool) -> Eq CBORBytes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CBORBytes -> CBORBytes -> Bool
== :: CBORBytes -> CBORBytes -> Bool
$c/= :: CBORBytes -> CBORBytes -> Bool
/= :: CBORBytes -> CBORBytes -> Bool
Eq

instance Show CBORBytes where
  show :: CBORBytes -> String
show = ByteString -> String
LBS.Char8.unpack (ByteString -> String)
-> (CBORBytes -> ByteString) -> CBORBytes -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.Base16.encode (ByteString -> ByteString)
-> (CBORBytes -> ByteString) -> CBORBytes -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CBORBytes -> ByteString
getCBORBytes


--
-- Utility functions
--

(?!:) :: Either e1 a -> (e1 -> e2) -> Either e2 a
?!: :: forall e1 a e2. Either e1 a -> (e1 -> e2) -> Either e2 a
(?!:) = ((e1 -> e2) -> Either e1 a -> Either e2 a)
-> Either e1 a -> (e1 -> e2) -> Either e2 a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (e1 -> e2) -> Either e1 a -> Either e2 a
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first

infix 1 ?!:

(?!) :: Bool -> e -> Either e ()
?! :: forall e. Bool -> e -> Either e ()
(?!) Bool
True  e
_ = () -> Either e ()
forall a b. b -> Either a b
Right ()
(?!) Bool
False e
e = e -> Either e ()
forall a b. a -> Either a b
Left e
e

infix 1 ?!