{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- | Module that re-exports everythign from `cardano-binary` package.
--
-- Everything that gets defined in this module should most likely be migrated to
-- `cardano-binary` package.
module Cardano.Ledger.Binary.Plain (
  module Cardano.Binary,
  module Codec.CBOR.Term,
  showDecoderError,
  invalidKey,
  decodeRecordNamed,
  decodeRecordNamedT,
  decodeRecordSum,
  decodeListLikeT,
  serializeAsHexText,
  decodeFullFromHexText,
  encodeEnum,
  decodeEnumBounded,
  withHexText,

  -- * DSIGN
  C.encodeVerKeyDSIGN,
  C.decodeVerKeyDSIGN,
  C.encodeSignKeyDSIGN,
  C.decodeSignKeyDSIGN,
  C.encodeSigDSIGN,
  C.decodeSigDSIGN,
  C.encodeSignedDSIGN,
  C.decodeSignedDSIGN,

  -- * KES
  C.encodeVerKeyKES,
  C.decodeVerKeyKES,
  C.encodeSignKeyKES,
  C.decodeSignKeyKES,
  C.encodeSigKES,
  C.decodeSigKES,
  C.encodeSignedKES,
  C.decodeSignedKES,

  -- * VRF
  C.encodeVerKeyVRF,
  C.decodeVerKeyVRF,
  C.encodeSignKeyVRF,
  C.decodeSignKeyVRF,
  C.encodeCertVRF,
  C.decodeCertVRF,
)
where

import Cardano.Binary hiding (encodedSizeExpr)
import qualified Cardano.Crypto.DSIGN.Class as C
import qualified Cardano.Crypto.KES.Class as C
import qualified Cardano.Crypto.VRF.Class as C
import Codec.CBOR.Term
import Control.Monad (unless)
import Control.Monad.Trans (MonadTrans (..))
import Control.Monad.Trans.Identity (IdentityT (runIdentityT))
import Data.ByteString (ByteString)
import Data.ByteString.Base16 as B16
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import Data.Typeable
import Formatting (build, formatToString)
import qualified Formatting.Buildable as B (Buildable (..))

showDecoderError :: B.Buildable e => e -> String
showDecoderError :: forall e. Buildable e => e -> String
showDecoderError = forall a. Format String a -> a
formatToString forall a r. Buildable a => Format r (a -> r)
build

-- | Encode a type as CBOR and encode it as base16
serializeAsHexText :: ToCBOR a => a -> Text.Text
serializeAsHexText :: forall a. ToCBOR a => a -> Text
serializeAsHexText = ByteString -> Text
Text.decodeLatin1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B16.encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToCBOR a => a -> ByteString
serialize'

withHexText :: (ByteString -> Either DecoderError b) -> Text.Text -> Either DecoderError b
withHexText :: forall b.
(ByteString -> Either DecoderError b)
-> Text -> Either DecoderError b
withHexText ByteString -> Either DecoderError b
f Text
txt =
  case ByteString -> Either String ByteString
B16.decode (Text -> ByteString
Text.encodeUtf8 Text
txt) of
    Left String
err -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecoderError
DecoderErrorCustom Text
"Invalid Hex encoding:" (String -> Text
Text.pack String
err)
    Right ByteString
bs -> ByteString -> Either DecoderError b
f ByteString
bs

-- | Try decoding base16 encode bytes and then try to decoding them as CBOR
decodeFullFromHexText :: FromCBOR a => Text.Text -> Either DecoderError a
decodeFullFromHexText :: forall a. FromCBOR a => Text -> Either DecoderError a
decodeFullFromHexText = forall b.
(ByteString -> Either DecoderError b)
-> Text -> Either DecoderError b
withHexText forall a. FromCBOR a => ByteString -> Either DecoderError a
decodeFull'

-- | Report an error when a numeric key of the type constructor doesn't match.
invalidKey :: MonadFail m => Word -> m a
invalidKey :: forall (m :: * -> *) a. MonadFail m => Word -> m a
invalidKey Word
k = forall (m :: * -> *) e a. (MonadFail m, Buildable e) => e -> m a
cborError forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecoderError
DecoderErrorCustom Text
"Not a valid key:" (String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Word
k)

decodeRecordNamed :: Text.Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed :: forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
name a -> Int
getRecordSize Decoder s a
decoder =
  forall {k} (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT forall a b. (a -> b) -> a -> b
$ forall (m :: (* -> *) -> * -> *) s a.
(MonadTrans m, Monad (m (Decoder s))) =>
Text -> (a -> Int) -> m (Decoder s) a -> m (Decoder s) a
decodeRecordNamedT Text
name a -> Int
getRecordSize (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Decoder s a
decoder)
{-# INLINE decodeRecordNamed #-}

decodeRecordNamedT ::
  (MonadTrans m, Monad (m (Decoder s))) =>
  Text.Text ->
  (a -> Int) ->
  m (Decoder s) a ->
  m (Decoder s) a
decodeRecordNamedT :: forall (m :: (* -> *) -> * -> *) s a.
(MonadTrans m, Monad (m (Decoder s))) =>
Text -> (a -> Int) -> m (Decoder s) a -> m (Decoder s) a
decodeRecordNamedT Text
name a -> Int
getRecordSize m (Decoder s) a
decoder =
  forall (m :: (* -> *) -> * -> *) s a.
(MonadTrans m, Monad (m (Decoder s))) =>
Text
-> m (Decoder s) a
-> (a -> Int -> m (Decoder s) ())
-> m (Decoder s) a
decodeListLikeT Text
name m (Decoder s) a
decoder forall a b. (a -> b) -> a -> b
$ \a
result Int
n ->
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s. Text -> Int -> Int -> Decoder s ()
matchSize (Text
"Record " forall a. Semigroup a => a -> a -> a
<> Text
name) Int
n (a -> Int
getRecordSize a
result)
{-# INLINE decodeRecordNamedT #-}

decodeRecordSum :: Text.Text -> (Word -> Decoder s (Int, a)) -> Decoder s a
decodeRecordSum :: forall s a. Text -> (Word -> Decoder s (Int, a)) -> Decoder s a
decodeRecordSum Text
name Word -> Decoder s (Int, a)
decoder =
  forall {k} (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT forall a b. (a -> b) -> a -> b
$
    forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
      forall (m :: (* -> *) -> * -> *) s a.
(MonadTrans m, Monad (m (Decoder s))) =>
Text
-> m (Decoder s) a
-> (a -> Int -> m (Decoder s) ())
-> m (Decoder s) a
decodeListLikeT Text
name (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall s. Decoder s Word
decodeWord forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word -> Decoder s (Int, a)
decoder)) forall a b. (a -> b) -> a -> b
$ \(Int
size, a
_) Int
n ->
        forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s. Text -> Int -> Int -> Decoder s ()
matchSize (String -> Text
Text.pack String
"Sum " forall a. Semigroup a => a -> a -> a
<> Text
name) Int
size Int
n
{-# INLINE decodeRecordSum #-}

decodeListLikeT ::
  (MonadTrans m, Monad (m (Decoder s))) =>
  -- | Name for error reporting
  Text.Text ->
  -- | Decoder for the datastructure itself
  m (Decoder s) a ->
  -- | In case when length was provided, act upon it.
  (a -> Int -> m (Decoder s) ()) ->
  m (Decoder s) a
decodeListLikeT :: forall (m :: (* -> *) -> * -> *) s a.
(MonadTrans m, Monad (m (Decoder s))) =>
Text
-> m (Decoder s) a
-> (a -> Int -> m (Decoder s) ())
-> m (Decoder s) a
decodeListLikeT Text
name m (Decoder s) a
decoder a -> Int -> m (Decoder s) ()
actOnLength = do
  Maybe Int
lenOrIndef <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s. Decoder s (Maybe Int)
decodeListLenOrIndef
  a
result <- m (Decoder s) a
decoder
  case Maybe Int
lenOrIndef of
    Just Int
n -> a -> Int -> m (Decoder s) ()
actOnLength a
result Int
n
    Maybe Int
Nothing -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ do
      Bool
isBreak <- forall s. Decoder s Bool
decodeBreakOr
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isBreak forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. (MonadFail m, Buildable e) => e -> m a
cborError forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecoderError
DecoderErrorCustom Text
name Text
"Excess terms in array"
  forall (f :: * -> *) a. Applicative f => a -> f a
pure a
result
{-# INLINE decodeListLikeT #-}

encodeEnum :: Enum a => a -> Encoding
encodeEnum :: forall a. Enum a => a -> Encoding
encodeEnum = Int -> Encoding
encodeInt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum

decodeEnumBounded :: forall a s. (Enum a, Bounded a, Typeable a) => Decoder s a
decodeEnumBounded :: forall a s. (Enum a, Bounded a, Typeable a) => Decoder s a
decodeEnumBounded = do
  Int
n <- forall s. Decoder s Int
decodeInt
  if forall a. Enum a => a -> Int
fromEnum (forall a. Bounded a => a
minBound :: a) forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
<= forall a. Enum a => a -> Int
fromEnum (forall a. Bounded a => a
maxBound :: a)
    then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Enum a => Int -> a
toEnum Int
n
    else forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Failed to decode an Enum: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
n forall a. Semigroup a => a -> a -> a
<> String
" for TypeRep: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {k} (t :: k). Proxy t
Proxy @a))
{-# INLINE decodeEnumBounded #-}