{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}

module Test.Cardano.Ledger.Binary.GoldenSpec (spec) where

import Cardano.Crypto.DSIGN (
  createPossessionProofDSIGN,
  deriveVerKeyDSIGN,
  genKeyDSIGN,
  signDSIGN,
 )
import Cardano.Crypto.Leios (
  LeiosCommittee (..),
  LeiosSeat (..),
  LeiosSeatId (..),
  aggregateLeiosCert,
  leiosSignContext,
  mkLeiosCommittee,
 )
import Cardano.Crypto.Seed (mkSeedFromBytes)
import Cardano.Ledger.Binary (getVersion, natVersion)
import Control.Monad (forM_)
import qualified Data.ByteString as BS
import qualified Data.Map.Strict as Map
import Data.Maybe.Strict (StrictMaybe (..))
import Data.Ratio ((%))
import qualified Data.Vector.Strict as V
import Data.Word
import Paths_cardano_ledger_binary (getDataFileName)
import Test.Cardano.Ledger.Binary.Golden (cborGoldenSpec)
import Test.Hspec (Spec, describe)

spec :: Spec
spec :: Spec
spec =
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Golden" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    [Version] -> (Version -> Spec) -> Spec
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @12 .. Version
forall a. Bounded a => a
maxBound] ((Version -> Spec) -> Spec) -> (Version -> Spec) -> Spec
forall a b. (a -> b) -> a -> b
$ \Version
version ->
      let fileName :: String
fileName = String
"golden/LeiosCertPV" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Word32 -> String
forall a. Show a => a -> String
show (forall i. Integral i => Version -> i
getVersion @Word32 Version
version) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".cbor"
          exampleLeiosCert :: LeiosCert
exampleLeiosCert =
            let sk :: SignKeyDSIGN LeiosDSIGN
sk = Seed -> SignKeyDSIGN LeiosDSIGN
forall v. DSIGNAlgorithm v => Seed -> SignKeyDSIGN v
genKeyDSIGN (ByteString -> Seed
mkSeedFromBytes (Int -> Word8 -> ByteString
BS.replicate Int
32 Word8
0))
                vk :: VerKeyDSIGN LeiosDSIGN
vk = SignKeyDSIGN LeiosDSIGN -> VerKeyDSIGN LeiosDSIGN
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
deriveVerKeyDSIGN SignKeyDSIGN LeiosDSIGN
sk
                pop :: PossessionProofDSIGN LeiosDSIGN
pop = ContextDSIGN LeiosDSIGN
-> SignKeyDSIGN LeiosDSIGN -> PossessionProofDSIGN LeiosDSIGN
forall v.
(DSIGNAggregatable v, HasCallStack) =>
ContextDSIGN v -> SignKeyDSIGN v -> PossessionProofDSIGN v
createPossessionProofDSIGN ContextDSIGN LeiosDSIGN
BLS12381SignContext
leiosSignContext SignKeyDSIGN LeiosDSIGN
sk
                committee :: LeiosCommittee
committee = Vector
  (StrictMaybe
     (VerKeyDSIGN LeiosDSIGN, PossessionProofDSIGN LeiosDSIGN),
   Weight)
-> LeiosCommittee
mkLeiosCommittee ([(StrictMaybe
    (VerKeyDSIGN LeiosDSIGN, PossessionProofDSIGN LeiosDSIGN),
  Weight)]
-> Vector
     (StrictMaybe
        (VerKeyDSIGN LeiosDSIGN, PossessionProofDSIGN LeiosDSIGN),
      Weight)
forall a. [a] -> Vector a
V.fromList [((VerKeyDSIGN LeiosDSIGN, PossessionProofDSIGN LeiosDSIGN)
-> StrictMaybe
     (VerKeyDSIGN LeiosDSIGN, PossessionProofDSIGN LeiosDSIGN)
forall a. a -> StrictMaybe a
SJust (VerKeyDSIGN LeiosDSIGN
vk, PossessionProofDSIGN LeiosDSIGN
pop), Integer
1 Integer -> Integer -> Weight
forall a. Integral a => a -> a -> Ratio a
% Integer
1)])
                msg :: ByteString
msg = ByteString
"golden" :: BS.ByteString
                sigs :: Map LeiosSeatId (SigDSIGN LeiosDSIGN)
sigs = LeiosSeatId
-> SigDSIGN LeiosDSIGN -> Map LeiosSeatId (SigDSIGN LeiosDSIGN)
forall k a. k -> a -> Map k a
Map.singleton (Word16 -> LeiosSeatId
LeiosSeatId Word16
0) (ContextDSIGN LeiosDSIGN
-> ByteString -> SignKeyDSIGN LeiosDSIGN -> SigDSIGN LeiosDSIGN
forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v -> a -> SignKeyDSIGN v -> SigDSIGN v
forall a.
(Signable LeiosDSIGN a, HasCallStack) =>
ContextDSIGN LeiosDSIGN
-> a -> SignKeyDSIGN LeiosDSIGN -> SigDSIGN LeiosDSIGN
signDSIGN ContextDSIGN LeiosDSIGN
BLS12381SignContext
leiosSignContext ByteString
msg SignKeyDSIGN LeiosDSIGN
sk)
             in case LeiosCommittee
