content: {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE NamedFieldPuns #-}
  {-# LANGUAGE OverloadedStrings #-}
  
  {-# OPTIONS_HADDOCK hide #-}
  
  -- |
  -- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect
  -- License: Apache-2.0
  
  module Command.Key.Hash
      ( Cmd (..)
      , mod
      , run
      ) where
  
  import Prelude hiding
      ( mod )
  
  import Cardano.Address.Derivation
      ( hashCredential )
  import Cardano.Address.KeyHash
      ( GovernanceType, KeyHash (..), KeyRole (..), keyHashToText )
  import Control.Monad
      ( when )
  import Data.Maybe
      ( fromJust )
  import Data.Text
      ( Text )
  import Options.Applicative
      ( CommandFields, Mod, command, footerDoc, helper, info, progDesc )
  import Options.Applicative.Governance
      ( governanceOpt )
  import Options.Applicative.Help.Pretty
      ( pretty )
  import System.IO
      ( stdin, stdout )
  import System.IO.Extra
      ( hGetBech32, hPutStringNoNewLn )
  
  import qualified Cardano.Codec.Bech32.Prefixes as CIP5
  import qualified Data.ByteString as BS
  import qualified Data.Text as T
  
  newtype Cmd = Hash
      { govType :: GovernanceType
      } deriving (Show)
  
  mod :: (Cmd -> parent) -> Mod CommandFields parent
  mod liftCmd = command "hash" $
      info (helper <*> fmap liftCmd parser) $ mempty
          <> progDesc "Get the hash of a public key"
          <> footerDoc (Just $ pretty $ mconcat
              [ "The public key is read from stdin and" :: Text
              , "bech32-encoded hash is returned."
              , "To get hex-encoded output pass it to stdin of `bech32`."
              ])
    where
      parser = Hash
          <$> governanceOpt
  
  run :: Cmd -> IO ()
  run Hash{govType} = do
      (hrp, bytes) <- hGetBech32 stdin allowedPrefixes
      guardBytes hrp bytes
      let keyhash = KeyHash (prefixFor hrp) (hashCredential $ BS.take 32 bytes)
      hPutStringNoNewLn stdout $ T.unpack $
          keyHashToText keyhash govType
    where
      -- Mapping of input HRP to key role
      prefixToRole =
          [ ( CIP5.addr_vk         , Payment )
          , ( CIP5.addr_xvk        , Payment )
          , ( CIP5.stake_vk        , Delegation )
          , ( CIP5.stake_xvk       , Delegation )
          , ( CIP5.addr_shared_vk  , PaymentShared )
          , ( CIP5.addr_shared_xvk , PaymentShared )
          , ( CIP5.stake_shared_vk , DelegationShared )
          , ( CIP5.stake_shared_xvk, DelegationShared )
          , ( CIP5.policy_vk       , Policy )
          , ( CIP5.policy_xvk      , Policy )
          , ( CIP5.drep_vk         , Representative )
          , ( CIP5.drep_xvk        , Representative )
          , ( CIP5.cc_cold_vk      , CommitteeCold )
          , ( CIP5.cc_cold_xvk     , CommitteeCold )
          , ( CIP5.cc_hot_vk       , CommitteeHot )
          , ( CIP5.cc_hot_xvk      , CommitteeHot )
          ]
      allowedPrefixes = map fst prefixToRole
      prefixFor = fromJust . flip lookup prefixToRole
  
      extendedPrefixes =
          [ CIP5.addr_xvk
          , CIP5.stake_xvk
          , CIP5.addr_shared_xvk
          , CIP5.stake_shared_xvk
          , CIP5.policy_xvk
          , CIP5.drep_xvk
          , CIP5.cc_cold_xvk
          , CIP5.cc_hot_xvk
          ]
  
      guardBytes hrp bytes
          | hrp `elem` extendedPrefixes = do
              when (BS.length bytes /= 64) $
                  fail "data should be a 32-byte public key with a 32-byte chain-code appended"
  
          | otherwise = do
              when (BS.length bytes /= 32) $
                  fail "data should be a 32-byte public key."
  