{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# 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           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 qualified Cardano.Crypto.Hash.Class as Crypto
import           Cardano.Ledger.Crypto (StandardCrypto)
import qualified Cardano.Ledger.Keys as Shelley

import           Data.Aeson ((.:))
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Types as Aeson
import           Data.Bifunctor (first)
import           Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import           Data.Data (Data)
import           Data.Either.Combinators (maybeToRight)
import           Data.Text (Text)
import qualified Data.Text as Text
import           Prettyprinter

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

-- | A representation of the required fields for off-chain stake pool metadata.
data StakePoolMetadata
  = StakePoolMetadata
  { StakePoolMetadata -> Text
stakePoolName :: !Text
  -- ^ A name of up to 50 characters.
  , StakePoolMetadata -> Text
stakePoolDescription :: !Text
  -- ^ A description of up to 255 characters.
  , StakePoolMetadata -> Text
stakePoolTicker :: !Text
  -- ^ A ticker of 3-5 characters, for a compact display of stake pools in
  -- a wallet.
  , StakePoolMetadata -> Text
stakePoolHomepage :: !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.
  }
  deriving (StakePoolMetadata -> StakePoolMetadata -> Bool
(StakePoolMetadata -> StakePoolMetadata -> Bool)
-> (StakePoolMetadata -> StakePoolMetadata -> Bool)
-> Eq StakePoolMetadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StakePoolMetadata -> StakePoolMetadata -> Bool
== :: StakePoolMetadata -> StakePoolMetadata -> Bool
$c/= :: StakePoolMetadata -> StakePoolMetadata -> Bool
/= :: 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
$cshowsPrec :: Int -> StakePoolMetadata -> ShowS
showsPrec :: Int -> StakePoolMetadata -> ShowS
$cshow :: StakePoolMetadata -> String
show :: StakePoolMetadata -> String
$cshowList :: [StakePoolMetadata] -> ShowS
showList :: [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
$c== :: Hash StakePoolMetadata -> Hash StakePoolMetadata -> Bool
== :: Hash StakePoolMetadata -> Hash StakePoolMetadata -> Bool
$c/= :: Hash StakePoolMetadata -> Hash StakePoolMetadata -> Bool
/= :: 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
$cshowsPrec :: Int -> Hash StakePoolMetadata -> ShowS
showsPrec :: Int -> Hash StakePoolMetadata -> ShowS
$cshow :: Hash StakePoolMetadata -> String
show :: Hash StakePoolMetadata -> String
$cshowList :: [Hash StakePoolMetadata] -> ShowS
showList :: [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) = 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
-> Either SerialiseAsRawBytesError (Hash StakePoolMetadata)
deserialiseFromRawBytes (AsHash AsType StakePoolMetadata
R:AsTypeStakePoolMetadata
AsStakePoolMetadata) ByteString
bs =
    SerialiseAsRawBytesError
-> Maybe (Hash StakePoolMetadata)
-> Either SerialiseAsRawBytesError (Hash StakePoolMetadata)
forall b a. b -> Maybe a -> Either b a
maybeToRight (String -> SerialiseAsRawBytesError
SerialiseAsRawBytesError String
"Unable to deserialise Hash StakePoolMetadata") (Maybe (Hash StakePoolMetadata)
 -> Either SerialiseAsRawBytesError (Hash StakePoolMetadata))
-> Maybe (Hash StakePoolMetadata)
-> Either SerialiseAsRawBytesError (Hash StakePoolMetadata)
forall a b. (a -> b) -> a -> b
$
      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 a b. Parser (a -> b) -> Parser a -> Parser b
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 a b. Parser (a -> b) -> Parser a -> Parser b
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 a b. Parser (a -> b) -> Parser a -> Parser b
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 a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
name
        else
          String -> Parser Text
forall a. String -> Parser a
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 a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
description
        else
          String -> Parser Text
forall a. String -> Parser a
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 a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
ticker
        else
          String -> Parser Text
forall a. String -> Parser a
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
  | -- | The length of the JSON-encoded stake pool metadata exceeds the
    -- maximum.
    StakePoolMetadataInvalidLengthError
      !Int
      -- ^ Maximum byte length.
      !Int
      -- ^ Actual byte length.
  deriving (StakePoolMetadataValidationError
-> StakePoolMetadataValidationError -> Bool
(StakePoolMetadataValidationError
 -> StakePoolMetadataValidationError -> Bool)
-> (StakePoolMetadataValidationError
    -> StakePoolMetadataValidationError -> Bool)
-> Eq StakePoolMetadataValidationError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StakePoolMetadataValidationError
-> StakePoolMetadataValidationError -> Bool
== :: StakePoolMetadataValidationError
-> StakePoolMetadataValidationError -> Bool
$c/= :: StakePoolMetadataValidationError
-> StakePoolMetadataValidationError -> Bool
/= :: StakePoolMetadataValidationError
-> StakePoolMetadataValidationError -> Bool
Eq, 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
$cshowsPrec :: Int -> StakePoolMetadataValidationError -> ShowS
showsPrec :: Int -> StakePoolMetadataValidationError -> ShowS
$cshow :: StakePoolMetadataValidationError -> String
show :: StakePoolMetadataValidationError -> String
$cshowList :: [StakePoolMetadataValidationError] -> ShowS
showList :: [StakePoolMetadataValidationError] -> ShowS
Show, Typeable StakePoolMetadataValidationError
Typeable StakePoolMetadataValidationError =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> StakePoolMetadataValidationError
 -> c StakePoolMetadataValidationError)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c StakePoolMetadataValidationError)
-> (StakePoolMetadataValidationError -> Constr)
-> (StakePoolMetadataValidationError -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c StakePoolMetadataValidationError))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c StakePoolMetadataValidationError))
-> ((forall b. Data b => b -> b)
    -> StakePoolMetadataValidationError
    -> StakePoolMetadataValidationError)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> StakePoolMetadataValidationError
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> StakePoolMetadataValidationError
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> StakePoolMetadataValidationError -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> StakePoolMetadataValidationError
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> StakePoolMetadataValidationError
    -> m StakePoolMetadataValidationError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> StakePoolMetadataValidationError
    -> m StakePoolMetadataValidationError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> StakePoolMetadataValidationError
    -> m StakePoolMetadataValidationError)
