{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}

-- | Stake pool off-chain metadata
--
module Cardano.Api.StakePoolMetadata (
    -- * Stake pool off-chain metadata
    StakePoolMetadata(..),
    validateAndHashStakePoolMetadata,
    StakePoolMetadataValidationError(..),

    -- * Data family instances
    AsType(..),
    Hash(..),
  ) where

import           Prelude

import           Data.Bifunctor (first)
import           Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import           Data.Text (Text)
import qualified Data.Text as Text

import           Data.Aeson ((.:))
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Types as Aeson

import qualified Cardano.Crypto.Hash.Class as Crypto

import           Cardano.Api.Eras
import           Cardano.Api.Error
import           Cardano.Api.Hash
import           Cardano.Api.HasTypeProxy
import           Cardano.Api.Key
import           Cardano.Api.KeysByron
import           Cardano.Api.KeysPraos
import           Cardano.Api.Script
import           Cardano.Api.SerialiseJSON
import           Cardano.Api.SerialiseRaw
import           Cardano.Ledger.Crypto (StandardCrypto)

import qualified Cardano.Ledger.Keys as Shelley


-- ----------------------------------------------------------------------------
-- Stake pool metadata
--

-- | A representation of the required fields for off-chain stake pool metadata.
--
data StakePoolMetadata =
     StakePoolMetadata {

       -- | A name of up to 50 characters.
       StakePoolMetadata -> Text
stakePoolName :: !Text

       -- | A description of up to 255 characters.
     , StakePoolMetadata -> Text
stakePoolDescription :: !Text

       -- | A ticker of 3-5 characters, for a compact display of stake pools in
       -- a wallet.
     , StakePoolMetadata -> Text
stakePoolTicker :: !Text

       -- | A URL to a homepage with additional information about the pool.
       -- n.b. the spec does not specify a character limit for this field.
     , StakePoolMetadata -> Text
stakePoolHomepage :: !Text
     }
  deriving (StakePoolMetadata -> StakePoolMetadata -> Bool
(StakePoolMetadata -> StakePoolMetadata -> Bool)
-> (StakePoolMetadata -> StakePoolMetadata -> Bool)
-> Eq StakePoolMetadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StakePoolMetadata -> StakePoolMetadata -> Bool
$c/= :: StakePoolMetadata -> StakePoolMetadata -> Bool
== :: StakePoolMetadata -> StakePoolMetadata -> Bool
$c== :: StakePoolMetadata -> StakePoolMetadata -> Bool
Eq, Int -> StakePoolMetadata -> ShowS
[StakePoolMetadata] -> ShowS
StakePoolMetadata -> String
(Int -> StakePoolMetadata -> ShowS)
-> (StakePoolMetadata -> String)
-> ([StakePoolMetadata] -> ShowS)
-> Show StakePoolMetadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StakePoolMetadata] -> ShowS
$cshowList :: [StakePoolMetadata] -> ShowS
show :: StakePoolMetadata -> String
$cshow :: StakePoolMetadata -> String
showsPrec :: Int -> StakePoolMetadata -> ShowS
$cshowsPrec :: Int -> StakePoolMetadata -> ShowS
Show)

newtype instance Hash StakePoolMetadata =
                 StakePoolMetadataHash (Shelley.Hash StandardCrypto ByteString)
    deriving (Hash StakePoolMetadata -> Hash StakePoolMetadata -> Bool
(Hash StakePoolMetadata -> Hash StakePoolMetadata -> Bool)
-> (Hash StakePoolMetadata -> Hash StakePoolMetadata -> Bool)
-> Eq (Hash StakePoolMetadata)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Hash StakePoolMetadata -> Hash StakePoolMetadata -> Bool
$c/= :: Hash StakePoolMetadata -> Hash StakePoolMetadata -> Bool
== :: Hash StakePoolMetadata -> Hash StakePoolMetadata -> Bool
$c== :: Hash StakePoolMetadata -> Hash StakePoolMetadata -> Bool
Eq, Int -> Hash StakePoolMetadata -> ShowS
[Hash StakePoolMetadata] -> ShowS
Hash StakePoolMetadata -> String
(Int -> Hash StakePoolMetadata -> ShowS)
-> (Hash StakePoolMetadata -> String)
-> ([Hash StakePoolMetadata] -> ShowS)
-> Show (Hash StakePoolMetadata)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Hash StakePoolMetadata] -> ShowS
$cshowList :: [Hash StakePoolMetadata] -> ShowS
show :: Hash StakePoolMetadata -> String
$cshow :: Hash StakePoolMetadata -> String
showsPrec :: Int -> Hash StakePoolMetadata -> ShowS
$cshowsPrec :: Int -> Hash StakePoolMetadata -> ShowS
Show)

