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

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

import Data.Aeson
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 Cardano.Crypto.DSIGN.Class (DSIGNAlgorithm)
import Cardano.Crypto.KES.Class (VerKeyKES)
-- import Cardano.Crypto.Util (SignableRepresentation (..))
import Cardano.KESAgent.KES.Crypto as KES
import Cardano.KESAgent.KES.OCert (OCert (..))

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)


-- TODO:
-- This type should be something like: `SignedKES (KES crypto) SigPayload`
newtype SigKESSignature = SigKESSignature { SigKESSignature -> ByteString
getSigKESSignature :: ByteString }
  deriving stock (Int -> SigKESSignature -> ShowS
[SigKESSignature] -> ShowS
SigKESSignature -> String
(Int -> SigKESSignature -> ShowS)
-> (SigKESSignature -> String)
-> ([SigKESSignature] -> ShowS)
-> Show SigKESSignature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SigKESSignature -> ShowS
showsPrec :: Int -> SigKESSignature -> ShowS
$cshow :: SigKESSignature -> String
show :: SigKESSignature -> String
$cshowList :: [SigKESSignature] -> ShowS
showList :: [SigKESSignature] -> ShowS
Show, SigKESSignature -> SigKESSignature -> Bool
(SigKESSignature -> SigKESSignature -> Bool)
-> (SigKESSignature -> SigKESSignature -> Bool)
-> Eq SigKESSignature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SigKESSignature -> SigKESSignature -> Bool
== :: SigKESSignature -> SigKESSignature -> Bool
$c/= :: SigKESSignature -> SigKESSignature -> Bool
/= :: SigKESSignature -> SigKESSignature -> Bool
Eq)

-- TODO:
-- This type should be more than just a `ByteString`.
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)


type SigKESPeriod = Word

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

-- | 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 -> SigKESPeriod
sigRawKESPeriod     :: SigKESPeriod,
    -- ^ 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 -> POSIXTime
sigRawExpiresAt     :: POSIXTime,
    forall crypto. SigRaw crypto -> SigKESSignature
sigRawKESSignature  :: SigKESSignature,
    forall crypto. SigRaw crypto -> SigOpCertificate crypto
sigRawOpCertificate :: SigOpCertificate crypto,
    forall crypto. SigRaw crypto -> SigColdKey
sigRawColdKey       :: SigColdKey
  }

deriving instance ( DSIGNAlgorithm (KES.DSIGN crypto)
                  , Show (VerKeyKES (KES crypto))
                  )
               => Show (SigRaw crypto)
deriving instance ( DSIGNAlgorithm (KES.DSIGN crypto)
                  , Eq (VerKeyKES (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 (SigRawWithSignedBytes crypto)
deriving instance ( DSIGNAlgorithm (KES.DSIGN crypto)
                  , Eq (VerKeyKES (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 (Sig crypto)
deriving instance ( DSIGNAlgorithm (KES.DSIGN crypto)
                  , Eq (VerKeyKES (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
  -> SigKESPeriod
  -> SigOpCertificate crypto
  -> SigColdKey
  -> POSIXTime
  -> LBS.ByteString
  -> LBS.ByteString
  -> Sig crypto
pattern
    $mSig :: forall {r} {crypto}.
Sig crypto
-> (SigId
    -> SigBody
    -> SigKESSignature
    -> SigKESPeriod
    -> SigOpCertificate crypto
    -> SigColdKey
    -> POSIXTime
    -> ByteString
    -> ByteString
    -> r)
-> ((# #) -> r)
-> r
$bSig :: forall crypto.
SigId
-> SigBody
-> SigKESSignature
-> SigKESPeriod
-> SigOpCertificate crypto
-> SigColdKey
-> POSIXTime
-> ByteString
-> ByteString
-> Sig crypto
Sig { forall crypto. Sig crypto -> SigId
sigId,
          forall crypto. Sig crypto -> SigBody
sigBody,
          forall crypto. Sig crypto -> SigKESSignature
sigKESSignature,
          forall crypto. Sig crypto -> SigKESPeriod
sigKESPeriod,
          forall crypto. Sig crypto -> SigOpCertificate crypto
sigOpCertificate,
          forall crypto. Sig crypto -> SigColdKey
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
sigRawKESSignature
        SigKESPeriod
sigRawKESPeriod
        SigOpCertificate crypto
sigRawOpCertificate
        SigColdKey
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,
            SigKESPeriod
sigRawKESPeriod :: SigKESPeriod
sigRawKESPeriod :: SigKESPeriod
sigRawKESPeriod,
            SigKESSignature
sigRawKESSignature :: SigKESSignature
sigRawKESSignature :: SigKESSignature
sigRawKESSignature,
            SigOpCertificate crypto
sigRawOpCertificate :: SigOpCertificate crypto
sigRawOpCertificate :: SigOpCertificate crypto
sigRawOpCertificate,
            SigColdKey
sigRawColdKey :: SigColdKey
sigRawColdKey :: SigColdKey
sigRawColdKey,
            POSIXTime
sigRawExpiresAt :: POSIXTime
sigRawExpiresAt :: POSIXTime
sigRawExpiresAt
          }
        }
      }
{-# COMPLETE Sig #-}

instance Typeable crypto => ShowProxy (Sig crypto) where

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