{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE ImportQualifiedPost #-}

module Haskoin.Util.Marshal where

import Control.Monad
import Crypto.Secp256k1
import Data.Aeson
import Data.Aeson.Encoding
import Data.Aeson.Types
import Data.ByteString
import Data.ByteString.Builder
import Data.ByteString.Lazy qualified as Lazy
import Data.Bytes.Get
import Data.Bytes.Put
import Data.Bytes.Serial

class Marshal s a | a -> s where
  marshalPut :: (MonadPut m) => s -> a -> m ()
  marshalGet :: (MonadGet m) => s -> m a

marshal :: (Marshal s a) => s -> a -> ByteString
marshal :: forall s a. Marshal s a => s -> a -> ByteString
marshal s
s = Put -> ByteString
runPutS (Put -> ByteString) -> (a -> Put) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> a -> Put
forall s a (m :: * -> *).
(Marshal s a, MonadPut m) =>
s -> a -> m ()
forall (m :: * -> *). MonadPut m => s -> a -> m ()
marshalPut s
s

marshalLazy :: (Marshal s a) => s -> a -> Lazy.ByteString
marshalLazy :: forall s a. Marshal s a => s -> a -> ByteString
marshalLazy s
s = Put -> ByteString
runPutL (Put -> ByteString) -> (a -> Put) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> a -> Put
forall s a (m :: * -> *).
(Marshal s a, MonadPut m) =>
s -> a -> m ()
forall (m :: * -> *). MonadPut m => s -> a -> m ()
marshalPut s
s

unmarshal :: (Marshal s a) => s -> ByteString -> Either String a
unmarshal :: forall s a. Marshal s a => s -> ByteString -> Either String a
unmarshal = Get a -> ByteString -> Either String a
forall a. Get a -> ByteString -> Either String a
runGetS (Get a -> ByteString -> Either String a)
-> (s -> Get a) -> s -> ByteString -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Get a
forall s a (m :: * -> *). (Marshal s a, MonadGet m) => s -> m a
forall (m :: * -> *). MonadGet m => s -> m a
marshalGet

unmarshalLazy :: (Marshal s a) => s -> Lazy.ByteString -> a
unmarshalLazy :: forall s a. Marshal s a => s -> ByteString -> a
unmarshalLazy = Get a -> ByteString -> a
forall a. Get a -> ByteString -> a
runGetL (Get a -> ByteString -> a) -> (s -> Get a) -> s -> ByteString -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Get a
forall s a (m :: * -> *). (Marshal s a, MonadGet m) => s -> m a
forall (m :: * -> *). MonadGet m => s -> m a
marshalGet

class MarshalJSON s a | a -> s where
  marshalValue :: s -> a -> Value
  marshalEncoding :: s -> a -> Encoding
  marshalEncoding s
x = Value -> Encoding
value (Value -> Encoding) -> (a -> Value) -> a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> a -> Value
forall s a. MarshalJSON s a => s -> a -> Value
marshalValue s
x
  unmarshalValue :: s -> Value -> Parser a

marshalJSON :: (MarshalJSON s a) => s -> a -> Lazy.ByteString
marshalJSON :: forall s a. MarshalJSON s a => s -> a -> ByteString
marshalJSON s
s = Builder -> ByteString
toLazyByteString (Builder -> ByteString) -> (a -> Builder) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoding -> Builder
forall tag. Encoding' tag -> Builder
fromEncoding (Encoding -> Builder) -> (a -> Encoding) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> a -> Encoding
forall s a. MarshalJSON s a => s -> a -> Encoding
marshalEncoding s
s

unmarshalJSON :: (MarshalJSON s a) => s -> Lazy.ByteString -> Maybe a
unmarshalJSON :: forall s a. MarshalJSON s a => s -> ByteString -> Maybe a
unmarshalJSON s
s = (Value -> Parser a) -> Value -> Maybe a
forall a b. (a -> Parser b) -> a -> Maybe b
parseMaybe (s -> Value -> Parser a
forall s a. MarshalJSON s a => s -> Value -> Parser a
unmarshalValue s
s) (Value -> Maybe a)
-> (ByteString -> Maybe Value) -> ByteString -> Maybe a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ByteString -> Maybe Value
forall a. FromJSON a => ByteString -> Maybe a
decode