instance HasTypeProxy StakePoolMetadata where
    data AsType StakePoolMetadata = AsStakePoolMetadata
    proxyToAsType :: Proxy StakePoolMetadata -> AsType StakePoolMetadata
proxyToAsType Proxy StakePoolMetadata
_ = AsType StakePoolMetadata
AsStakePoolMetadata

instance SerialiseAsRawBytes (Hash StakePoolMetadata) where
    serialiseToRawBytes :: Hash StakePoolMetadata -> ByteString
serialiseToRawBytes (StakePoolMetadataHash h) = Hash Blake2b_256 ByteString -> ByteString
forall h a. Hash h a -> ByteString
Crypto.hashToBytes Hash Blake2b_256 ByteString
Hash StandardCrypto ByteString
h

    deserialiseFromRawBytes :: AsType (Hash StakePoolMetadata)
-> ByteString -> Maybe (Hash StakePoolMetadata)
deserialiseFromRawBytes (AsHash AsStakePoolMetadata) ByteString
bs =
      Hash Blake2b_256 ByteString -> Hash StakePoolMetadata
Hash StandardCrypto ByteString -> Hash StakePoolMetadata
StakePoolMetadataHash (Hash Blake2b_256 ByteString -> Hash StakePoolMetadata)
-> Maybe (Hash Blake2b_256 ByteString)
-> Maybe (Hash StakePoolMetadata)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (Hash Blake2b_256 ByteString)
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
Crypto.hashFromBytes ByteString
bs

--TODO: instance ToJSON StakePoolMetadata where

instance FromJSON StakePoolMetadata where
    parseJSON :: Value -> Parser StakePoolMetadata
parseJSON =
        String
-> (Object -> Parser StakePoolMetadata)
-> Value
-> Parser StakePoolMetadata
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"StakePoolMetadata" ((Object -> Parser StakePoolMetadata)
 -> Value -> Parser StakePoolMetadata)
-> (Object -> Parser StakePoolMetadata)
-> Value
-> Parser StakePoolMetadata
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
          Text -> Text -> Text -> Text -> StakePoolMetadata
StakePoolMetadata
            (Text -> Text -> Text -> Text -> StakePoolMetadata)
-> Parser Text
-> Parser (Text -> Text -> Text -> StakePoolMetadata)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser Text
parseName Object
obj
            Parser (Text -> Text -> Text -> StakePoolMetadata)
-> Parser Text -> Parser (Text -> Text -> StakePoolMetadata)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Parser Text
parseDescription Object
obj
            Parser (Text -> Text -> StakePoolMetadata)
-> Parser Text -> Parser (Text -> StakePoolMetadata)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Parser Text
parseTicker Object
obj
            Parser (Text -> StakePoolMetadata)
-> Parser Text -> Parser StakePoolMetadata
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"homepage"

      where
        -- Parse and validate the stake pool metadata name from a JSON object.
        -- The name must be 50 characters or fewer.
        --
        parseName :: Aeson.Object -> Aeson.Parser Text
        parseName :: Object -> Parser Text
parseName Object
obj = do
          Text
name <- Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
          if Text -> Int
Text.length Text
name Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
50
            then Text -> Parser Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
name
            else String -> Parser Text
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Text) -> String -> Parser Text
forall a b. (a -> b) -> a -> b
$ String
"\"name\" must have at most 50 characters, but it has "
                     String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Text -> Int
Text.length Text
name)
                     String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" characters."

        -- Parse and validate the stake pool metadata description
        -- The description must be 255 characters or fewer.
        --
        parseDescription :: Aeson.Object -> Aeson.Parser Text
        parseDescription :: Object -> Parser Text
parseDescription Object
obj = do
          Text
description <- Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"description"
          if Text -> Int
Text.length Text
description Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
255
            then Text -> Parser Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
description
            else String -> Parser Text
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Text) -> String -> Parser Text
forall a b. (a -> b) -> a -> b
$
                 String
"\"description\" must have at most 255 characters, but it has "
              String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Text -> Int
Text.length Text
description)
              String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" characters."

        -- | Parse and validate the stake pool ticker description
        -- The ticker must be 3 to 5 characters long.
        --
        parseTicker :: Aeson.Object -> Aeson.Parser Text
        parseTicker :: Object -> Parser Text
