From 985f4b0384347ce7911b2f5747ff8cd8e9bb5642 Mon Sep 17 00:00:00 2001
From: Thomas Winant <thomas@well-typed.com>
Date: Tue, 16 Jun 2020 15:24:29 +0200
Subject: [PATCH] Implement genesisHash

---
 .../src/Shelley/Spec/Ledger/Genesis.hs        | 57 ++++++++++++++++++-
 1 file changed, 55 insertions(+), 2 deletions(-)

diff --git a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/Genesis.hs b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/Genesis.hs
index bd33c653b84..a7515d62d11 100644
--- a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/Genesis.hs
+++ b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/Genesis.hs
@@ -11,20 +11,27 @@ module Shelley.Spec.Ledger.Genesis
     ShelleyGenesis (..),
     emptyGenesisStaking,
     sgActiveSlotCoeff,
+    genesisHash,
     genesisUtxO,
     initialFundsPseudoTxIn,
   )
 where
 
+import Cardano.Binary (Encoding, ToCBOR (..), encodeDouble, encodeListLen)
 import Cardano.Crypto (ProtocolMagicId)
 import qualified Cardano.Crypto.Hash.Class as Crypto (Hash (..), hash)
 import Cardano.Prelude (NoUnexpectedThunks)
-import Cardano.Slotting.Slot (EpochSize)
+import Cardano.Slotting.Slot (EpochSize (..))
 import Data.Aeson ((.:), (.=), FromJSON (..), ToJSON (..), Value (..))
 import qualified Data.Aeson as Aeson
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
-import Data.Time (NominalDiffTime, UTCTime)
+import Data.Time
+  ( Day (..),
+    NominalDiffTime,
+    UTCTime (..),
+    diffTimeToPicoseconds,
+  )
 import Data.Word (Word32, Word64)
 import GHC.Generics (Generic)
 import Shelley.Spec.Ledger.Address
@@ -62,6 +69,14 @@ data ShelleyGenesisStaking c = ShelleyGenesisStaking
   deriving stock (Eq, Show, Generic)
   deriving anyclass (NoUnexpectedThunks)
 
+instance Crypto c => ToCBOR (ShelleyGenesisStaking c) where
+  toCBOR (ShelleyGenesisStaking pools stake) =
+    mconcat
+      [ encodeListLen 2,
+        toCBOR pools,
+        toCBOR stake
+      ]
+
 -- | Empty genesis staking
 emptyGenesisStaking :: ShelleyGenesisStaking c
 emptyGenesisStaking =
@@ -108,6 +123,44 @@ sgActiveSlotCoeff =
     . toRational
     . sgActiveSlotsCoeff
 
+-- | This instance is used by 'genesisHash'.
+instance Crypto crypto => ToCBOR (ShelleyGenesis crypto) where
+  toCBOR sg =
+    mconcat
+      [ encodeListLen 16,
+        encodeUTCTime $ sgSystemStart sg,
+        toCBOR $ sgNetworkMagic sg,
+        toCBOR $ sgNetworkId sg,
+        toCBOR $ sgProtocolMagicId sg,
+        encodeDouble $ sgActiveSlotsCoeff sg,
+        toCBOR $ sgSecurityParam sg,
+        toCBOR $ unEpochSize (sgEpochLength sg),
+        toCBOR $ sgSlotsPerKESPeriod sg,
+        toCBOR $ sgMaxKESEvolutions sg,
+        toCBOR $ sgSlotLength sg,
+        toCBOR $ sgUpdateQuorum sg,
+        toCBOR $ sgMaxLovelaceSupply sg,
+        toCBOR $ sgProtocolParams sg,
+        toCBOR $ sgGenDelegs sg,
+        toCBOR $ sgInitialFunds sg,
+        toCBOR $ sgStaking sg
+      ]
+    where
+      encodeUTCTime :: UTCTime -> Encoding
+      encodeUTCTime (UTCTime (ModifiedJulianDay day) diffTime) =
+        encodeListLen 2
+          <> toCBOR day
+          <> toCBOR (diffTimeToPicoseconds diffTime)
+
+-- | Return the hash of the genesis config.
+--
+-- Uses the 'ToCBOR' instance.
+genesisHash ::
+  Crypto crypto =>
+  ShelleyGenesis crypto ->
+  Hash crypto (ShelleyGenesis crypto)
+genesisHash = hash
+
 instance Crypto crypto => ToJSON (ShelleyGenesis crypto) where
   toJSON sg =
     Aeson.object