{- |
Module      : Cardano.YTxP.Control.Parameters
Description : Data required to work with the compiled control scripts

This module is consider deprecated. Use Ply instead.
-}
module Cardano.YTxP.SDK.ControlParameters
  {-# DEPRECATED "Use Ply instead." #-} (
  -- * Types
  YieldingScripts (..),
  ControlParameters (..),
  HexStringScript (..),
  sbsToHexText,
  hexTextToSbs,
) where

import Cardano.YTxP.SDK.SdkParameters (SdkParameters)
import Control.Monad ((<=<))
import Data.Aeson (
  FromJSON (parseJSON),
  ToJSON (toEncoding, toJSON),
  object,
  pairs,
  withObject,
  withText,
  (.:),
  (.=),
 )
import Data.ByteString.Base16 qualified as Base16
import Data.ByteString.Short (ShortByteString)
import Data.ByteString.Short qualified as SBS
import Data.Proxy (Proxy (Proxy))
import Data.Text (Text)
import Data.Text.Encoding qualified as TE
import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)
import Prettyprinter (
  Pretty (pretty),
  align,
  braces,
  punctuate,
  viaShow,
  vsep,
  (<+>),
 )

{- | A helper newtype to ensure that any 'Script's we use are serialized (and
deserialized), consistently. We also have a \'tag\' for a more specific type
name or label when using a via derivation with this, or as part of a larger
type.

See @JSON.md@ for an explanation of our policy. TODO: update json policy
-}
newtype HexStringScript (scriptLabel :: Symbol) = HexStringScript ShortByteString
  deriving newtype (HexStringScript scriptLabel -> HexStringScript scriptLabel -> Bool
(HexStringScript scriptLabel
 -> HexStringScript scriptLabel -> Bool)
-> (HexStringScript scriptLabel
    -> HexStringScript scriptLabel -> Bool)
-> Eq (HexStringScript scriptLabel)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (scriptLabel :: Symbol).
HexStringScript scriptLabel -> HexStringScript scriptLabel -> Bool
$c== :: forall (scriptLabel :: Symbol).
HexStringScript scriptLabel -> HexStringScript scriptLabel -> Bool
== :: HexStringScript scriptLabel -> HexStringScript scriptLabel -> Bool
$c/= :: forall (scriptLabel :: Symbol).
HexStringScript scriptLabel -> HexStringScript scriptLabel -> Bool
/= :: HexStringScript scriptLabel -> HexStringScript scriptLabel -> Bool
Eq)

instance Pretty (HexStringScript (scriptLabel :: Symbol)) where
  pretty :: forall ann. HexStringScript scriptLabel -> Doc ann
pretty (HexStringScript ShortByteString
s) = ShortByteString -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow ShortByteString
s

instance ToJSON (HexStringScript scriptLabel) where
  {-# INLINEABLE toJSON #-}
  toJSON :: HexStringScript scriptLabel -> Value
toJSON (HexStringScript ShortByteString
script) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value)
-> (ShortByteString -> Text) -> ShortByteString -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> Text
sbsToHexText (ShortByteString -> Value) -> ShortByteString -> Value
forall a b. (a -> b) -> a -> b
$ ShortByteString
script
  {-# INLINEABLE toEncoding #-}
  toEncoding :: HexStringScript scriptLabel -> Encoding
toEncoding (HexStringScript ShortByteString
script) = Text -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (Text -> Encoding)
-> (ShortByteString -> Text) -> ShortByteString -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> Text
sbsToHexText (ShortByteString -> Encoding) -> ShortByteString -> Encoding
forall a b. (a -> b) -> a -> b
$ ShortByteString
script

instance (KnownSymbol scriptLabel) => FromJSON (HexStringScript scriptLabel) where
  {-# INLINEABLE parseJSON #-}
  parseJSON :: Value -> Parser (HexStringScript scriptLabel)
parseJSON =
    (HexStringScript scriptLabel -> Parser (HexStringScript scriptLabel)
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (HexStringScript scriptLabel
 -> Parser (HexStringScript scriptLabel))
-> (ShortByteString -> HexStringScript scriptLabel)
-> ShortByteString
-> Parser (HexStringScript scriptLabel)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> HexStringScript scriptLabel
forall (scriptLabel :: Symbol).
ShortByteString -> HexStringScript scriptLabel
HexStringScript)
      (ShortByteString -> Parser (HexStringScript scriptLabel))
-> (Value -> Parser ShortByteString)
-> Value
-> Parser (HexStringScript scriptLabel)
forall (m :: Type -> Type) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< String
-> (Text -> Parser ShortByteString)
-> Value
-> Parser ShortByteString
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
scriptLabel' Text -> Parser ShortByteString
forall (m :: Type -> Type).
MonadFail m =>
Text -> m ShortByteString
hexTextToSbs
    where
      scriptLabel' :: String
      scriptLabel' :: String
scriptLabel' = Proxy @Symbol scriptLabel -> String
forall (n :: Symbol) (proxy :: Symbol -> Type).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy @k t
forall (t :: Symbol). Proxy @Symbol t
Proxy @scriptLabel)

instance (KnownSymbol scriptLabel) => Show (HexStringScript scriptLabel) where
  show :: HexStringScript scriptLabel -> String
show (HexStringScript ShortByteString
script) = String
scriptLabel' String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShortByteString -> String
forall a. Show a => a -> String
show ShortByteString
script
    where
      scriptLabel' :: String
      scriptLabel' :: String
scriptLabel' = Proxy @Symbol scriptLabel -> String
forall (n :: Symbol) (proxy :: Symbol -> Type).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy @k t
forall (t :: Symbol). Proxy @Symbol t
Proxy @scriptLabel)

