{-# LANGUAGE DeriveDataTypeable #-}

-- | JSON serialisation
module Cardano.Api.Serialise.Json
  ( serialiseToJSON
  , ToJSON (..)
  , ToJSONKey
  , deserialiseFromJSON
  , prettyPrintJSON
  , FromJSON (..)
  , FromJSONKey
  , JsonDecodeError (..)
  , readFileJSON
  , writeFileJSON
  , textWithMaxLength
  , toRationalJSON
  )
where

import Cardano.Api.Error
import Cardano.Api.Pretty

import Control.Monad.Trans.Except (runExceptT)
import Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistEither)
import Data.Aeson (FromJSON (..), FromJSONKey, ToJSON (..), ToJSONKey, Value)
import Data.Aeson qualified as Aeson
import Data.Aeson.Encode.Pretty (encodePretty)
import Data.Aeson.Types qualified as Aeson
import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Data.ByteString.Lazy qualified as LBS
import Data.Data (Data)
import Data.Scientific (fromRationalRepetendLimited)
import Data.Text (Text)
import Data.Text qualified as T

newtype JsonDecodeError = JsonDecodeError String
  deriving (JsonDecodeError -> JsonDecodeError -> Bool
(JsonDecodeError -> JsonDecodeError -> Bool)
-> (JsonDecodeError -> JsonDecodeError -> Bool)
-> Eq JsonDecodeError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JsonDecodeError -> JsonDecodeError -> Bool
== :: JsonDecodeError -> JsonDecodeError -> Bool
$c/= :: JsonDecodeError -> JsonDecodeError -> Bool
/= :: JsonDecodeError -> JsonDecodeError -> Bool
Eq, Int -> JsonDecodeError -> ShowS
[JsonDecodeError] -> ShowS
JsonDecodeError -> [Char]
(Int -> JsonDecodeError -> ShowS)
-> (JsonDecodeError -> [Char])
-> ([JsonDecodeError] -> ShowS)
-> Show JsonDecodeError
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JsonDecodeError -> ShowS
showsPrec :: Int -> JsonDecodeError -> ShowS
$cshow :: JsonDecodeError -> [Char]
show :: JsonDecodeError -> [Char]
$cshowList :: [JsonDecodeError] -> ShowS
showList :: [JsonDecodeError] -> ShowS
Show, Typeable JsonDecodeError
Typeable JsonDecodeError =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> JsonDecodeError -> c JsonDecodeError)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c JsonDecodeError)
-> (JsonDecodeError -> Constr)
-> (JsonDecodeError -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c JsonDecodeError))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c JsonDecodeError))
-> ((forall b. Data b => b -> b)
    -> JsonDecodeError -> JsonDecodeError)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> JsonDecodeError -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> JsonDecodeError -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> JsonDecodeError -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> JsonDecodeError -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> JsonDecodeError -> m JsonDecodeError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> JsonDecodeError -> m JsonDecodeError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> JsonDecodeError -> m JsonDecodeError)
-> Data JsonDecodeError
JsonDecodeError -> Constr
JsonDecodeError -> DataType
(forall b. Data b => b -> b) -> JsonDecodeError -> JsonDecodeError
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> JsonDecodeError -> u
forall u. (forall d. Data d => d -> u) -> JsonDecodeError -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JsonDecodeError -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JsonDecodeError -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> JsonDecodeError -> m JsonDecodeError
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> JsonDecodeError -> m JsonDecodeError
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JsonDecodeError
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JsonDecodeError -> c JsonDecodeError
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JsonDecodeError)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c JsonDecodeError)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JsonDecodeError -> c JsonDecodeError
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JsonDecodeError -> c JsonDecodeError
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JsonDecodeError
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JsonDecodeError
$ctoConstr :: JsonDecodeError -> Constr
toConstr :: JsonDecodeError -> Constr
$cdataTypeOf :: JsonDecodeError -> DataType
dataTypeOf :: JsonDecodeError -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JsonDecodeError)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JsonDecodeError)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c JsonDecodeError)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c JsonDecodeError)
$cgmapT :: (forall b. Data b => b -> b) -> JsonDecodeError -> JsonDecodeError
gmapT :: (forall b. Data b => b -> b) -> JsonDecodeError -> JsonDecodeError
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JsonDecodeError -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JsonDecodeError -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JsonDecodeError -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JsonDecodeError -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> JsonDecodeError -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> JsonDecodeError -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> JsonDecodeError -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> JsonDecodeError -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> JsonDecodeError -> m JsonDecodeError
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> JsonDecodeError -> m JsonDecodeError
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> JsonDecodeError -> m JsonDecodeError
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> JsonDecodeError -> m JsonDecodeError
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> JsonDecodeError -> m JsonDecodeError
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> JsonDecodeError -> m JsonDecodeError
Data)

instance Error JsonDecodeError where
  prettyError :: forall ann. JsonDecodeError -> Doc ann
prettyError (JsonDecodeError [Char]
err) =
    [Char] -> Doc ann
