{-# 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."