{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

module Cardano.Chain.Update.ApplicationName (
  ApplicationName (..),
  applicationNameMaxLength,
  ApplicationNameError (..),
  checkApplicationName,
)
where

import Cardano.Ledger.Binary (
  Case (..),
  DecCBOR (..),
  Decoder,
  DecoderError (..),
  EncCBOR (..),
  FromCBOR (..),
  ToCBOR (..),
  cborError,
  decodeListLen,
  decodeWord8,
  encodeListLen,
  fromByronCBOR,
  matchSize,
  szCases,
  toByronCBOR,
 )
import Cardano.Prelude hiding (cborError)
import Data.Aeson (ToJSON)
import Data.Data (Data)
import qualified Data.Text as T
import Formatting (bprint, int, stext)
import qualified Formatting.Buildable as B
import NoThunks.Class (NoThunks (..))

newtype ApplicationName = ApplicationName
  { ApplicationName -> Text
unApplicationName :: Text
  }
  deriving (ApplicationName -> ApplicationName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApplicationName -> ApplicationName -> Bool
$c/= :: ApplicationName -> ApplicationName -> Bool
== :: ApplicationName -> ApplicationName -> Bool
$c== :: ApplicationName -> ApplicationName -> Bool
Eq, Eq ApplicationName
ApplicationName -> ApplicationName -> Bool
ApplicationName -> ApplicationName -> Ordering
ApplicationName -> ApplicationName -> ApplicationName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ApplicationName -> ApplicationName -> ApplicationName
$cmin :: ApplicationName -> ApplicationName -> ApplicationName
max :: ApplicationName -> ApplicationName -> ApplicationName
$cmax :: ApplicationName -> ApplicationName -> ApplicationName
>= :: ApplicationName -> ApplicationName -> Bool
$c>= :: ApplicationName -> ApplicationName -> Bool
> :: ApplicationName -> ApplicationName -> Bool
$c> :: ApplicationName -> ApplicationName -> Bool
<= :: ApplicationName -> ApplicationName -> Bool
$c<= :: ApplicationName -> ApplicationName -> Bool
< :: ApplicationName -> ApplicationName -> Bool
$c< :: ApplicationName -> ApplicationName -> Bool
compare :: ApplicationName -> ApplicationName -> Ordering
$ccompare :: ApplicationName -> ApplicationName -> Ordering
Ord, Int -> ApplicationName -> ShowS
[ApplicationName] -> ShowS
ApplicationName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApplicationName] -> ShowS
$cshowList :: [ApplicationName] -> ShowS
show :: ApplicationName -> String
$cshow :: ApplicationName -> String
showsPrec :: Int -> ApplicationName -> ShowS
$cshowsPrec :: Int -> ApplicationName -> ShowS
Show, forall x. Rep ApplicationName x -> ApplicationName
forall x. ApplicationName -> Rep ApplicationName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApplicationName x -> ApplicationName
$cfrom :: forall x. ApplicationName -> Rep ApplicationName x
Generic, ApplicationName -> Builder
forall p. (p -> Builder) -> Buildable p
build :: ApplicationName -> Builder
$cbuild :: ApplicationName -> Builder
B.Buildable, ApplicationName -> ()
forall a. (a -> ()) -> NFData a
rnf :: ApplicationName -> ()
$crnf :: ApplicationName -> ()
NFData, Context -> ApplicationName -> IO (Maybe ThunkInfo)
Proxy ApplicationName -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy ApplicationName -> String
$cshowTypeOf :: Proxy ApplicationName -> String
wNoThunks :: Context -> ApplicationName -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> ApplicationName -> IO (Maybe ThunkInfo)
noThunks :: Context -> ApplicationName -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> ApplicationName -> IO (Maybe ThunkInfo)
NoThunks)

instance ToCBOR ApplicationName where
  toCBOR :: ApplicationName -> Encoding
