{-# LANGUAGE ScopedTypeVariables #-}

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

import           Prelude

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

import qualified Data.Aeson.Types as Aeson

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
str =
      case ByteString -> Either String ByteString
Base16.decode (String -> ByteString
BSC.pack String
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  -> a -> UsingRawBytesHex a
forall a. a -> UsingRawBytesHex a
UsingRawBytesHex a
x
          Maybe a
Nothing -> String -> UsingRawBytesHex a
forall a. HasCallStack => String -> a
error (String
"fromString: cannot deserialise " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
str)
        Left String
msg -> String -> UsingRawBytesHex a
forall a. HasCallStack => String -> a
error (String
"fromString: invalid hex " 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]
++ String
msg)
      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 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
$ \Text
str ->
        case ByteString -> Either String ByteString
Base16.decode (Text -> ByteString
Text.encodeUtf8 Text
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 -> Parser (UsingRawBytesHex a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> UsingRawBytesHex a
forall a. a -> UsingRawBytesHex a
UsingRawBytesHex a
x)
            Maybe a
Nothing -> String -> Parser (UsingRawBytesHex a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"cannot deserialise " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
str)
          Left String
msg  -> String -> Parser (UsingRawBytesHex a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"invalid hex " String -> String -> String
forall a. [a] -> [a] -> [a]
++ 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]
++ String
msg)
      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 => ToJSONKey (UsingRawBytesHex a)
instance (SerialiseAsRawBytes a, Typeable a) => FromJSONKey (UsingRawBytesHex 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)