{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

module Cardano.Api.Any (
    module Cardano.Api.Any
  , module Cbor
  , module Proxy
  ) where


import           Cardano.Ledger.Binary as Cbor (DecCBOR (..), EncCBOR (..),
                     FromCBOR (..), ToCBOR (..))
import qualified Cardano.Ledger.Binary.Plain as CBOR
import           Control.Exception (Exception (..), IOException, throwIO)
import           Data.ByteString (ByteString)
import qualified Data.ByteString.Base16 as Base16 (decode, encode)
import           Data.Kind (Constraint, Type)
import           Data.Proxy as Proxy (Proxy (..))
import           Data.Text as Text (Text)
import qualified Data.Text.Encoding as Text (decodeUtf8)
import           System.IO (Handle)



-- DUPLICATE -- adapted from: cardano-api/src/Cardano/Api/HasTypeProxy.hs

class HasTypeProxy t where
  -- | A family of singleton types used in this API to indicate which type to
  -- use where it would otherwise be ambiguous or merely unclear.
  --
  -- Values of this type are passed to deserialisation functions for example.
  --
  data AsType t

  proxyToAsType :: Proxy t -> AsType t


data FromSomeType (c :: Type -> Constraint) b where
     FromSomeType :: c a => AsType a -> (a -> b) -> FromSomeType c b



-- DUPLICATE -- adapted from: cardano-api/src/Cardano/Api/Hash.hs

data family Hash keyrole :: Type

class CastHash roleA roleB where

    castHash :: Hash roleA -> Hash roleB


instance HasTypeProxy a => HasTypeProxy (Hash a) where
    data AsType (Hash a) = AsHash (AsType a)
    proxyToAsType :: Proxy (Hash a) -> AsType (Hash a)
proxyToAsType Proxy (Hash a)
_ = AsType a -> AsType (Hash a)
forall a. AsType a -> AsType (Hash a)
AsHash (Proxy a -> AsType a
forall t. HasTypeProxy t => Proxy t -> AsType t
proxyToAsType (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a))



-- DUPLICATE -- adapted from: cardano-api/src/Cardano/Api/SerialiseRaw.hs

class HasTypeProxy a => SerialiseAsRawBytes a where

  serialiseToRawBytes :: a -> ByteString

  deserialiseFromRawBytes :: AsType a -> ByteString -> Maybe a

serialiseToRawBytesHex :: SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytesHex :: forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytesHex = ByteString -> ByteString
Base16.encode (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes

serialiseToRawBytesHexText :: SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText :: forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText = ByteString -> Text
Text.decodeUtf8 (ByteString -> Text) -> (a -> ByteString) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytesHex

deserialiseFromRawBytesHex :: SerialiseAsRawBytes a
                           => AsType a -> ByteString -> Maybe a
deserialiseFromRawBytesHex :: forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Maybe a
deserialiseFromRawBytesHex AsType a
proxy ByteString
hex =
    case ByteString -> Either String ByteString
Base16.decode ByteString
hex of
      Right ByteString
raw -> AsType a -> ByteString -> Maybe a
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Maybe a
deserialiseFromRawBytes AsType a
proxy ByteString
raw
      Left String
_msg -> Maybe a
forall a. Maybe a
Nothing



-- DUPLICATE -- adapted from: cardano-api/src/Cardano/Api/SerialiseAsCBOR.hs

class HasTypeProxy a => SerialiseAsCBOR a where
    serialiseToCBOR :: a -> ByteString
    deserialiseFromCBOR :: AsType a -> ByteString -> Either CBOR.DecoderError a

    default serialiseToCBOR :: ToCBOR a => a -> ByteString
    serialiseToCBOR = a -> ByteString
forall a. ToCBOR a => a -> ByteString
CBOR.serialize'

    default deserialiseFromCBOR :: FromCBOR a
                                => AsType a
                                -> ByteString
                                -> Either CBOR.DecoderError a
    deserialiseFromCBOR AsType a
_proxy = ByteString -> Either DecoderError a
forall a. FromCBOR a => ByteString -> Either DecoderError a
CBOR.decodeFull'



-- DUPLICATE -- adapted from: cardano-api/src/Cardano/Api/Error.hs

class Show e => Error e where

    displayError :: e -> String

instance Error () where
    displayError :: () -> String
displayError () = String
""


-- | The preferred approach is to use 'Except' or 'ExceptT', but you can if
-- necessary use IO exceptions.
--
throwErrorAsException :: Error e => e -> IO a
throwErrorAsException :: forall e a. Error e => e -> IO a
throwErrorAsException e
e = ErrorAsException -> IO a
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (e -> ErrorAsException
forall e. Error e => e -> ErrorAsException
ErrorAsException e
e)

data ErrorAsException where
     ErrorAsException :: Error e => e -> ErrorAsException

instance Show ErrorAsException where
    show :: ErrorAsException -> String
show (ErrorAsException e
e) = e -> String
forall a. Show a => a -> String
show e
e

instance Exception ErrorAsException where
    displayException :: ErrorAsException -> String
displayException (ErrorAsException e
e) = e -> String
forall e. Error e => e -> String
displayError e
e


data FileError e = FileError   FilePath e
                 | FileErrorTempFile
                     FilePath
                     -- ^ Target path
                     FilePath
                     -- ^ Temporary path
                     Handle
                 | FileIOError FilePath IOException
  deriving Int -> FileError e -> ShowS
[FileError e] -> ShowS
FileError e -> String
(Int -> FileError e -> ShowS)
-> (FileError e -> String)
-> ([FileError e] -> ShowS)
-> Show (FileError e)
forall e. Show e => Int -> FileError e -> ShowS
forall e. Show e => [FileError e] -> ShowS
forall e. Show e => FileError e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall e. Show e => Int -> FileError e -> ShowS
showsPrec :: Int -> FileError e -> ShowS
$cshow :: forall e. Show e => FileError e -> String
show :: FileError e -> String
$cshowList :: forall e. Show e => [FileError e] -> ShowS
showList :: [FileError e] -> ShowS
Show

instance Error e => Error (FileError e) where
  displayError :: FileError e -> String
displayError (FileErrorTempFile String
targetPath String
tempPath Handle
h)=
    String
"Error creating temporary file at: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
tempPath String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
"/n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Target path: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
targetPath String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
"/n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Handle: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Handle -> String
forall a. Show a => a -> String
show Handle
h
  displayError (FileIOError String
path IOException
ioe) =
    String
path String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ IOException -> String
forall e. Exception e => e -> String
displayException IOException
ioe
  displayError (FileError String
path e
e) =
    String
path String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ e -> String
forall e. Error e => e -> String
displayError e
e

instance Error IOException where
  displayError :: IOException -> String
displayError = IOException -> String
forall a. Show a => a -> String
show



--- WARNING: STUB for Bech32

class (HasTypeProxy a, SerialiseAsRawBytes a) => SerialiseAsBech32 a where

    -- | The human readable prefix to use when encoding this value to Bech32.
    --
    bech32PrefixFor :: a -> Text

    -- | The set of human readable prefixes that can be used for this type.
    --
    bech32PrefixesPermitted :: AsType a -> [Text]


-- serialiseToBech32 :: SerialiseAsBech32 a => a -> Text
serialiseToBech32 :: a -> Text
serialiseToBech32 :: forall a. a -> Text
serialiseToBech32 a
_ = String -> Text
forall a. HasCallStack => String -> a
error String
"serialiseToBech32: stub not implemented"

-- deserialiseFromBech32 :: SerialiseAsBech32 a => AsType a -> Text -> Either Bech32DecodeError a
deserialiseFromBech32 :: AsType a -> Text -> Either Bech32DecodeError a
deserialiseFromBech32 :: forall a. AsType a -> Text -> Either Bech32DecodeError a
deserialiseFromBech32 AsType a
_ Text
_ = String -> Either Bech32DecodeError a
forall a. HasCallStack => String -> a
error String
"deserialiseFromBech32: stub not implemented"

data Bech32DecodeError

instance Show Bech32DecodeError where
    show :: Bech32DecodeError -> String
show = String -> Bech32DecodeError -> String
forall a b. a -> b -> a
const String
"Bech32DecodeError: stub not implemented"

instance Error Bech32DecodeError where
    displayError :: Bech32DecodeError -> String
displayError = Bech32DecodeError -> String
forall a. Show a => a -> String
show