toCBOR = forall a. EncCBOR a => a -> Encoding
toByronCBOR

instance FromCBOR ApplicationName where
  fromCBOR :: forall s. Decoder s ApplicationName
fromCBOR = forall a s. DecCBOR a => Decoder s a
fromByronCBOR

instance EncCBOR ApplicationName where
  encCBOR :: ApplicationName -> Encoding
encCBOR ApplicationName
appName = forall a. EncCBOR a => a -> Encoding
encCBOR (ApplicationName -> Text
unApplicationName ApplicationName
appName)
  encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy ApplicationName -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
_ Proxy ApplicationName
_ =
    Size
1
      forall a. Num a => a -> a -> a
+ [Case Size] -> Size
szCases
        [ forall t. Text -> t -> Case t
Case Text
"minBound" Size
0
        , forall t. Text -> t -> Case t
Case Text
"maxBound" (forall a. Num a => Integer -> a
fromInteger forall i. Integral i => i
applicationNameMaxLength)
        ]

instance DecCBOR ApplicationName where
  decCBOR :: forall s. Decoder s ApplicationName
decCBOR = Text -> ApplicationName
ApplicationName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR

data ApplicationNameError
  = ApplicationNameTooLong Text
  | ApplicationNameNotAscii Text
  deriving (Typeable ApplicationNameError
ApplicationNameError -> DataType
ApplicationNameError -> Constr
(forall b. Data b => b -> b)
-> ApplicationNameError -> ApplicationNameError
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) -> ApplicationNameError -> u
forall u.
(forall d. Data d => d -> u) -> ApplicationNameError -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ApplicationNameError -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ApplicationNameError -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ApplicationNameError -> m ApplicationNameError
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ApplicationNameError -> m ApplicationNameError
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ApplicationNameError
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ApplicationNameError
-> c ApplicationNameError
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ApplicationNameError)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ApplicationNameError)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ApplicationNameError -> m ApplicationNameError
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ApplicationNameError -> m ApplicationNameError
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ApplicationNameError -> m ApplicationNameError
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ApplicationNameError -> m ApplicationNameError
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ApplicationNameError -> m ApplicationNameError
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ApplicationNameError -> m ApplicationNameError
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ApplicationNameError -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ApplicationNameError -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> ApplicationNameError -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> ApplicationNameError -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ApplicationNameError -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ApplicationNameError -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ApplicationNameError -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ApplicationNameError -> r
gmapT :: (forall b. Data b => b -> b)
-> ApplicationNameError -> ApplicationNameError
$cgmapT :: (forall b. Data b => b -> b)
-> ApplicationNameError -> ApplicationNameError
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ApplicationNameError)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ApplicationNameError)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ApplicationNameError)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ApplicationNameError)
dataTypeOf :: ApplicationNameError -> DataType
$cdataTypeOf :: ApplicationNameError -> DataType
toConstr :: ApplicationNameError -> Constr
$ctoConstr :: ApplicationNameError -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ApplicationNameError
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ApplicationNameError
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ApplicationNameError
-> c ApplicationNameError
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ApplicationNameError
-> c ApplicationNameError
Data, ApplicationNameError -> ApplicationNameError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApplicationNameError -> ApplicationNameError -> Bool
$c/= :: ApplicationNameError -> ApplicationNameError -> Bool
== :: ApplicationNameError -> ApplicationNameError -> Bool
$c== :: ApplicationNameError -> ApplicationNameError -> Bool
Eq, Int -> ApplicationNameError -> ShowS
[ApplicationNameError] -> ShowS
ApplicationNameError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApplicationNameError] -> ShowS
$cshowList :: [ApplicationNameError] -> ShowS
show :: ApplicationNameError -> String
$cshow :: ApplicationNameError -> String
showsPrec :: Int -> ApplicationNameError -> ShowS
$cshowsPrec :: Int -> ApplicationNameError -> ShowS
Show)

