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

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

import           Data.Bifunctor (Bifunctor (..))
import           Data.ByteString (ByteString)
import qualified Data.ByteString.Base16 as Base16
import           Data.Data (typeRep)
import           Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import           Data.Typeable (TypeRep, Typeable)

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

newtype SerialiseAsRawBytesError = SerialiseAsRawBytesError
  -- TODO We can do better than use String to carry the error message
  { SerialiseAsRawBytesError -> String
unSerialiseAsRawBytesError :: String
  }
  deriving (SerialiseAsRawBytesError -> SerialiseAsRawBytesError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SerialiseAsRawBytesError -> SerialiseAsRawBytesError -> Bool
$c/= :: SerialiseAsRawBytesError -> SerialiseAsRawBytesError -> Bool
== :: SerialiseAsRawBytesError -> SerialiseAsRawBytesError -> Bool
$c== :: SerialiseAsRawBytesError -> SerialiseAsRawBytesError -> Bool
Eq, Int -> SerialiseAsRawBytesError -> ShowS
[SerialiseAsRawBytesError] -> ShowS
SerialiseAsRawBytesError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SerialiseAsRawBytesError] -> ShowS
$cshowList :: [SerialiseAsRawBytesError] -> ShowS
show :: SerialiseAsRawBytesError -> String
$cshow :: SerialiseAsRawBytesError -> String
showsPrec :: Int -> SerialiseAsRawBytesError -> ShowS
$cshowsPrec :: Int -> SerialiseAsRawBytesError -> ShowS
Show)

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

  serialiseToRawBytes :: a -> ByteString

  deserialiseFromRawBytes :: AsType a -> ByteString -> Either SerialiseAsRawBytesError a

eitherDeserialiseFromRawBytes :: SerialiseAsRawBytes a => AsType a -> ByteString -> Either SerialiseAsRawBytesError a
eitherDeserialiseFromRawBytes :: forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Either SerialiseAsRawBytesError a
eitherDeserialiseFromRawBytes = forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Either SerialiseAsRawBytesError a
deserialiseFromRawBytes
{-# DEPRECATED eitherDeserialiseFromRawBytes "Use deserialiseFromRawBytes instead" #-}

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

serialiseToRawBytesHexText :: SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText :: forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText = ByteString -> Text
Text.decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
      SerialiseAsRawBytesError  -- ^ error message
  deriving (Int -> RawBytesHexError -> ShowS
[RawBytesHexError] -> ShowS
RawBytesHexError -> String
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 " forall a. [a] -> [a] -> [a]
++ ByteString -> String
pretty ByteString
input forall a. [a] -> [a] -> [a]
++ String
"; "
      forall a. [a] -> [a] -> [a]
++ String
message
    RawBytesHexErrorRawBytesDecodeFail ByteString
input TypeRep
asType (SerialiseAsRawBytesError String
e) ->
      String
"Failed to deserialise " forall a. [a] -> [a] -> [a]
++ ByteString -> String
pretty ByteString
input forall a. [a] -> [a] -> [a]
++ String
" as " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show TypeRep
asType forall a. [a] -> [a] -> [a]
++ String
". " forall a. [a] -> [a] -> [a]
++ String
e
    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
_ -> forall a. Show a => a -> String
show ByteString
bs

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