{-# LANGUAGE ScopedTypeVariables #-}

-- DUPLICATE -- adapted from: cardano-api/src/Cardano/Api/SerialiseUsing.hs

-- | Raw binary serialisation
--
module Cardano.Api.SerialiseUsing (
    UsingRawBytes (..)
  , UsingRawBytesHex (..)
  ) where

import           Cardano.Api.Any
import           Data.Aeson.Types (FromJSON, FromJSONKey, ToJSON (..),
                     ToJSONKey)
import qualified Data.Aeson.Types as Aeson
import           Data.ByteString (ByteString)
import qualified Data.ByteString.Base16 as Base16
import qualified Data.ByteString.Char8 as BSC
import           Data.String (IsString (..))
import qualified Data.Text.Encoding as Text
import           Data.Typeable (Typeable, tyConName, typeRep, typeRepTyCon)


-- | For use with @deriving via@, to provide 'ToCBOR' and 'FromCBOR' instances,
-- based on the 'SerialiseAsRawBytes' instance. Eg:
--
-- > deriving (ToCBOR, FromCBOR) via (UsingRawBytes Blah)
--
newtype UsingRawBytes a = UsingRawBytes a

instance (SerialiseAsRawBytes a, Typeable a) => ToCBOR (UsingRawBytes a) where
    toCBOR :: UsingRawBytes a -> Encoding
toCBOR (UsingRawBytes a
x) = ByteString -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (a -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes a
x)

instance (SerialiseAsRawBytes a, Typeable a) => FromCBOR (UsingRawBytes a) where
    fromCBOR :: forall s. Decoder s (UsingRawBytes a)
fromCBOR = do
      ByteString
bs <- Decoder s ByteString
forall s. Decoder s ByteString
forall a s. FromCBOR a => Decoder s a
fromCBOR
      case AsType a -> ByteString -> Maybe a
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Maybe a
deserialiseFromRawBytes AsType a
ttoken ByteString
bs of
        Just a
x  -> UsingRawBytes a -> Decoder s (UsingRawBytes a)
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> UsingRawBytes a
forall a. a -> UsingRawBytes a
UsingRawBytes a
x)
        Maybe a
Nothing -> String -> Decoder s (UsingRawBytes a)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"cannot deserialise as a " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
tname)
      where
        ttoken :: AsType a