{- | Scripts that yield to transaction families identified by reference scripts
which carry a state thread token
-}
data YieldingScripts = YieldingScripts
  { YieldingScripts -> [HexStringScript "YieldingMP"]
yieldingMintingPolicies :: [HexStringScript "YieldingMP"]
  -- ^ @since 0.1.0
  , YieldingScripts -> HexStringScript "YieldingValidator"
yieldingValidator :: HexStringScript "YieldingValidator"
  -- ^ @since 0.1.0
  , YieldingScripts -> [HexStringScript "YieldingSV"]
yieldingStakingValidators :: [HexStringScript "YieldingSV"]
  -- ^ @since 0.1.0
  }
  deriving stock (YieldingScripts -> YieldingScripts -> Bool
(YieldingScripts -> YieldingScripts -> Bool)
-> (YieldingScripts -> YieldingScripts -> Bool)
-> Eq YieldingScripts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: YieldingScripts -> YieldingScripts -> Bool
== :: YieldingScripts -> YieldingScripts -> Bool
$c/= :: YieldingScripts -> YieldingScripts -> Bool
/= :: YieldingScripts -> YieldingScripts -> Bool
Eq, Int -> YieldingScripts -> ShowS
[YieldingScripts] -> ShowS
YieldingScripts -> String
(Int -> YieldingScripts -> ShowS)
-> (YieldingScripts -> String)
-> ([YieldingScripts] -> ShowS)
-> Show YieldingScripts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> YieldingScripts -> ShowS
showsPrec :: Int -> YieldingScripts -> ShowS
$cshow :: YieldingScripts -> String
show :: YieldingScripts -> String
$cshowList :: [YieldingScripts] -> ShowS
showList :: [YieldingScripts] -> ShowS
Show)

instance Pretty YieldingScripts where
  pretty :: forall ann. YieldingScripts -> Doc ann
pretty
    YieldingScripts
      { [HexStringScript "YieldingMP"]
$sel:yieldingMintingPolicies:YieldingScripts :: YieldingScripts -> [HexStringScript "YieldingMP"]
yieldingMintingPolicies :: [HexStringScript "YieldingMP"]
yieldingMintingPolicies
      , HexStringScript "YieldingValidator"
$sel:yieldingValidator:YieldingScripts :: YieldingScripts -> HexStringScript "YieldingValidator"
yieldingValidator :: HexStringScript "YieldingValidator"
yieldingValidator
      , [HexStringScript "YieldingSV"]
$sel:yieldingStakingValidators:YieldingScripts :: YieldingScripts -> [HexStringScript "YieldingSV"]
yieldingStakingValidators :: [HexStringScript "YieldingSV"]
yieldingStakingValidators
      } =
      (Doc ann
"YieldingScripts:" <+>) (Doc ann -> Doc ann)
-> ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces (Doc ann -> Doc ann)
-> ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Doc ann -> Doc ann)
-> ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ann] -> Doc ann)
-> ([Doc ann] -> [Doc ann]) -> [Doc ann] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
"," ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$
        [ Doc ann
"yieldingMintingPolicies:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [HexStringScript "YieldingMP"] -> Doc ann
forall ann. [HexStringScript "YieldingMP"] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [HexStringScript "YieldingMP"]
yieldingMintingPolicies
        , Doc ann
"yieldingValidator:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> HexStringScript "YieldingValidator" -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. HexStringScript "YieldingValidator" -> Doc ann
pretty HexStringScript "YieldingValidator"
yieldingValidator
        , Doc ann
"yieldingStakingValidators:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [HexStringScript "YieldingSV"] -> Doc ann
forall ann. [HexStringScript "YieldingSV"] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [HexStringScript "YieldingSV"]
yieldingStakingValidators
        ]

