{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

module Cardano.Chain.Update.SoftwareVersion (
  SoftwareVersion (..),
  SoftwareVersionError (..),
  NumSoftwareVersion,
  checkSoftwareVersion,
) where

import Cardano.Chain.Update.ApplicationName
import Cardano.Ledger.Binary (
  DecCBOR (..),
  DecoderError (..),
  EncCBOR (..),
  FromCBOR (..),
  ToCBOR (..),
  cborError,
  decodeWord8,
  encodeListLen,
  enforceSize,
  fromByronCBOR,
  toByronCBOR,
 )
import Cardano.Prelude hiding (cborError)
import Data.Aeson (ToJSON)
import Data.Data (Data)
import Formatting (bprint, build, formatToString, int, stext)
import qualified Formatting.Buildable as B (Buildable (..))
import NoThunks.Class (NoThunks (..))
import qualified Prelude

-- | Numeric software version associated with 'ApplicationName'
type NumSoftwareVersion = Word32

-- | Software version
data SoftwareVersion = SoftwareVersion
  { SoftwareVersion -> ApplicationName
svAppName :: !ApplicationName
  , SoftwareVersion -> NumSoftwareVersion
svNumber :: !NumSoftwareVersion
  }
  deriving (SoftwareVersion -> SoftwareVersion -> Bool
(SoftwareVersion -> SoftwareVersion -> Bool)
-> (SoftwareVersion -> SoftwareVersion -> Bool)
-> Eq SoftwareVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SoftwareVersion -> SoftwareVersion -> Bool
== :: SoftwareVersion -> SoftwareVersion -> Bool
$c/= :: SoftwareVersion -> SoftwareVersion -> Bool
/= :: SoftwareVersion -> SoftwareVersion -> Bool
Eq, (forall x. SoftwareVersion -> Rep SoftwareVersion x)
-> (forall x. Rep SoftwareVersion x -> SoftwareVersion)
-> Generic SoftwareVersion
forall x. Rep SoftwareVersion x -> SoftwareVersion
forall x. SoftwareVersion -> Rep SoftwareVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SoftwareVersion -> Rep SoftwareVersion x
from :: forall x. SoftwareVersion -> Rep SoftwareVersion x
$cto :: forall x. Rep SoftwareVersion x -> SoftwareVersion
to :: forall x. Rep SoftwareVersion x -> SoftwareVersion
Generic, Eq SoftwareVersion
Eq SoftwareVersion =>
(SoftwareVersion -> SoftwareVersion -> Ordering)
-> (SoftwareVersion -> SoftwareVersion -> Bool)
-> (SoftwareVersion -> SoftwareVersion -> Bool)
-> (SoftwareVersion -> SoftwareVersion -> Bool)
-> (SoftwareVersion -> SoftwareVersion -> Bool)
-> (SoftwareVersion -> SoftwareVersion -> SoftwareVersion)
-> (SoftwareVersion -> SoftwareVersion -> SoftwareVersion)
-> Ord SoftwareVersion
SoftwareVersion -> SoftwareVersion -> Bool
SoftwareVersion -> SoftwareVersion -> Ordering
SoftwareVersion -> SoftwareVersion -> SoftwareVersion
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
$ccompare :: SoftwareVersion -> SoftwareVersion -> Ordering
compare :: SoftwareVersion -> SoftwareVersion -> Ordering
$c< :: SoftwareVersion -> SoftwareVersion -> Bool
< :: SoftwareVersion -> SoftwareVersion -> Bool
$c<= :: SoftwareVersion -> SoftwareVersion -> Bool
<= :: SoftwareVersion -> SoftwareVersion -> Bool
$c> :: SoftwareVersion -> SoftwareVersion -> Bool
> :: SoftwareVersion -> SoftwareVersion -> Bool
$c>= :: SoftwareVersion -> SoftwareVersion -> Bool
>= :: SoftwareVersion -> SoftwareVersion -> Bool
$cmax :: SoftwareVersion -> SoftwareVersion -> SoftwareVersion
max :: SoftwareVersion -> SoftwareVersion -> SoftwareVersion
$cmin :: SoftwareVersion -> SoftwareVersion -> SoftwareVersion
min :: SoftwareVersion -> SoftwareVersion -> SoftwareVersion
Ord)
  deriving anyclass (SoftwareVersion -> ()
(SoftwareVersion -> ()) -> NFData SoftwareVersion
forall a. (a -> ()) -> NFData a
$crnf :: SoftwareVersion -> ()
rnf :: SoftwareVersion -> ()
NFData, Context -> SoftwareVersion -> IO (Maybe ThunkInfo)
Proxy SoftwareVersion -> String
(Context -> SoftwareVersion -> IO (Maybe ThunkInfo))
-> (Context -> SoftwareVersion -> IO (Maybe ThunkInfo))
-> (Proxy SoftwareVersion -> String)
-> NoThunks SoftwareVersion
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> SoftwareVersion -> IO (Maybe ThunkInfo)
noThunks :: Context -> SoftwareVersion -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> SoftwareVersion -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> SoftwareVersion -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy SoftwareVersion -> String
showTypeOf :: Proxy SoftwareVersion -> String
NoThunks)

instance B.Buildable SoftwareVersion where
  build :: SoftwareVersion -> Builder
build SoftwareVersion
sv =
    Format Builder (Text -> NumSoftwareVersion -> Builder)
-> Text -> NumSoftwareVersion -> Builder
forall a. Format Builder a -> a
bprint (Format
  (NumSoftwareVersion -> Builder)
  (Text -> NumSoftwareVersion -> Builder)
forall r. Format r (Text -> r)
stext Format
  (NumSoftwareVersion -> Builder)
  (Text -> NumSoftwareVersion -> Builder)
-> Format Builder (NumSoftwareVersion -> Builder)
-> Format Builder (Text -> NumSoftwareVersion -> Builder)
forall b c a. Format b c -> Format a b -> Format a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (NumSoftwareVersion -> Builder) (NumSoftwareVersion -> Builder)
":" Format
  (NumSoftwareVersion -> Builder) (NumSoftwareVersion -> Builder)
-> Format Builder (NumSoftwareVersion -> Builder)
-> Format Builder (NumSoftwareVersion -> Builder)
forall b c a. Format b c -> Format a b -> Format a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (NumSoftwareVersion -> Builder)
forall a r. Integral a => Format r (a -> r)
int) (ApplicationName -> Text
unApplicationName (ApplicationName -> Text) -> ApplicationName -> Text
forall a b. (a -> b) -> a -> b
$ SoftwareVersion -> ApplicationName
svAppName SoftwareVersion
sv) (SoftwareVersion -> NumSoftwareVersion
svNumber SoftwareVersion
sv)

instance Show SoftwareVersion where
  show :: SoftwareVersion -> String
show = Format String (SoftwareVersion -> String)
-> SoftwareVersion -> String
forall a. Format String a -> a
formatToString Format String (SoftwareVersion -> String)
forall a r. Buildable a => Format r (a -> r)
build

-- Used for debugging purposes only
instance ToJSON SoftwareVersion

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

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

instance EncCBOR SoftwareVersion where
  encCBOR :: SoftwareVersion -> Encoding
encCBOR SoftwareVersion
sv = Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ApplicationName -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (SoftwareVersion -> ApplicationName
svAppName SoftwareVersion
sv) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> NumSoftwareVersion -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (SoftwareVersion -> NumSoftwareVersion
svNumber SoftwareVersion
sv)

  encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy SoftwareVersion -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
f Proxy SoftwareVersion
sv =
    Size
1
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy ApplicationName -> Size
forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr Proxy t -> Size
forall t. EncCBOR t => Proxy t -> Size
f (SoftwareVersion -> ApplicationName
svAppName (SoftwareVersion -> ApplicationName)
-> Proxy SoftwareVersion -> Proxy ApplicationName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy SoftwareVersion
sv)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy NumSoftwareVersion -> Size
forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr Proxy t -> Size
forall t. EncCBOR t => Proxy t -> Size
f (SoftwareVersion -> NumSoftwareVersion
svNumber (SoftwareVersion -> NumSoftwareVersion)
-> Proxy SoftwareVersion -> Proxy NumSoftwareVersion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy SoftwareVersion
sv)

instance DecCBOR SoftwareVersion where
  decCBOR :: forall s. Decoder s SoftwareVersion
decCBOR = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"SoftwareVersion" Int
2
    ApplicationName -> NumSoftwareVersion -> SoftwareVersion
SoftwareVersion (ApplicationName -> NumSoftwareVersion -> SoftwareVersion)
-> Decoder s ApplicationName
-> Decoder s (NumSoftwareVersion -> SoftwareVersion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s ApplicationName
forall s. Decoder s ApplicationName
forall a s. DecCBOR a => Decoder s a
decCBOR Decoder s (NumSoftwareVersion -> SoftwareVersion)
-> Decoder s NumSoftwareVersion -> Decoder s SoftwareVersion
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s NumSoftwareVersion
forall s. Decoder s NumSoftwareVersion
forall a s. DecCBOR a => Decoder s a
decCBOR

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

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

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

instance EncCBOR SoftwareVersionError where
  encCBOR :: SoftwareVersionError -> Encoding
encCBOR (SoftwareVersionApplicationNameError ApplicationNameError
applicationNameError) =
    Word -> Encoding
encodeListLen Word
2
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
0 :: Word8)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ApplicationNameError -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR ApplicationNameError
applicationNameError

instance DecCBOR SoftwareVersionError where
  decCBOR :: forall s. Decoder s SoftwareVersionError
decCBOR = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"SoftwareVersionError" Int
2
    Word8
tag <- Decoder s Word8
forall s. Decoder s Word8
decodeWord8
    case Word8
tag of
      Word8
0 -> ApplicationNameError -> SoftwareVersionError
SoftwareVersionApplicationNameError (ApplicationNameError -> SoftwareVersionError)
-> Decoder s ApplicationNameError -> Decoder s SoftwareVersionError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s ApplicationNameError
forall s. Decoder s ApplicationNameError
forall a s. DecCBOR a => Decoder s a
decCBOR
      Word8
_ -> DecoderError -> Decoder s SoftwareVersionError
forall (m :: * -> *) e a. (MonadFail m, Buildable e) => e -> m a
cborError (DecoderError -> Decoder s SoftwareVersionError)
-> DecoderError -> Decoder s SoftwareVersionError
forall a b. (a -> b) -> a -> b
$ Text -> Word8 -> DecoderError
DecoderErrorUnknownTag Text
"SoftwareVersionError" Word8
tag

instance B.Buildable SoftwareVersionError where
  build :: SoftwareVersionError -> Builder
build = \case
    SoftwareVersionApplicationNameError ApplicationNameError
err ->
      Format Builder (ApplicationNameError -> Builder)
-> ApplicationNameError -> Builder
forall a. Format Builder a -> a
bprint
        ( Format
  (ApplicationNameError -> Builder) (ApplicationNameError -> Builder)
"ApplicationName was invalid when checking SoftwareVersion\n Error:"
            Format
  (ApplicationNameError -> Builder) (ApplicationNameError -> Builder)
-> Format Builder (ApplicationNameError -> Builder)
-> Format Builder (ApplicationNameError -> Builder)
forall b c a. Format b c -> Format a b -> Format a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (ApplicationNameError -> Builder)
forall a r. Buildable a => Format r (a -> r)
build
        )
        ApplicationNameError
err

-- | A software version is valid iff its application name is valid
checkSoftwareVersion ::
  MonadError SoftwareVersionError m => SoftwareVersion -> m ()
checkSoftwareVersion :: forall (m :: * -> *).
MonadError SoftwareVersionError m =>
SoftwareVersion -> m ()
checkSoftwareVersion SoftwareVersion
sv =
  ApplicationName -> Either ApplicationNameError ()
forall (m :: * -> *).
MonadError ApplicationNameError m =>
ApplicationName -> m ()
checkApplicationName (SoftwareVersion -> ApplicationName
svAppName SoftwareVersion
sv)
    Either ApplicationNameError ()
-> (ApplicationNameError -> SoftwareVersionError) -> m ()
forall e' (m :: * -> *) e a.
MonadError e' m =>
Either e a -> (e -> e') -> m a
`wrapError` ApplicationNameError -> SoftwareVersionError
SoftwareVersionApplicationNameError