{-# 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           Data.Bifunctor (first)
import           Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import           Data.Either.Combinators (maybeToRight)
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.Keys.Byron
import           Cardano.Api.Keys.Praos
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
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
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
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
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 Hash StandardCrypto ByteString
h) = forall h a. Hash h a -> ByteString
Crypto.hashToBytes Hash StandardCrypto ByteString
h

    deserialiseFromRawBytes :: AsType (Hash StakePoolMetadata)
-> ByteString
-> Either SerialiseAsRawBytesError (Hash StakePoolMetadata)
deserialiseFromRawBytes (AsHash AsType StakePoolMetadata
R:AsTypeStakePoolMetadata
AsStakePoolMetadata) ByteString
bs =
      forall b a. b -> Maybe a -> Either b a
maybeToRight (String -> SerialiseAsRawBytesError
SerialiseAsRawBytesError String
"Unable to deserialise Hash StakePoolMetadata") forall a b. (a -> b) -> a -> b
$
        Hash StandardCrypto ByteString -> Hash StakePoolMetadata
StakePoolMetadataHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 =
        forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"StakePoolMetadata" forall a b. (a -> b) -> a -> b
$ \Object
obj ->
          Text -> Text -> Text -> Text -> StakePoolMetadata
StakePoolMetadata
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser Text
parseName Object
obj
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Parser Text
parseDescription Object
obj
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Parser Text
parseTicker Object
obj
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj 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 forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
          if Text -> Int
Text.length Text
name forall a. Ord a => a -> a -> Bool
<= Int
50
            then forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
name
            else forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"\"name\" must have at most 50 characters, but it has "
                     forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Text -> Int
Text.length Text
name)
                     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 forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"description"
          if Text -> Int
Text.length Text
description forall a. Ord a => a -> a -> Bool
<= Int
255
            then forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
description
            else forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$
                 String
"\"description\" must have at most 255 characters, but it has "
              forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Text -> Int
Text.length Text
description)
              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 forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ticker"
          let tickerLen :: Int
tickerLen = Text -> Int
Text.length Text
ticker
          if Int
tickerLen forall a. Ord a => a -> a -> Bool
>= Int
3 Bool -> Bool -> Bool
&& Int
tickerLen forall a. Ord a => a -> a -> Bool
<= Int
5
            then forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
ticker
            else forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$
                 String
"\"ticker\" must have at least 3 and at most 5 "
              forall a. Semigroup a => a -> a -> a
<> String
"characters, but it has "
              forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Text -> Int
Text.length Text
ticker)
              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
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 "
      forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
maxLen
      forall a. Semigroup a => a -> a -> a
<> String
" bytes, but it consists of "
      forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
actualLen
      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 forall a. Ord a => a -> a -> Bool
<= Int
512 = do
      StakePoolMetadata
md <- forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> StakePoolMetadataValidationError
StakePoolMetadataJsonDecodeError
                  (forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecodeStrict' ByteString
bs)
      let mdh :: Hash StakePoolMetadata
mdh = Hash StandardCrypto ByteString -> Hash StakePoolMetadata
StakePoolMetadataHash (forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
Crypto.hashWith forall a. a -> a
id ByteString
bs)
      forall (m :: * -> *) a. Monad m => a -> m a
return (StakePoolMetadata
md, Hash StakePoolMetadata
mdh)
  | Bool
otherwise = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Int -> Int -> StakePoolMetadataValidationError
StakePoolMetadataInvalidLengthError Int
512 (ByteString -> Int
BS.length ByteString
bs)