{-# LANGUAGE ScopedTypeVariables #-}

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

import           Prelude

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 as Text
import qualified Data.Text.Encoding as Text
import           Data.Typeable (Typeable, tyConName, typeRep, typeRepTyCon)

import           Cardano.Api.Error
import           Cardano.Api.HasTypeProxy
import           Cardano.Api.SerialiseBech32
import           Cardano.Api.SerialiseCBOR
import           Cardano.Api.SerialiseJSON
import           Cardano.Api.SerialiseRaw



-- | For use with @deriving via@, to provide 'ToCBOR' and 'FromCBOR' instances,
-- based on the 'SerialiseAsRawBytes' instance.
--
-- > 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 :: Decoder s (UsingRawBytes a)
fromCBOR = do
      ByteString
bs <- 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 (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 (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)


-- | 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 (m :: * -> *) a. MonadFail m => String -> m a
fail UsingRawBytesHex a -> Parser (UsingRawBytesHex 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 (m :: * -> *) a. MonadFail m => String -> m a
fail UsingRawBytesHex a -> Parser (UsingRawBytesHex 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 :: 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 (forall a. Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)


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

instance SerialiseAsBech32 a => Show (UsingBech32 a) where
    show :: UsingBech32 a -> String
show (UsingBech32 a
x) = Text -> String
forall a. Show a => a -> String
show (a -> Text
forall a. SerialiseAsBech32 a => a -> Text
serialiseToBech32 a
x)

instance SerialiseAsBech32 a => IsString (UsingBech32 a) where
    fromString :: String -> UsingBech32 a
fromString String
str =
      case AsType a -> Text -> Either Bech32DecodeError a
forall a.
SerialiseAsBech32 a =>
AsType a -> Text -> Either Bech32DecodeError a
deserialiseFromBech32 AsType a
ttoken (String -> Text
Text.pack String
str) of
        Right a
x  -> a -> UsingBech32 a
forall a. a -> UsingBech32 a
UsingBech32 a
x
        Left  Bech32DecodeError
e -> String -> UsingBech32 a
forall a. HasCallStack => String -> a
error (String
"fromString: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
str String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Bech32DecodeError -> String
forall e. Error e => e -> String
displayError Bech32DecodeError
e)
      where
        ttoken :: AsType a
        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

instance SerialiseAsBech32 a => ToJSON (UsingBech32 a) where
    toJSON :: UsingBech32 a -> Value
toJSON (UsingBech32 a
x) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (a -> Text
forall a. SerialiseAsBech32 a => a -> Text
serialiseToBech32 a
x)

instance (SerialiseAsBech32 a, Typeable a) => FromJSON (UsingBech32 a) where
    parseJSON :: Value -> Parser (UsingBech32 a)
parseJSON =
      String
-> (Text -> Parser (UsingBech32 a))
-> Value
-> Parser (UsingBech32 a)
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
tname ((Text -> Parser (UsingBech32 a))
 -> Value -> Parser (UsingBech32 a))
-> (Text -> Parser (UsingBech32 a))
-> Value
-> Parser (UsingBech32 a)
forall a b. (a -> b) -> a -> b
$ \Text
str ->
        case AsType a -> Text -> Either Bech32DecodeError a
forall a.
SerialiseAsBech32 a =>
AsType a -> Text -> Either Bech32DecodeError a
deserialiseFromBech32 AsType a
ttoken Text
str of
          Right a
x -> UsingBech32 a -> Parser (UsingBech32 a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> UsingBech32 a
forall a. a -> UsingBech32 a
UsingBech32 a
x)
          Left  Bech32DecodeError
e -> String -> Parser (UsingBech32 a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (Text -> String
forall a. Show a => a -> String
show Text
str String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Bech32DecodeError -> String
forall e. Error e => e -> String
displayError Bech32DecodeError
e)
      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 SerialiseAsBech32 a => ToJSONKey (UsingBech32 a)
instance (SerialiseAsBech32 a, Typeable a) => FromJSONKey (UsingBech32 a)