-- | @since 0.1.0
instance ToJSON YieldingScripts where
  {-# INLINEABLE toJSON #-}
  toJSON :: YieldingScripts -> Value
toJSON YieldingScripts
ys =
    [Pair] -> Value
object
      [ Key
"yieldingMintingPolicies" Key -> [HexStringScript "YieldingMP"] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= YieldingScripts -> [HexStringScript "YieldingMP"]
yieldingMintingPolicies YieldingScripts
ys
      , Key
"yieldingValidator" Key -> HexStringScript "YieldingValidator" -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= YieldingScripts -> HexStringScript "YieldingValidator"
yieldingValidator YieldingScripts
ys
      , Key
"yieldingStakingValidators" Key -> [HexStringScript "YieldingSV"] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= YieldingScripts -> [HexStringScript "YieldingSV"]
yieldingStakingValidators YieldingScripts
ys
      ]
  {-# INLINEABLE toEncoding #-}
  toEncoding :: YieldingScripts -> Encoding
toEncoding YieldingScripts
ys =
    Series -> Encoding
pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
      Key
"yieldingMintingPolicies"
        Key -> [HexStringScript "YieldingMP"] -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= YieldingScripts -> [HexStringScript "YieldingMP"]
yieldingMintingPolicies YieldingScripts
ys
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"yieldingValidator"
          Key -> HexStringScript "YieldingValidator" -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= YieldingScripts -> HexStringScript "YieldingValidator"
yieldingValidator YieldingScripts
ys
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"yieldingStakingValidators"
          Key -> [HexStringScript "YieldingSV"] -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= YieldingScripts -> [HexStringScript "YieldingSV"]
yieldingStakingValidators YieldingScripts
ys

-- | @since 0.1.0
instance FromJSON YieldingScripts where
  {-# INLINEABLE parseJSON #-}
  parseJSON :: Value -> Parser YieldingScripts
parseJSON = String
-> (Object -> Parser YieldingScripts)
-> Value
-> Parser YieldingScripts
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"YieldingScripts" ((Object -> Parser YieldingScripts)
 -> Value -> Parser YieldingScripts)
-> (Object -> Parser YieldingScripts)
-> Value
-> Parser YieldingScripts
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
    [HexStringScript "YieldingMP"]
ysmp <- Object
obj Object -> Key -> Parser [HexStringScript "YieldingMP"]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"yieldingMintingPolicies"
    HexStringScript "YieldingValidator"
ysv <- Object
obj Object -> Key -> Parser (HexStringScript "YieldingValidator")
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"yieldingValidator"
    [HexStringScript "YieldingSV"]
ysvs <- Object
obj Object -> Key -> Parser [HexStringScript "YieldingSV"]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"yieldingStakingValidators"
    YieldingScripts -> Parser YieldingScripts
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (YieldingScripts -> Parser YieldingScripts)
-> YieldingScripts -> Parser YieldingScripts
forall a b. (a -> b) -> a -> b
$ [HexStringScript "YieldingMP"]
-> HexStringScript "YieldingValidator"
-> [HexStringScript "YieldingSV"]
-> YieldingScripts
YieldingScripts [HexStringScript "YieldingMP"]
ysmp HexStringScript "YieldingValidator"
ysv [HexStringScript "YieldingSV"]
ysvs

{- | Contains the compiled scripts along with the parameters
they were compiled against. This is useful for _library consumers_
and should contain all of the information needed to work with the
library.
-}
data ControlParameters = ControlParameters
  { ControlParameters -> YieldingScripts
yieldingScripts :: YieldingScripts
  -- ^ @since 0.1.0
  , ControlParameters -> SdkParameters
sdkParameters :: SdkParameters
  -- ^ @since 0.1.0
  }
  deriving stock (ControlParameters -> ControlParameters -> Bool
(ControlParameters -> ControlParameters -> Bool)
-> (ControlParameters -> ControlParameters -> Bool)
-> Eq ControlParameters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ControlParameters -> ControlParameters -> Bool
== :: ControlParameters -> ControlParameters -> Bool
$c/= :: ControlParameters -> ControlParameters -> Bool
/= :: ControlParameters -> ControlParameters -> Bool
Eq, Int -> ControlParameters -> ShowS
[ControlParameters] -> ShowS
ControlParameters -> String
(Int -> ControlParameters -> ShowS)
-> (ControlParameters -> String)
-> ([ControlParameters] -> ShowS)
-> Show ControlParameters
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ControlParameters -> ShowS
showsPrec :: Int -> ControlParameters -> ShowS
$cshow :: ControlParameters -> String
show :: ControlParameters -> String
$cshowList :: [ControlParameters] -> ShowS
showList :: [ControlParameters] -> ShowS
Show)

-- | @since 0.1.0
instance ToJSON ControlParameters where
  {-# INLINEABLE toJSON #-}
  toJSON :: ControlParameters -> Value
toJSON ControlParameters
cp =
    [Pair] -> Value
object
      [ Key
"yieldingScripts" Key -> YieldingScripts -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ControlParameters -> YieldingScripts
yieldingScripts ControlParameters
cp
      , Key
"sdkParameters" Key -> SdkParameters -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ControlParameters -> SdkParameters
sdkParameters ControlParameters
cp
      ]
  {-# INLINEABLE toEncoding #-}
  toEncoding :: ControlParameters -> Encoding
toEncoding ControlParameters
cp =
    Series -> Encoding
pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
      Key
"yieldingScripts"
        Key -> YieldingScripts -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ControlParameters -> YieldingScripts
yieldingScripts ControlParameters
cp
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"sdkParameters"
          Key -> SdkParameters -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ControlParameters -> SdkParameters
sdkParameters ControlParameters
cp

instance FromJSON ControlParameters where
  {-# INLINEABLE parseJSON #-}
  parseJSON :: Value -> Parser ControlParameters
parseJSON = String
-> (Object -> Parser ControlParameters)
-> Value
-> Parser ControlParameters
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ControlParameters" ((Object -> Parser ControlParameters)
 -> Value -> Parser ControlParameters)
-> (Object -> Parser ControlParameters)
-> Value
-> Parser ControlParameters
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
    YieldingScripts
ys <- Object
obj Object -> Key -> Parser YieldingScripts
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"yieldingScripts"
    SdkParameters
cpi <- Object
obj Object -> Key -> Parser SdkParameters
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"sdkParameters"
    ControlParameters -> Parser ControlParameters
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (ControlParameters -> Parser ControlParameters)
-> ControlParameters -> Parser ControlParameters
forall a b. (a -> b) -> a -> b
$ YieldingScripts -> SdkParameters -> ControlParameters
ControlParameters YieldingScripts
ys SdkParameters
cpi

instance Pretty ControlParameters where
  pretty :: forall ann. ControlParameters -> Doc ann
pretty ControlParameters {YieldingScripts
$sel:yieldingScripts:ControlParameters :: ControlParameters -> YieldingScripts
yieldingScripts :: YieldingScripts
yieldingScripts, SdkParameters
$sel:sdkParameters:ControlParameters :: ControlParameters -> SdkParameters
sdkParameters :: SdkParameters
sdkParameters} =
    (Doc ann
"ControlParameters:" <+>) (Doc ann -> Doc ann)
-> ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces (Doc ann -> Doc ann)
-> ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Doc ann -> Doc ann)
-> ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ann] -> Doc ann)
-> ([Doc ann] -> [Doc ann]) -> [Doc ann] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
"," ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$
      [ YieldingScripts -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. YieldingScripts -> Doc ann
pretty YieldingScripts
yieldingScripts
      , SdkParameters -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. SdkParameters -> Doc ann
pretty SdkParameters
sdkParameters
      ]

-- | Converts a 'ShortByteString' into a textual representation in hex.
sbsToHexText :: ShortByteString -> Text
sbsToHexText :: ShortByteString -> Text
sbsToHexText = ByteString -> Text
TE.decodeUtf8 (ByteString -> Text)
-> (ShortByteString -> ByteString) -> ShortByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base16.encode (ByteString -> ByteString)
-> (ShortByteString -> ByteString) -> ShortByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
SBS.fromShort

{- | Attempts to parse the given 'Text' into the 'ShortByteString' that would
have produced it via 'sbsToHexText', indicating parse failures with 'fail'.
-}
hexTextToSbs :: (MonadFail m) => Text -> m ShortByteString
hexTextToSbs :: forall (m :: Type -> Type).
MonadFail m =>
Text -> m ShortByteString
hexTextToSbs Text
t = case ByteString -> Either String ByteString
Base16.decode (ByteString -> Either String ByteString)
-> ByteString -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
TE.encodeUtf8 Text
t of
  Left String
e -> String -> m ShortByteString
forall a. String -> m a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
e
  Right ByteString
b -> ShortByteString -> m ShortByteString
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (ShortByteString -> m ShortByteString)
-> ShortByteString -> m ShortByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ShortByteString
SBS.toShort ByteString
b