ttoken = Proxy a -> AsType a
forall t. HasTypeProxy t => Proxy t -> AsType t
proxyToAsType (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
        tname :: String
tname  = (TyCon -> String
tyConName (TyCon -> String) -> (Proxy a -> TyCon) -> Proxy a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRep -> TyCon
typeRepTyCon (TypeRep -> TyCon) -> (Proxy a -> TypeRep) -> Proxy a -> TyCon
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep) (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)

instance (SerialiseAsRawBytes a, Typeable a) => EncCBOR (UsingRawBytes a)

instance (SerialiseAsRawBytes a, Typeable a) => DecCBOR (UsingRawBytes a)


-- | For use with @deriving via@, to provide instances for any\/all of 'Show',
-- 'IsString', 'ToJSON', 'FromJSON', 'ToJSONKey', FromJSONKey' using a hex
-- encoding, based on the 'SerialiseAsRawBytes' instance.
--
-- > deriving (Show, IsString) via (UsingRawBytesHex Blah)
-- > deriving (ToJSON, FromJSON) via (UsingRawBytesHex Blah)
-- > deriving (ToJSONKey, FromJSONKey) via (UsingRawBytesHex Blah)
--
newtype UsingRawBytesHex a = UsingRawBytesHex a

instance SerialiseAsRawBytes a => Show (UsingRawBytesHex a) where
    show :: UsingRawBytesHex a -> String
show (UsingRawBytesHex a
x) = ByteString -> String
forall a. Show a => a -> String
show (a -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytesHex a
x)

instance SerialiseAsRawBytes a => IsString (UsingRawBytesHex a) where
    fromString :: String -> UsingRawBytesHex a
fromString = (String -> UsingRawBytesHex a)
-> (UsingRawBytesHex a -> UsingRawBytesHex a)
-> Either String (UsingRawBytesHex a)
-> UsingRawBytesHex a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> UsingRawBytesHex a
forall a. HasCallStack => String -> a
error UsingRawBytesHex a -> UsingRawBytesHex a
forall a. a -> a
id (Either String (UsingRawBytesHex a) -> UsingRawBytesHex a)
-> (String -> Either String (UsingRawBytesHex a))
-> String
-> UsingRawBytesHex a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String (UsingRawBytesHex a)
forall a.
SerialiseAsRawBytes a =>
ByteString -> Either String (UsingRawBytesHex a)
deserialiseFromRawBytesBase16 (ByteString -> Either String (UsingRawBytesHex a))
-> (String -> ByteString)
-> String
-> Either String (UsingRawBytesHex a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BSC.pack

instance SerialiseAsRawBytes a => ToJSON (UsingRawBytesHex a) where
    toJSON :: UsingRawBytesHex a -> Value
toJSON (UsingRawBytesHex a
x) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (a -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText a
x)

instance (SerialiseAsRawBytes a, Typeable a) => FromJSON (UsingRawBytesHex a) where
  parseJSON :: Value -> Parser (UsingRawBytesHex a)
parseJSON =
    String
-> (Text -> Parser (UsingRawBytesHex a))
-> Value
-> Parser (UsingRawBytesHex a)
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
tname ((Text -> Parser (UsingRawBytesHex a))
 -> Value -> Parser (UsingRawBytesHex a))
-> (Text -> Parser (UsingRawBytesHex a))
-> Value
-> Parser (UsingRawBytesHex a)
forall a b. (a -> b) -> a -> b
$
      (String -> Parser (UsingRawBytesHex a))
-> (UsingRawBytesHex a -> Parser (UsingRawBytesHex a))
-> Either String (UsingRawBytesHex a)
-> Parser (UsingRawBytesHex a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser (UsingRawBytesHex a)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail UsingRawBytesHex a -> Parser (UsingRawBytesHex a)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String (UsingRawBytesHex a) -> Parser (UsingRawBytesHex a))
-> (Text -> Either String (UsingRawBytesHex a))
-> Text
-> Parser (UsingRawBytesHex a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String (UsingRawBytesHex a)
forall a.
SerialiseAsRawBytes a =>
ByteString -> Either String (UsingRawBytesHex a)
deserialiseFromRawBytesBase16 (ByteString -> Either String (UsingRawBytesHex a))
-> (Text -> ByteString)
-> Text
-> Either String (UsingRawBytesHex a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8
    where
      tname :: String
tname  = (TyCon -> String
tyConName (TyCon -> String) -> (Proxy a -> TyCon) -> Proxy a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRep -> TyCon
typeRepTyCon (TypeRep -> TyCon) -> (Proxy a -> TypeRep) -> Proxy a -> TyCon
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep) (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)

instance SerialiseAsRawBytes a => ToJSONKey (UsingRawBytesHex a) where
  toJSONKey :: ToJSONKeyFunction (UsingRawBytesHex a)
toJSONKey =
    (UsingRawBytesHex a -> Text)
-> ToJSONKeyFunction (UsingRawBytesHex a)
forall a. (a -> Text) -> ToJSONKeyFunction a
Aeson.toJSONKeyText ((UsingRawBytesHex a -> Text)
 -> ToJSONKeyFunction (UsingRawBytesHex a))
-> (UsingRawBytesHex a -> Text)
-> ToJSONKeyFunction (UsingRawBytesHex a)
forall a b. (a -> b) -> a -> b
$ \(UsingRawBytesHex a
x) -> a -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText a
x

instance
  (SerialiseAsRawBytes a, Typeable a) => FromJSONKey (UsingRawBytesHex a) where

  fromJSONKey :: FromJSONKeyFunction (UsingRawBytesHex a)
fromJSONKey =
    (Text -> Parser (UsingRawBytesHex a))
-> FromJSONKeyFunction (UsingRawBytesHex a)
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
Aeson.FromJSONKeyTextParser ((Text -> Parser (UsingRawBytesHex a))
 -> FromJSONKeyFunction (UsingRawBytesHex a))
-> (Text -> Parser (UsingRawBytesHex a))
-> FromJSONKeyFunction (UsingRawBytesHex a)
forall a b. (a -> b) -> a -> b
$
    (String -> Parser (UsingRawBytesHex a))
-> (UsingRawBytesHex a -> Parser (UsingRawBytesHex a))
-> Either String (UsingRawBytesHex a)
-> Parser (UsingRawBytesHex a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser (UsingRawBytesHex a)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail UsingRawBytesHex a -> Parser (UsingRawBytesHex a)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String (UsingRawBytesHex a) -> Parser (UsingRawBytesHex a))
-> (Text -> Either String (UsingRawBytesHex a))
-> Text
-> Parser (UsingRawBytesHex a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String (UsingRawBytesHex a)
forall a.
SerialiseAsRawBytes a =>
ByteString -> Either String (UsingRawBytesHex a)
deserialiseFromRawBytesBase16 (ByteString -> Either String (UsingRawBytesHex a))
-> (Text -> ByteString)
-> Text
-> Either String (UsingRawBytesHex a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8

deserialiseFromRawBytesBase16 ::
  SerialiseAsRawBytes a => ByteString -> Either String (UsingRawBytesHex a)
deserialiseFromRawBytesBase16 :: forall a.
SerialiseAsRawBytes a =>
ByteString -> Either String (UsingRawBytesHex a)
deserialiseFromRawBytesBase16 ByteString
str =
  case ByteString -> Either String ByteString
Base16.decode ByteString
str of
    Right ByteString
raw -> case AsType a -> ByteString -> Maybe a
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Maybe a
deserialiseFromRawBytes AsType a
ttoken ByteString
raw of
      Just a
x  -> UsingRawBytesHex a -> Either String (UsingRawBytesHex a)
forall a b. b -> Either a b
Right (a -> UsingRawBytesHex a
forall a. a -> UsingRawBytesHex a
UsingRawBytesHex a
x)
      Maybe a
Nothing -> String -> Either String (UsingRawBytesHex a)
forall a b. a -> Either a b
Left (String
"cannot deserialise " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
str)
    Left String
msg  -> String -> Either String (UsingRawBytesHex a)
forall a b. a -> Either a b
Left (String
"invalid hex " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
str String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg)
  where
    ttoken :: AsType a
ttoken = Proxy a -> AsType a
forall t. HasTypeProxy t => Proxy t -> AsType t
proxyToAsType (Proxy a
forall {a}. Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)