-- Used for debugging purposes only
instance ToJSON ApplicationName

instance ToCBOR ApplicationNameError where
  toCBOR :: ApplicationNameError -> Encoding
toCBOR = forall a. EncCBOR a => a -> Encoding
toByronCBOR

instance FromCBOR ApplicationNameError where
  fromCBOR :: forall s. Decoder s ApplicationNameError
fromCBOR = forall a s. DecCBOR a => Decoder s a
fromByronCBOR

instance EncCBOR ApplicationNameError where
  encCBOR :: ApplicationNameError -> Encoding
encCBOR ApplicationNameError
err = case ApplicationNameError
err of
    ApplicationNameTooLong Text
appName ->
      Word -> Encoding
encodeListLen Word
2
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
0 :: Word8)
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR Text
appName
    ApplicationNameNotAscii Text
appName ->
      Word -> Encoding
encodeListLen Word
2
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
1 :: Word8)
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR Text
appName

instance DecCBOR ApplicationNameError where
  decCBOR :: forall s. Decoder s ApplicationNameError
decCBOR = do
    Int
len <- forall s. Decoder s Int
decodeListLen
    let checkSize :: Int -> Decoder s ()
        checkSize :: forall s. Int -> Decoder s ()
checkSize Int
size = forall s. Text -> Int -> Int -> Decoder s ()
matchSize Text
"ApplicationNameError" Int
size Int
len
    Word8
tag <- forall s. Decoder s Word8
decodeWord8
    case Word8
tag of
      Word8
0 -> forall s. Int -> Decoder s ()
checkSize Int
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> ApplicationNameError
ApplicationNameTooLong forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR
      Word8
1 -> forall s. Int -> Decoder s ()
checkSize Int
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> ApplicationNameError
ApplicationNameNotAscii forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR
      Word8
_ -> forall (m :: * -> *) e a. (MonadFail m, Buildable e) => e -> m a
cborError forall a b. (a -> b) -> a -> b
$ Text -> Word8 -> DecoderError
DecoderErrorUnknownTag Text
"ApplicationNameError" Word8
tag

instance B.Buildable ApplicationNameError where
  build :: ApplicationNameError -> Builder
build = \case
    ApplicationNameTooLong Text
name ->
      forall a. Format Builder a -> a
bprint
        (Format (Text -> Int -> Builder) (Text -> Int -> Builder)
"ApplicationName, " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall r. Format r (Text -> r)
stext forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (Int -> Builder) (Int -> Builder)
", exceeds limit of " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Integral a => Format r (a -> r)
int)
        Text
name
        (forall i. Integral i => i
applicationNameMaxLength :: Int)
    ApplicationNameNotAscii Text
name ->
      forall a. Format Builder a -> a
bprint
        (Format (Text -> Builder) (Text -> Builder)
"ApplicationName, " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall r. Format r (Text -> r)
stext forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder Builder
", contains non-ascii characters")
        Text
name

-- | Smart constructor of 'ApplicationName'
checkApplicationName ::
  MonadError ApplicationNameError m => ApplicationName -> m ()
checkApplicationName :: forall (m :: * -> *).
MonadError ApplicationNameError m =>
ApplicationName -> m ()
checkApplicationName (ApplicationName Text
appName)
  | Text -> Int
T.length Text
appName forall a. Ord a => a -> a -> Bool
> forall i. Integral i => i
applicationNameMaxLength =
      forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
        forall a b. (a -> b) -> a -> b
$ Text -> ApplicationNameError
ApplicationNameTooLong Text
appName
  | (Char -> Bool) -> Text -> Bool
T.any (Bool -> Bool
not forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Char -> Bool
isAscii) Text
appName = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> ApplicationNameError
ApplicationNameNotAscii Text
appName
  | Bool
otherwise = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

applicationNameMaxLength :: Integral i => i
applicationNameMaxLength :: forall i. Integral i => i
applicationNameMaxLength = i
12