-> Map LeiosSeatId (SigDSIGN LeiosDSIGN)
-> Either AggregationError LeiosCert
aggregateLeiosCert LeiosCommittee
committee Map LeiosSeatId (SigDSIGN LeiosDSIGN)
sigs of
                  Right LeiosCert
cert -> LeiosCert
cert
                  Left AggregationError
e -> String -> LeiosCert
forall a. HasCallStack => String -> a
error (String
"exampleLeiosCert: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> AggregationError -> String
forall a. Show a => a -> String
show AggregationError
e)
       in (String -> IO String) -> String -> Version -> LeiosCert -> Spec
forall a.
(Eq a, Show a, EncCBOR a, DecCBOR a, HasCallStack) =>
(String -> IO String) -> String -> Version -> a -> Spec
cborGoldenSpec String -> IO String
getDataFileName String
fileName Version
version LeiosCert
exampleLeiosCert
    [Version] -> (Version -> Spec) -> Spec
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @12 .. Version
forall a. Bounded a => a
maxBound] ((Version -> Spec) -> Spec) -> (Version -> Spec) -> Spec
forall a b. (a -> b) -> a -> b
$ \Version
version ->
      let fileName :: String
fileName = String
"golden/LeiosSeatPV" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Word32 -> String
forall a. Show a => a -> String
show (forall i. Integral i => Version -> i
getVersion @Word32 Version
version) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".cbor"
          exampleLeiosSeat :: LeiosSeat
exampleLeiosSeat =
            LeiosSeat
              { seatWeight :: Weight
seatWeight = Integer
1 Integer -> Integer -> Weight
forall a. Integral a => a -> a -> Ratio a
% Integer
3
              , seatVKey :: StrictMaybe (VerKeyDSIGN LeiosDSIGN)
seatVKey = VerKeyDSIGN LeiosDSIGN -> StrictMaybe (VerKeyDSIGN LeiosDSIGN)
forall a. a -> StrictMaybe a
SJust (SignKeyDSIGN LeiosDSIGN -> VerKeyDSIGN LeiosDSIGN
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
deriveVerKeyDSIGN (Seed -> SignKeyDSIGN LeiosDSIGN
forall v. DSIGNAlgorithm v => Seed -> SignKeyDSIGN v
genKeyDSIGN (ByteString -> Seed
mkSeedFromBytes (Int -> Word8 -> ByteString
BS.replicate Int
32 Word8
0))))
              }
       in (String -> IO String) -> String -> Version -> LeiosSeat -> Spec
forall a.
(Eq a, Show a, EncCBOR a, DecCBOR a, HasCallStack) =>
(String -> IO String) -> String -> Version -> a -> Spec
cborGoldenSpec String -> IO String
getDataFileName String
fileName Version
version LeiosSeat
exampleLeiosSeat
    [Version] -> (Version -> Spec) -> Spec
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @12 .. Version
forall a. Bounded a => a
maxBound] ((Version -> Spec) -> Spec) -> (Version -> Spec) -> Spec
forall a b. (a -> b) -> a -> b
$ \Version
version ->
      let fileName :: String
fileName = String
"golden/LeiosCommitteePV" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Word32 -> String
forall a. Show a => a -> String
show (forall i. Integral i => Version -> i
getVersion @Word32 Version
version) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".cbor"
          exampleLeiosCommittee :: LeiosCommittee
exampleLeiosCommittee =
            Vector LeiosSeat -> LeiosCommittee
UnsafeLeiosCommittee (Vector LeiosSeat -> LeiosCommittee)
-> Vector LeiosSeat -> LeiosCommittee
forall a b. (a -> b) -> a -> b
$
              [LeiosSeat] -> Vector LeiosSeat
forall a. [a] -> Vector a
V.fromList
                [ Weight -> StrictMaybe (VerKeyDSIGN LeiosDSIGN) -> LeiosSeat
LeiosSeat (Integer
1 Integer -> Integer -> Weight
forall a. Integral a => a -> a -> Ratio a
% Integer
2) StrictMaybe (VerKeyDSIGN LeiosDSIGN)
forall a. StrictMaybe a
SNothing
                , Weight -> StrictMaybe (VerKeyDSIGN LeiosDSIGN) -> LeiosSeat
LeiosSeat (Integer
1 Integer -> Integer -> Weight
forall a. Integral a => a -> a -> Ratio a
% Integer
2) (VerKeyDSIGN LeiosDSIGN -> StrictMaybe (VerKeyDSIGN LeiosDSIGN)
forall a. a -> StrictMaybe a
SJust (SignKeyDSIGN LeiosDSIGN -> VerKeyDSIGN LeiosDSIGN
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
deriveVerKeyDSIGN (Seed -> SignKeyDSIGN LeiosDSIGN
forall v. DSIGNAlgorithm v => Seed -> SignKeyDSIGN v
genKeyDSIGN (ByteString -> Seed
mkSeedFromBytes (Int -> Word8 -> ByteString
BS.replicate Int
32 Word8
0)))))
                ]
       in (String -> IO String)
-> String -> Version -> LeiosCommittee -> Spec
forall a.
(Eq a, Show a, EncCBOR a, DecCBOR a, HasCallStack) =>
(String -> IO String) -> String -> Version -> a -> Spec
cborGoldenSpec String -> IO String
getDataFileName String
fileName Version
version LeiosCommittee
exampleLeiosCommittee