-- | Encoding and decoding of 'ByteString' and serialisable values
--   as base16 encoded JSON strings
module Data.Aeson.Extras(
      encodeByteString
    , decodeByteString
    , encodeSerialise
    , decodeSerialise
    , tryDecode
    , JSONViaSerialise (..)
    ) where

import Codec.CBOR.Write qualified as Write
import Codec.Serialise (Serialise, deserialiseOrFail, encode)
import Control.Monad ((>=>))
import Data.Aeson qualified as Aeson
import Data.Aeson.Types qualified as Aeson
import Data.Bifunctor (first)
import Data.ByteString qualified as BSS
import Data.ByteString.Base16 qualified as Base16
import Data.ByteString.Lazy qualified as BSL
import Data.Text qualified as Text
import Data.Text.Encoding qualified as TE

encodeByteString :: BSS.ByteString -> Text.Text
encodeByteString :: ByteString -> Text
encodeByteString = ByteString -> Text
TE.decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base16.encode

tryDecode :: Text.Text -> Either String BSS.ByteString
tryDecode :: Text -> Either String ByteString
tryDecode = ByteString -> Either String ByteString
Base16.decode (ByteString -> Either String ByteString)
-> (Text -> ByteString) -> Text -> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TE.encodeUtf8

decodeByteString :: Aeson.Value -> Aeson.Parser BSS.ByteString
decodeByteString :: Value -> Parser ByteString
decodeByteString = String -> (Text -> Parser ByteString) -> Value -> Parser ByteString
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"ByteString" ((String -> Parser ByteString)
-> (ByteString -> Parser ByteString)
-> Either String ByteString
-> Parser ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ByteString -> Parser ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String ByteString -> Parser ByteString)
-> (Text -> Either String ByteString) -> Text -> Parser ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String ByteString
tryDecode)

encodeSerialise :: Serialise a => a -> Text.Text
encodeSerialise :: a -> Text
encodeSerialise = ByteString -> Text
encodeByteString (ByteString -> Text) -> (a -> ByteString) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoding -> ByteString
Write.toStrictByteString (Encoding -> ByteString) -> (a -> Encoding) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Encoding
forall a. Serialise a => a -> Encoding
encode

decodeSerialise :: Serialise a => Aeson.Value -> Aeson.Parser a
decodeSerialise :: Value -> Parser a
decodeSerialise = Value -> Parser ByteString
decodeByteString (Value -> Parser ByteString)
-> (ByteString -> Parser a) -> Value -> Parser a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> ByteString -> Parser a
forall a (m :: * -> *).
(Serialise a, MonadFail m) =>
ByteString -> m a
go where
    go :: ByteString -> m a
go ByteString
bs =
        case (DeserialiseFailure -> String)
-> Either DeserialiseFailure a -> Either String a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first DeserialiseFailure -> String
forall a. Show a => a -> String
show (Either DeserialiseFailure a -> Either String a)
-> Either DeserialiseFailure a -> Either String a
forall a b. (a -> b) -> a -> b
$ ByteString -> Either DeserialiseFailure a
forall a. Serialise a => ByteString -> Either DeserialiseFailure a
deserialiseOrFail (ByteString -> Either DeserialiseFailure a)
-> ByteString -> Either DeserialiseFailure a
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BSL.fromStrict ByteString
bs of
            Left String
e  -> String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
            Right a
v -> a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
v

-- | Newtype for deriving 'ToJSON' and 'FromJSON' for types that have a 'Serialise'
-- instance by just encoding the serialized bytes as a JSON string.
newtype JSONViaSerialise a = JSONViaSerialise a

instance Serialise a => Aeson.ToJSON (JSONViaSerialise a) where
    toJSON :: JSONViaSerialise a -> Value
toJSON (JSONViaSerialise a
a) = Text -> Value
Aeson.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ a -> Text
forall a. Serialise a => a -> Text
encodeSerialise a
a

instance Serialise a => Aeson.FromJSON (JSONViaSerialise a) where
    parseJSON :: Value -> Parser (JSONViaSerialise a)
parseJSON Value
v = a -> JSONViaSerialise a
forall a. a -> JSONViaSerialise a
JSONViaSerialise (a -> JSONViaSerialise a)
-> Parser a -> Parser (JSONViaSerialise a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
forall a. Serialise a => Value -> Parser a
decodeSerialise Value
v