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

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

import           Cardano.Prelude
import           Prelude (String)

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

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


class HasTypeProxy 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

data RawBytesHexError
  = RawBytesHexErrorBase16DecodeFail
      ByteString -- ^ original input
      String -- ^ error message
  | RawBytesHexErrorRawBytesDecodeFail
      ByteString -- ^ original input
      -- TODO(2022-01-26, cblp) TypeRep -- ^ output type proxy
  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
forall a b. (Show a, ConvertText String b) => a -> b
show ByteString
input String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"; "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
message
    RawBytesHexErrorRawBytesDecodeFail ByteString
input ->
      String
"Failed to deserialise " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a b. (Show a, ConvertText String b) => a -> b
show ByteString
input
      -- TODO(2022-01-26, cblp) show expected output type

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 -> RawBytesHexError
RawBytesHexErrorRawBytesDecodeFail ByteString
hex) 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