{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE UndecidableInstances #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

-- |
-- Copyright: © 2018-2021 IOHK
-- License: Apache-2.0
--
-- Utility functions for internal use of the library.

module Cardano.Address.Internal
    ( orElse
    , WithErrorMessage (..)
    , DeserialiseFailure (..)
    ) where

import Prelude

import Codec.CBOR.Read
    ( DeserialiseFailure (..) )
import Control.Exception
    ( Exception (..) )
import Data.Aeson
    ( GToJSON
    , Options (..)
    , SumEncoding (..)
    , ToJSON (..)
    , Value (..)
    , Zero
    , defaultOptions
    , genericToJSON
    , object
    , toJSON
    , (.=)
    )
import GHC.Generics
    ( Generic, Rep )

orElse :: Either e a -> Either e a -> Either e a
orElse :: Either e a -> Either e a -> Either e a
orElse (Right a
a) Either e a
_ = a -> Either e a
forall a b. b -> Either a b
Right a
a
orElse (Left e
_) Either e a
ea = Either e a
ea

errToJSON :: (Exception e, Generic e, GToJSON Zero (Rep e)) => e -> Value
errToJSON :: e -> Value
errToJSON e
err = [Pair] -> Value
object
    [ Key
"error" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Options -> e -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
opts e
err
    , Key
"message" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String -> Value
forall a. ToJSON a => a -> Value
toJSON (e -> String
forall e. Exception e => e -> String
displayException e
err)
    ]
  where
    opts :: Options
opts = Options
defaultOptions { sumEncoding :: SumEncoding
sumEncoding = SumEncoding
errorCodes }
    errorCodes :: SumEncoding
errorCodes = String -> String -> SumEncoding
TaggedObject String
"code" String
"details"

newtype WithErrorMessage e = WithErrorMessage { WithErrorMessage e -> e
withErrorMessage :: e }

instance (Exception e, Generic e, GToJSON Zero (Rep e)) => ToJSON (WithErrorMessage e) where
    toJSON :: WithErrorMessage e -> Value
toJSON = e -> Value
forall e.
(Exception e, Generic e, GToJSON Zero (Rep e)) =>
e -> Value
errToJSON (e -> Value)
-> (WithErrorMessage e -> e) -> WithErrorMessage e -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithErrorMessage e -> e
forall e. WithErrorMessage e -> e
withErrorMessage

instance ToJSON DeserialiseFailure where
    toJSON :: DeserialiseFailure -> Value
toJSON (DeserialiseFailure ByteOffset
off String
msg) = [Pair] -> Value
object
        [ Key
"code" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"Codec.CBOR.DeserialiseFailure"
        , Key
"details" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [ Key
"byteOffset" Key -> ByteOffset -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ByteOffset
off, Key
"message" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
msg ]
        ]