{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE NamedFieldPuns     #-}
{-# LANGUAGE PatternSynonyms    #-}

module DMQ.Protocol.SigSubmission.Type
  ( -- * Data types
    SigHash (..)
  , SigId (..)
  , SigBody (..)
  , SigKesSignature (..)
  , SigOpCertificate (..)
  , Sig (SigRaw, Sig, sigId, sigBody, sigExpiresAt, sigOpCertificate, sigKesSignature)
    -- * `TxSubmission` mini-protocol
  , SigSubmission
  , module SigSubmission
  ) where

import Data.ByteString (ByteString)
import Data.Time.Clock.POSIX (POSIXTime)

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 ShowProxy SigId where
  showProxy :: Proxy SigId -> String
showProxy Proxy SigId
_ = String
"SigId"

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)

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

-- | Sig type consists of payload and its KES signature.
--
data Sig = SigRaw {
    Sig -> SigPayload
sigRawPayload      :: SigPayload,
    Sig -> SigKesSignature
sigRawKesSignature :: SigKesSignature
  }
  deriving stock (Int -> Sig -> ShowS
[Sig] -> ShowS
Sig -> String
(Int -> Sig -> ShowS)
-> (Sig -> String) -> ([Sig] -> ShowS) -> Show Sig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Sig -> ShowS
showsPrec :: Int -> Sig -> ShowS
$cshow :: Sig -> String
show :: Sig -> String
$cshowList :: [Sig] -> ShowS
showList :: [Sig] -> ShowS
Show, Sig -> Sig -> Bool
(Sig -> Sig -> Bool) -> (Sig -> Sig -> Bool) -> Eq Sig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Sig -> Sig -> Bool
== :: Sig -> Sig -> Bool
$c/= :: Sig -> Sig -> Bool
/= :: Sig -> Sig -> Bool
Eq)

data SigPayload = SigPayload {
    SigPayload -> SigId
sigPayloadId            :: SigId,
    SigPayload -> SigBody
sigPayloadBody          :: SigBody,
    SigPayload -> POSIXTime
sigPayloadExpiresAt     :: POSIXTime,
    SigPayload -> SigOpCertificate
sigPayloadOpCertificate :: SigOpCertificate
  }
  deriving stock (Int -> SigPayload -> ShowS
[SigPayload] -> ShowS
SigPayload -> String
(Int -> SigPayload -> ShowS)
-> (SigPayload -> String)
-> ([SigPayload] -> ShowS)
-> Show SigPayload
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SigPayload -> ShowS
showsPrec :: Int -> SigPayload -> ShowS
$cshow :: SigPayload -> String
show :: SigPayload -> String
$cshowList :: [SigPayload] -> ShowS
showList :: [SigPayload] -> ShowS
Show, SigPayload -> SigPayload -> Bool
(SigPayload -> SigPayload -> Bool)
-> (SigPayload -> SigPayload -> Bool) -> Eq SigPayload
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SigPayload -> SigPayload -> Bool
== :: SigPayload -> SigPayload -> Bool
$c/= :: SigPayload -> SigPayload -> Bool
/= :: SigPayload -> SigPayload -> Bool
Eq)

-- | A convenient bidirectional pattern synonym for the `Sig` type.
--
pattern Sig
  :: SigId
  -> SigBody
  -> POSIXTime
  -> SigOpCertificate
  -> SigKesSignature
  -> Sig
pattern
    $mSig :: forall {r}.
Sig
-> (SigId
    -> SigBody
    -> POSIXTime
    -> SigOpCertificate
    -> SigKesSignature
    -> r)
-> ((# #) -> r)
-> r
$bSig :: SigId
-> SigBody
-> POSIXTime
-> SigOpCertificate
-> SigKesSignature
-> Sig
Sig { Sig -> SigId
sigId,
          Sig -> SigBody
sigBody,
          Sig -> POSIXTime
sigExpiresAt,
          Sig -> SigOpCertificate
sigOpCertificate,
          Sig -> SigKesSignature
sigKesSignature
        }
    <-
    SigRaw {
      sigRawPayload =
        SigPayload {
          sigPayloadId            = sigId,
          sigPayloadBody          = sigBody,
          sigPayloadExpiresAt     = sigExpiresAt,
          sigPayloadOpCertificate = sigOpCertificate
        },
      sigRawKesSignature = sigKesSignature
    }
  where
    Sig SigId
sigPayloadId
        SigBody
sigPayloadBody
        POSIXTime
sigPayloadExpiresAt
        SigOpCertificate
sigPayloadOpCertificate
        SigKesSignature
sigRawKesSignature
      =
      SigRaw {
        sigRawPayload :: SigPayload
sigRawPayload =
          SigPayload {
            SigId
sigPayloadId :: SigId
sigPayloadId :: SigId
sigPayloadId,
            SigBody
sigPayloadBody :: SigBody
sigPayloadBody :: SigBody
sigPayloadBody,
            POSIXTime
sigPayloadExpiresAt :: POSIXTime
sigPayloadExpiresAt :: POSIXTime
sigPayloadExpiresAt,
            SigOpCertificate
sigPayloadOpCertificate :: SigOpCertificate
sigPayloadOpCertificate :: SigOpCertificate
sigPayloadOpCertificate
          },
        SigKesSignature
sigRawKesSignature :: SigKesSignature
sigRawKesSignature :: SigKesSignature
sigRawKesSignature
      }
{-# COMPLETE Sig #-}


instance ShowProxy Sig where
  showProxy :: Proxy Sig -> String
showProxy Proxy Sig
_ = String
"Sig"


type SigSubmission = TxSubmission2.TxSubmission2 SigId Sig