{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | Raw binary serialisation
--
module Cardano.Api.SerialiseRaw
  ( RawBytesHexError(..)
  , SerialiseAsRawBytes(..)
  , serialiseToRawBytesHex
  , deserialiseFromRawBytesHex
  , serialiseToRawBytesHexText
  ) where

import           Cardano.Prelude
import           Prelude (String)

import qualified Data.ByteString.Base16 as Base16
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text

import           Cardano.Api.Error (Error, displayError)
import           Cardano.Api.HasTypeProxy

class (HasTypeProxy a, Typeable a) => SerialiseAsRawBytes a where

  serialiseToRawBytes :: a -> ByteString

  deserialiseFromRawBytes :: AsType a -> ByteString -> Maybe a

serialiseToRawBytesHex :: SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytesHex :: a -> ByteString
serialiseToRawBytesHex = ByteString -> ByteString
Base16.encode (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes

serialiseToRawBytesHexText :: SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText :: a -> Text
serialiseToRawBytesHexText = ByteString -> Text
Text.decodeUtf8 (ByteString -> Text) -> (a -> ByteString) -> a -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytesHex

-- | The errors that the pure 'SerialiseAsRawBytes' parsing\/decoding functions can return.
data RawBytesHexError
  = RawBytesHexErrorBase16DecodeFail
      ByteString -- ^ original input
      String -- ^ error message
  | RawBytesHexErrorRawBytesDecodeFail
      ByteString -- ^ original input
      TypeRep    -- ^ expected type
  deriving (Int -> RawBytesHexError -> ShowS
[RawBytesHexError] -> ShowS
RawBytesHexError -> String
(Int -> RawBytesHexError -> ShowS)
-> (RawBytesHexError -> String)
-> ([RawBytesHexError] -> ShowS)
-> Show RawBytesHexError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RawBytesHexError] -> ShowS
$cshowList :: [RawBytesHexError] -> ShowS
show :: RawBytesHexError -> String
$cshow :: RawBytesHexError -> String
showsPrec :: Int -> RawBytesHexError -> ShowS
$cshowsPrec :: Int -> RawBytesHexError -> ShowS
Show)

instance Error RawBytesHexError where
  displayError :: RawBytesHexError -> String
displayError = \case
    RawBytesHexErrorBase16DecodeFail ByteString
input String
message ->
      String
"Expected Base16-encoded bytestring, but got " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
pretty ByteString
input String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"; "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
message
    RawBytesHexErrorRawBytesDecodeFail ByteString
input TypeRep
asType ->
      String
"Failed to deserialise " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
pretty ByteString
input String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" as " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TypeRep -> String
forall a b. (Show a, ConvertText String b) => a -> b
show TypeRep
asType
    where
      pretty :: ByteString -> String
pretty ByteString
bs = case ByteString -> Either UnicodeException Text
Text.decodeUtf8' ByteString
bs of
        Right Text
t -> Text -> String
Text.unpack Text
t
        Left UnicodeException
_ -> ByteString -> String
forall a b. (Show a, ConvertText String b) => a -> b
show ByteString
bs

deserialiseFromRawBytesHex
  :: SerialiseAsRawBytes a
  => AsType a -> ByteString -> Either RawBytesHexError a
deserialiseFromRawBytesHex :: AsType a -> ByteString -> Either RawBytesHexError a
deserialiseFromRawBytesHex AsType a
proxy ByteString
hex = do
  ByteString
raw <- (String -> RawBytesHexError)
-> Either String ByteString -> Either RawBytesHexError ByteString
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (ByteString -> String -> RawBytesHexError
RawBytesHexErrorBase16DecodeFail ByteString
hex) (Either String ByteString -> Either RawBytesHexError ByteString)
-> Either String ByteString -> Either RawBytesHexError ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String ByteString
Base16.decode ByteString
hex
  Either RawBytesHexError a
-> (a -> Either RawBytesHexError a)
-> Maybe a
-> Either RawBytesHexError a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (RawBytesHexError -> Either RawBytesHexError a
forall a b. a -> Either a b
Left (RawBytesHexError -> Either RawBytesHexError a)
-> RawBytesHexError -> Either RawBytesHexError a
forall a b. (a -> b) -> a -> b
$ ByteString -> TypeRep -> RawBytesHexError
RawBytesHexErrorRawBytesDecodeFail ByteString
hex (TypeRep -> RawBytesHexError) -> TypeRep -> RawBytesHexError
forall a b. (a -> b) -> a -> b
$ AsType a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep AsType a
proxy) a -> Either RawBytesHexError a
forall a b. b -> Either a b
Right (Maybe a -> Either RawBytesHexError a)
-> Maybe a -> Either RawBytesHexError a
forall a b. (a -> b) -> a -> b
$
    AsType a -> ByteString -> Maybe a
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Maybe a
deserialiseFromRawBytes AsType a
proxy ByteString
raw