{-# 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
      -- | Target path
      FilePath
      -- | Temporary path
      FilePath
      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