-> Data StakePoolMetadataValidationError
StakePoolMetadataValidationError -> Constr
StakePoolMetadataValidationError -> DataType
(forall b. Data b => b -> b)
-> StakePoolMetadataValidationError
-> StakePoolMetadataValidationError
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> StakePoolMetadataValidationError
-> u
forall u.
(forall d. Data d => d -> u)
-> StakePoolMetadataValidationError -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> StakePoolMetadataValidationError
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> StakePoolMetadataValidationError
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> StakePoolMetadataValidationError
-> m StakePoolMetadataValidationError
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> StakePoolMetadataValidationError
-> m StakePoolMetadataValidationError
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c StakePoolMetadataValidationError
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> StakePoolMetadataValidationError
-> c StakePoolMetadataValidationError
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c StakePoolMetadataValidationError)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c StakePoolMetadataValidationError)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> StakePoolMetadataValidationError
-> c StakePoolMetadataValidationError
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> StakePoolMetadataValidationError
-> c StakePoolMetadataValidationError
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c StakePoolMetadataValidationError
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c StakePoolMetadataValidationError
$ctoConstr :: StakePoolMetadataValidationError -> Constr
toConstr :: StakePoolMetadataValidationError -> Constr
$cdataTypeOf :: StakePoolMetadataValidationError -> DataType
dataTypeOf :: StakePoolMetadataValidationError -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c StakePoolMetadataValidationError)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c StakePoolMetadataValidationError)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c StakePoolMetadataValidationError)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c StakePoolMetadataValidationError)
$cgmapT :: (forall b. Data b => b -> b)
-> StakePoolMetadataValidationError
-> StakePoolMetadataValidationError
gmapT :: (forall b. Data b => b -> b)
-> StakePoolMetadataValidationError
-> StakePoolMetadataValidationError
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> StakePoolMetadataValidationError
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> StakePoolMetadataValidationError
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> StakePoolMetadataValidationError
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> StakePoolMetadataValidationError
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> StakePoolMetadataValidationError -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> StakePoolMetadataValidationError -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> StakePoolMetadataValidationError
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> StakePoolMetadataValidationError
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> StakePoolMetadataValidationError
-> m StakePoolMetadataValidationError
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> StakePoolMetadataValidationError
-> m StakePoolMetadataValidationError
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> StakePoolMetadataValidationError
-> m StakePoolMetadataValidationError
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> StakePoolMetadataValidationError
-> m StakePoolMetadataValidationError
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> StakePoolMetadataValidationError
-> m StakePoolMetadataValidationError
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> StakePoolMetadataValidationError
-> m StakePoolMetadataValidationError
Data)

instance Error StakePoolMetadataValidationError where
  prettyError :: forall ann. StakePoolMetadataValidationError -> Doc ann
prettyError = \case
    StakePoolMetadataJsonDecodeError String
errStr ->
      String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
errStr
    StakePoolMetadataInvalidLengthError Int
maxLen Int
actualLen ->
      [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat
        [ Doc ann
"Stake pool metadata must consist of at most "
        , Int -> Doc ann
forall ann. Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
maxLen
        , Doc ann
" bytes, but it consists of "
        , Int -> Doc ann
forall ann. Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
actualLen
        , Doc ann
" 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 a b c. (a -> b) -> Either a c -> Either b c
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 a. a -> Either StakePoolMetadataValidationError a
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)