forall ann. [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
err

serialiseToJSON :: ToJSON a => a -> ByteString
serialiseToJSON :: forall a. ToJSON a => a -> ByteString
serialiseToJSON = LazyByteString -> ByteString
LBS.toStrict (LazyByteString -> ByteString)
-> (a -> LazyByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> LazyByteString
forall a. ToJSON a => a -> LazyByteString
Aeson.encode

prettyPrintJSON :: ToJSON a => a -> ByteString
prettyPrintJSON :: forall a. ToJSON a => a -> ByteString
prettyPrintJSON = LazyByteString -> ByteString
LBS.toStrict (LazyByteString -> ByteString)
-> (a -> LazyByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> LazyByteString
forall a. ToJSON a => a -> LazyByteString
encodePretty

deserialiseFromJSON
  :: FromJSON a
  => ByteString
  -> Either JsonDecodeError a
deserialiseFromJSON :: forall a. FromJSON a => ByteString -> Either JsonDecodeError a
deserialiseFromJSON =
  ([Char] -> Either JsonDecodeError a)
-> (a -> Either JsonDecodeError a)
-> Either [Char] a
-> Either JsonDecodeError a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (JsonDecodeError -> Either JsonDecodeError a
forall a b. a -> Either a b
Left (JsonDecodeError -> Either JsonDecodeError a)
-> ([Char] -> JsonDecodeError)
-> [Char]
-> Either JsonDecodeError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> JsonDecodeError
JsonDecodeError) a -> Either JsonDecodeError a
forall a b. b -> Either a b
Right
    (Either [Char] a -> Either JsonDecodeError a)
-> (ByteString -> Either [Char] a)
-> ByteString
-> Either JsonDecodeError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either [Char] a
forall a. FromJSON a => ByteString -> Either [Char] a
Aeson.eitherDecodeStrict'

readFileJSON
  :: FromJSON a
  => FilePath
  -> IO (Either (FileError JsonDecodeError) a)
readFileJSON :: forall a.
FromJSON a =>
[Char] -> IO (Either (FileError JsonDecodeError) a)
readFileJSON [Char]
path =
  ExceptT (FileError JsonDecodeError) IO a
-> IO (Either (FileError JsonDecodeError) a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (FileError JsonDecodeError) IO a
 -> IO (Either (FileError JsonDecodeError) a))
-> ExceptT (FileError JsonDecodeError) IO a
-> IO (Either (FileError JsonDecodeError) a)
forall a b. (a -> b) -> a -> b
$ do
    content <- [Char]
-> ([Char] -> IO ByteString)
-> ExceptT (FileError JsonDecodeError) IO ByteString
forall (m :: * -> *) s e.
MonadIO m =>
[Char] -> ([Char] -> IO s) -> ExceptT (FileError e) m s
fileIOExceptT [Char]
path [Char] -> IO ByteString
BS.readFile
    firstExceptT (FileError path) $
      hoistEither $
        deserialiseFromJSON content

writeFileJSON
  :: ToJSON a
  => FilePath
  -> a
  -> IO (Either (FileError ()) ())
writeFileJSON :: forall a. ToJSON a => [Char] -> a -> IO (Either (FileError ()) ())
writeFileJSON [Char]
path a
x =
  ExceptT (FileError ()) IO () -> IO (Either (FileError ()) ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (FileError ()) IO () -> IO (Either (FileError ()) ()))
-> ExceptT (FileError ()) IO () -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$
    (IOException -> FileError ())
-> IO () -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT ([Char] -> IOException -> FileError ()
forall e. [Char] -> IOException -> FileError e
FileIOError [Char]
path) (IO () -> ExceptT (FileError ()) IO ())
-> IO () -> ExceptT (FileError ()) IO ()
forall a b. (a -> b) -> a -> b
$
      [Char] -> ByteString -> IO ()
BS.writeFile [Char]
path (a -> ByteString
forall a. ToJSON a => a -> ByteString
serialiseToJSON a
x)

-- | Parser for 'Text' that validates that the number of characters is
-- under a given maximum. The 'String' parameter is meant to be the name
-- of the field in order to be able to give context in case of error.
textWithMaxLength :: String -> Int -> Value -> Aeson.Parser Text
textWithMaxLength :: [Char] -> Int -> Value -> Parser Text
textWithMaxLength [Char]
fieldName Int
maxLen Value
value = do
  txt <- Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
value
  if T.length txt <= maxLen
    then pure txt
    else
      fail $
        "key \""
          ++ fieldName
          ++ "\" exceeds maximum length of "
          ++ show maxLen
          ++ " characters. Got length: "
          ++ show (T.length txt)

-- Rationals and JSON are an awkward mix. We cannot convert rationals
-- like @1/3@ to JSON numbers. But _most_ of the numbers we want to use
-- in practice have simple decimal representations. Our solution here is
-- to use simple decimal representations where we can and representation
-- in a @{"numerator": 1, "denominator": 3}@ style otherwise.
--
toRationalJSON :: Rational -> Value
toRationalJSON :: Rational -> Value
toRationalJSON Rational
r =
  case Int
-> Rational
-> Either (Scientific, Rational) (Scientific, Maybe Int)
fromRationalRepetendLimited Int
20 Rational
r of
    Right (Scientific
s, Maybe Int
Nothing) -> Scientific -> Value
forall a. ToJSON a => a -> Value
toJSON Scientific
s
    Either (Scientific, Rational) (Scientific, Maybe Int)
_ -> Rational -> Value
forall a. ToJSON a => a -> Value
toJSON Rational
r