parseTicker Object
obj = do
          Text
ticker <- Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ticker"
          let tickerLen :: Int
tickerLen = Text -> Int
Text.length Text
ticker
          if Int
tickerLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
3 Bool -> Bool -> Bool
&& Int
tickerLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
5
            then Text -> Parser Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
ticker
            else String -> Parser Text
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Text) -> String -> Parser Text
forall a b. (a -> b) -> a -> b
$
                 String
"\"ticker\" must have at least 3 and at most 5 "
              String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"characters, but it has "
              String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Text -> Int
Text.length Text
ticker)
              String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" characters."

-- | A stake pool metadata validation error.
data StakePoolMetadataValidationError
  = StakePoolMetadataJsonDecodeError !String
  | StakePoolMetadataInvalidLengthError
    -- ^ The length of the JSON-encoded stake pool metadata exceeds the
    -- maximum.
      !Int
      -- ^ Maximum byte length.
      !Int
      -- ^ Actual byte length.
  deriving Int -> StakePoolMetadataValidationError -> ShowS
[StakePoolMetadataValidationError] -> ShowS
StakePoolMetadataValidationError -> String
(Int -> StakePoolMetadataValidationError -> ShowS)
-> (StakePoolMetadataValidationError -> String)
-> ([StakePoolMetadataValidationError] -> ShowS)
-> Show StakePoolMetadataValidationError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StakePoolMetadataValidationError] -> ShowS
$cshowList :: [StakePoolMetadataValidationError] -> ShowS
show :: StakePoolMetadataValidationError -> String
$cshow :: StakePoolMetadataValidationError -> String
showsPrec :: Int -> StakePoolMetadataValidationError -> ShowS
$cshowsPrec :: Int -> StakePoolMetadataValidationError -> ShowS
Show

instance Error StakePoolMetadataValidationError where
    displayError :: StakePoolMetadataValidationError -> String
displayError (StakePoolMetadataJsonDecodeError String
errStr) = String
errStr
    displayError (StakePoolMetadataInvalidLengthError Int
maxLen Int
actualLen) =
         String
"Stake pool metadata must consist of at most "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
maxLen
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" bytes, but it consists of "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
actualLen
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" bytes."

-- | Decode and validate the provided JSON-encoded bytes as 'StakePoolMetadata'.
-- Return the decoded metadata and the hash of the original bytes.
--
validateAndHashStakePoolMetadata
  :: ByteString
  -> Either StakePoolMetadataValidationError
            (StakePoolMetadata, Hash StakePoolMetadata)
validateAndHashStakePoolMetadata :: ByteString
-> Either
     StakePoolMetadataValidationError
     (StakePoolMetadata, Hash StakePoolMetadata)
validateAndHashStakePoolMetadata ByteString
bs
  | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
512 = do
      StakePoolMetadata
md <- (String -> StakePoolMetadataValidationError)
-> Either String StakePoolMetadata
-> Either StakePoolMetadataValidationError StakePoolMetadata
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> StakePoolMetadataValidationError
StakePoolMetadataJsonDecodeError
                  (ByteString -> Either String StakePoolMetadata
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecodeStrict' ByteString
bs)
      let mdh :: Hash StakePoolMetadata
mdh = Hash StandardCrypto ByteString -> Hash StakePoolMetadata
StakePoolMetadataHash ((ByteString -> ByteString)
-> ByteString -> Hash Blake2b_256 ByteString
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
Crypto.hashWith ByteString -> ByteString
forall a. a -> a
id ByteString
bs)
      (StakePoolMetadata, Hash StakePoolMetadata)
-> Either
     StakePoolMetadataValidationError
     (StakePoolMetadata, Hash StakePoolMetadata)
forall (m :: * -> *) a. Monad m => a -> m a
return (StakePoolMetadata
md, Hash StakePoolMetadata
mdh)
  | Bool
otherwise = StakePoolMetadataValidationError
-> Either
     StakePoolMetadataValidationError
     (StakePoolMetadata, Hash StakePoolMetadata)
forall a b. a -> Either a b
Left (StakePoolMetadataValidationError
 -> Either
      StakePoolMetadataValidationError
      (StakePoolMetadata, Hash StakePoolMetadata))
-> StakePoolMetadataValidationError
-> Either
     StakePoolMetadataValidationError
     (StakePoolMetadata, Hash StakePoolMetadata)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> StakePoolMetadataValidationError
StakePoolMetadataInvalidLengthError Int
512 (ByteString -> Int
BS.length ByteString
bs)