{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

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

-- | TextEnvelope Serialisation
--
module Cardano.Api.SerialiseTextEnvelope (
    FromSomeType (..)
  , HasTextEnvelope (..)
  , TextEnvelope (..)
  , TextEnvelopeDescr (..)
  , TextEnvelopeError (..)
  , TextEnvelopeType (..)
  , deserialiseFromTextEnvelope
  , deserialiseFromTextEnvelopeAnyOf
  , readFileTextEnvelope
  , readFileTextEnvelopeAnyOf
  , readTextEnvelopeFromFile
  , readTextEnvelopeOfTypeFromFile
  , serialiseToTextEnvelope
    -- * Data family instances
  , AsType (..)
  ) where

import           Cardano.Api.Any
import           Cardano.Ledger.Binary (DecoderError)
import           Control.Monad (unless)
import           Control.Monad.Trans.Except (ExceptT (..), runExceptT)
import           Control.Monad.Trans.Except.Extra (firstExceptT,
                     handleIOExceptT, hoistEither)
import           Data.Aeson as Aeson (FromJSON (..), ToJSON (..),
                     eitherDecodeStrict', object, withObject, (.:), (.=))
import           Data.Bifunctor (first)
import           Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as Base16
import qualified Data.List as List
import           Data.Maybe (fromMaybe)
import           Data.String (IsString)
import qualified Data.Text.Encoding as Text

-- ----------------------------------------------------------------------------
-- Text envelopes
--

newtype TextEnvelopeType = TextEnvelopeType String
  deriving (TextEnvelopeType -> TextEnvelopeType -> Bool
(TextEnvelopeType -> TextEnvelopeType -> Bool)
-> (TextEnvelopeType -> TextEnvelopeType -> Bool)
-> Eq TextEnvelopeType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TextEnvelopeType -> TextEnvelopeType -> Bool
== :: TextEnvelopeType -> TextEnvelopeType -> Bool
$c/= :: TextEnvelopeType -> TextEnvelopeType -> Bool
/= :: TextEnvelopeType -> TextEnvelopeType -> Bool
Eq, Int -> TextEnvelopeType -> ShowS
[TextEnvelopeType] -> ShowS
TextEnvelopeType -> String
(Int -> TextEnvelopeType -> ShowS)
-> (TextEnvelopeType -> String)
-> ([TextEnvelopeType] -> ShowS)
-> Show TextEnvelopeType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TextEnvelopeType -> ShowS
showsPrec :: Int -> TextEnvelopeType -> ShowS
$cshow :: TextEnvelopeType -> String
show :: TextEnvelopeType -> String
$cshowList :: [TextEnvelopeType] -> ShowS
showList :: [TextEnvelopeType] -> ShowS
Show)
  deriving newtype (String -> TextEnvelopeType
(String -> TextEnvelopeType) -> IsString TextEnvelopeType
forall a. (String -> a) -> IsString a
$cfromString :: String -> TextEnvelopeType
fromString :: String -> TextEnvelopeType
IsString, NonEmpty TextEnvelopeType -> TextEnvelopeType
TextEnvelopeType -> TextEnvelopeType -> TextEnvelopeType
(TextEnvelopeType -> TextEnvelopeType -> TextEnvelopeType)
-> (NonEmpty TextEnvelopeType -> TextEnvelopeType)
-> (forall b.
    Integral b =>
    b -> TextEnvelopeType -> TextEnvelopeType)
-> Semigroup TextEnvelopeType
forall b. Integral b => b -> TextEnvelopeType -> TextEnvelopeType
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: TextEnvelopeType -> TextEnvelopeType -> TextEnvelopeType
<> :: TextEnvelopeType -> TextEnvelopeType -> TextEnvelopeType
$csconcat :: NonEmpty TextEnvelopeType -> TextEnvelopeType
sconcat :: NonEmpty TextEnvelopeType -> TextEnvelopeType
$cstimes :: forall b. Integral b => b -> TextEnvelopeType -> TextEnvelopeType
stimes :: forall b. Integral b => b -> TextEnvelopeType -> TextEnvelopeType
Semigroup, [TextEnvelopeType] -> Value
[TextEnvelopeType] -> Encoding
TextEnvelopeType -> Bool
TextEnvelopeType -> Value
TextEnvelopeType -> Encoding
(TextEnvelopeType -> Value)
-> (TextEnvelopeType -> Encoding)
-> ([TextEnvelopeType] -> Value)
-> ([TextEnvelopeType] -> Encoding)
-> (TextEnvelopeType -> Bool)
-> ToJSON TextEnvelopeType
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: TextEnvelopeType -> Value
toJSON :: TextEnvelopeType -> Value
$ctoEncoding :: TextEnvelopeType -> Encoding
toEncoding :: TextEnvelopeType -> Encoding
$ctoJSONList :: [TextEnvelopeType] -> Value
toJSONList :: [TextEnvelopeType] -> Value
$ctoEncodingList :: [TextEnvelopeType] -> Encoding
toEncodingList :: [TextEnvelopeType] -> Encoding
$comitField :: TextEnvelopeType -> Bool
omitField :: TextEnvelopeType -> Bool
ToJSON, Maybe TextEnvelopeType
Value -> Parser [TextEnvelopeType]
Value -> Parser TextEnvelopeType
(Value -> Parser TextEnvelopeType)
-> (Value -> Parser [TextEnvelopeType])
-> Maybe TextEnvelopeType
-> FromJSON TextEnvelopeType
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser TextEnvelopeType
parseJSON :: Value -> Parser TextEnvelopeType
$cparseJSONList :: Value -> Parser [TextEnvelopeType]
parseJSONList :: Value -> Parser [TextEnvelopeType]
$comittedField :: Maybe TextEnvelopeType
omittedField :: Maybe TextEnvelopeType
FromJSON)

newtype TextEnvelopeDescr = TextEnvelopeDescr String
  deriving (TextEnvelopeDescr -> TextEnvelopeDescr -> Bool
(TextEnvelopeDescr -> TextEnvelopeDescr -> Bool)
-> (TextEnvelopeDescr -> TextEnvelopeDescr -> Bool)
-> Eq TextEnvelopeDescr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TextEnvelopeDescr -> TextEnvelopeDescr -> Bool
== :: TextEnvelopeDescr -> TextEnvelopeDescr -> Bool
$c/= :: TextEnvelopeDescr -> TextEnvelopeDescr -> Bool
/= :: TextEnvelopeDescr -> TextEnvelopeDescr -> Bool
Eq, Int -> TextEnvelopeDescr -> ShowS
[TextEnvelopeDescr] -> ShowS
TextEnvelopeDescr -> String
(Int -> TextEnvelopeDescr -> ShowS)
-> (TextEnvelopeDescr -> String)
-> ([TextEnvelopeDescr] -> ShowS)
-> Show TextEnvelopeDescr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TextEnvelopeDescr -> ShowS
showsPrec :: Int -> TextEnvelopeDescr -> ShowS
$cshow :: TextEnvelopeDescr -> String
show :: TextEnvelopeDescr -> String
$cshowList :: [TextEnvelopeDescr] -> ShowS
showList :: [TextEnvelopeDescr] -> ShowS
Show)
  deriving newtype (String -> TextEnvelopeDescr
(String -> TextEnvelopeDescr) -> IsString TextEnvelopeDescr
forall a. (String -> a) -> IsString a
$cfromString :: String -> TextEnvelopeDescr
fromString :: String -> TextEnvelopeDescr
IsString, NonEmpty TextEnvelopeDescr -> TextEnvelopeDescr
TextEnvelopeDescr -> TextEnvelopeDescr -> TextEnvelopeDescr
(TextEnvelopeDescr -> TextEnvelopeDescr -> TextEnvelopeDescr)
-> (NonEmpty TextEnvelopeDescr -> TextEnvelopeDescr)
-> (forall b.
    Integral b =>
    b -> TextEnvelopeDescr -> TextEnvelopeDescr)
-> Semigroup TextEnvelopeDescr
forall b. Integral b => b -> TextEnvelopeDescr -> TextEnvelopeDescr
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: TextEnvelopeDescr -> TextEnvelopeDescr -> TextEnvelopeDescr
<> :: TextEnvelopeDescr -> TextEnvelopeDescr -> TextEnvelopeDescr
$csconcat :: NonEmpty TextEnvelopeDescr -> TextEnvelopeDescr
sconcat :: NonEmpty TextEnvelopeDescr -> TextEnvelopeDescr
$cstimes :: forall b. Integral b => b -> TextEnvelopeDescr -> TextEnvelopeDescr
stimes :: forall b. Integral b => b -> TextEnvelopeDescr -> TextEnvelopeDescr
Semigroup, [TextEnvelopeDescr] -> Value
[TextEnvelopeDescr] -> Encoding
TextEnvelopeDescr -> Bool
TextEnvelopeDescr -> Value
TextEnvelopeDescr -> Encoding
(TextEnvelopeDescr -> Value)
-> (TextEnvelopeDescr -> Encoding)
-> ([TextEnvelopeDescr] -> Value)
-> ([TextEnvelopeDescr] -> Encoding)
-> (TextEnvelopeDescr -> Bool)
-> ToJSON TextEnvelopeDescr
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: TextEnvelopeDescr -> Value
toJSON :: TextEnvelopeDescr -> Value
$ctoEncoding :: TextEnvelopeDescr -> Encoding
toEncoding :: TextEnvelopeDescr -> Encoding
$ctoJSONList :: [TextEnvelopeDescr] -> Value
toJSONList :: [TextEnvelopeDescr] -> Value
$ctoEncodingList :: [TextEnvelopeDescr] -> Encoding
toEncodingList :: [TextEnvelopeDescr] -> Encoding
$comitField :: TextEnvelopeDescr -> Bool
omitField :: TextEnvelopeDescr -> Bool
ToJSON, Maybe TextEnvelopeDescr
Value -> Parser [TextEnvelopeDescr]
Value -> Parser TextEnvelopeDescr
(Value -> Parser TextEnvelopeDescr)
-> (Value -> Parser [TextEnvelopeDescr])
-> Maybe TextEnvelopeDescr
-> FromJSON TextEnvelopeDescr
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser TextEnvelopeDescr
parseJSON :: Value -> Parser TextEnvelopeDescr
$cparseJSONList :: Value -> Parser [TextEnvelopeDescr]
parseJSONList :: Value -> Parser [TextEnvelopeDescr]
$comittedField :: Maybe TextEnvelopeDescr
omittedField :: Maybe TextEnvelopeDescr
FromJSON)

-- | A 'TextEnvelope' is a structured envelope for serialised binary values
-- with an external format with a semi-readable textual format.
--
-- It contains a \"type\" field, e.g. \"PublicKeyByron\" or \"TxSignedShelley\"
-- to indicate the type of the encoded data. This is used as a sanity check
-- and to help readers.
--
-- It also contains a \"title\" field which is free-form, and could be used
-- to indicate the role or purpose to a reader.
--
data TextEnvelope = TextEnvelope
  { TextEnvelope -> TextEnvelopeType
teType        :: !TextEnvelopeType
  , TextEnvelope -> TextEnvelopeDescr
teDescription :: !TextEnvelopeDescr
  , TextEnvelope -> ByteString
teRawCBOR     :: !ByteString
  } deriving (TextEnvelope -> TextEnvelope -> Bool
(TextEnvelope -> TextEnvelope -> Bool)
-> (TextEnvelope -> TextEnvelope -> Bool) -> Eq TextEnvelope
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TextEnvelope -> TextEnvelope -> Bool
== :: TextEnvelope -> TextEnvelope -> Bool
$c/= :: TextEnvelope -> TextEnvelope -> Bool
/= :: TextEnvelope -> TextEnvelope -> Bool
Eq, Int -> TextEnvelope -> ShowS
[TextEnvelope] -> ShowS
TextEnvelope -> String
(Int -> TextEnvelope -> ShowS)
-> (TextEnvelope -> String)
-> ([TextEnvelope] -> ShowS)
-> Show TextEnvelope
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TextEnvelope -> ShowS
showsPrec :: Int -> TextEnvelope -> ShowS
$cshow :: TextEnvelope -> String
show :: TextEnvelope -> String
$cshowList :: [TextEnvelope] -> ShowS
showList :: [TextEnvelope] -> ShowS
Show)

instance HasTypeProxy TextEnvelope where
    data AsType TextEnvelope = AsTextEnvelope
    proxyToAsType :: Proxy TextEnvelope -> AsType TextEnvelope
proxyToAsType Proxy TextEnvelope
_ = AsType TextEnvelope
AsTextEnvelope

instance ToJSON TextEnvelope where
  toJSON :: TextEnvelope -> Value
toJSON TextEnvelope {TextEnvelopeType
teType :: TextEnvelope -> TextEnvelopeType
teType :: TextEnvelopeType
teType, TextEnvelopeDescr
teDescription :: TextEnvelope -> TextEnvelopeDescr
teDescription :: TextEnvelopeDescr
teDescription, ByteString
teRawCBOR :: TextEnvelope -> ByteString
teRawCBOR :: ByteString
teRawCBOR} =
    [Pair] -> Value
object [ Key
"type"        Key -> TextEnvelopeType -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TextEnvelopeType
teType
           , Key
"description" Key -> TextEnvelopeDescr -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TextEnvelopeDescr
teDescription
           , Key
"cborHex"     Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ByteString -> Text
Text.decodeUtf8 (ByteString -> ByteString
Base16.encode ByteString
teRawCBOR)
           ]

instance FromJSON TextEnvelope where
  parseJSON :: Value -> Parser TextEnvelope
parseJSON = String
-> (Object -> Parser TextEnvelope) -> Value -> Parser TextEnvelope
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"TextEnvelope" ((Object -> Parser TextEnvelope) -> Value -> Parser TextEnvelope)
-> (Object -> Parser TextEnvelope) -> Value -> Parser TextEnvelope
forall a b. (a -> b) -> a -> b
$ \Object
v ->
                TextEnvelopeType -> TextEnvelopeDescr -> ByteString -> TextEnvelope
TextEnvelope (TextEnvelopeType
 -> TextEnvelopeDescr -> ByteString -> TextEnvelope)
-> Parser TextEnvelopeType
-> Parser (TextEnvelopeDescr -> ByteString -> TextEnvelope)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v Object -> Key -> Parser TextEnvelopeType
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type")
                             Parser (TextEnvelopeDescr -> ByteString -> TextEnvelope)
-> Parser TextEnvelopeDescr -> Parser (ByteString -> TextEnvelope)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Key -> Parser TextEnvelopeDescr
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"description")
                             Parser (ByteString -> TextEnvelope)
-> Parser ByteString -> Parser TextEnvelope
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser ByteString
parseJSONBase16 (Value -> Parser ByteString) -> Parser Value -> Parser ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
v Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"cborHex")
    where
      parseJSONBase16 :: Value -> Parser ByteString
parseJSONBase16 Value
v =
        (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 a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ByteString -> Parser ByteString
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String ByteString -> Parser ByteString)
-> (Text -> Either String ByteString) -> Text -> Parser ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
Text.encodeUtf8 (Text -> Parser ByteString) -> Parser Text -> Parser ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v


-- | The errors that the pure 'TextEnvelope' parsing\/decoding functions can return.
--
data TextEnvelopeError
  = TextEnvelopeTypeError   ![TextEnvelopeType] !TextEnvelopeType -- ^ expected, actual
  | TextEnvelopeDecodeError !DecoderError
  | TextEnvelopeAesonDecodeError !String
  deriving (TextEnvelopeError -> TextEnvelopeError -> Bool
(TextEnvelopeError -> TextEnvelopeError -> Bool)
-> (TextEnvelopeError -> TextEnvelopeError -> Bool)
-> Eq TextEnvelopeError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TextEnvelopeError -> TextEnvelopeError -> Bool
== :: TextEnvelopeError -> TextEnvelopeError -> Bool
$c/= :: TextEnvelopeError -> TextEnvelopeError -> Bool
/= :: TextEnvelopeError -> TextEnvelopeError -> Bool
Eq, Int -> TextEnvelopeError -> ShowS
[TextEnvelopeError] -> ShowS
TextEnvelopeError -> String
(Int -> TextEnvelopeError -> ShowS)
-> (TextEnvelopeError -> String)
-> ([TextEnvelopeError] -> ShowS)
-> Show TextEnvelopeError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TextEnvelopeError -> ShowS
showsPrec :: Int -> TextEnvelopeError -> ShowS
$cshow :: TextEnvelopeError -> String
show :: TextEnvelopeError -> String
$cshowList :: [TextEnvelopeError] -> ShowS
showList :: [TextEnvelopeError] -> ShowS
Show)

instance Error TextEnvelopeError where
  displayError :: TextEnvelopeError -> String
displayError TextEnvelopeError
tee =
    case TextEnvelopeError
tee of
      TextEnvelopeTypeError [TextEnvelopeType String
expType]
                            (TextEnvelopeType String
actType) ->
          String
"TextEnvelope type error: "
       String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" Expected: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
expType
       String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" Actual: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
actType

      TextEnvelopeTypeError [TextEnvelopeType]
expTypes (TextEnvelopeType String
actType) ->
          String
"TextEnvelope type error: "
       String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" Expected one of: "
       String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
", "
            [ String
expType | TextEnvelopeType String
expType <- [TextEnvelopeType]
expTypes ]
       String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" Actual: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
actType
      TextEnvelopeAesonDecodeError String
decErr -> String
"TextEnvelope aeson decode error: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
decErr
      TextEnvelopeDecodeError DecoderError
decErr -> String
"TextEnvelope decode error: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> DecoderError -> String
forall a. Show a => a -> String
show DecoderError
decErr

-- | Check that the \"type\" of the 'TextEnvelope' is as expected.
--
-- For example, one might check that the type is \"TxSignedShelley\".
--
expectTextEnvelopeOfType :: TextEnvelopeType -> TextEnvelope -> Either TextEnvelopeError ()
expectTextEnvelopeOfType :: TextEnvelopeType -> TextEnvelope -> Either TextEnvelopeError ()
expectTextEnvelopeOfType TextEnvelopeType
expectedType TextEnvelope { teType :: TextEnvelope -> TextEnvelopeType
teType = TextEnvelopeType
actualType } =
    Bool -> Either TextEnvelopeError () -> Either TextEnvelopeError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (TextEnvelopeType
expectedType TextEnvelopeType -> TextEnvelopeType -> Bool
forall a. Eq a => a -> a -> Bool
== TextEnvelopeType
actualType) (Either TextEnvelopeError () -> Either TextEnvelopeError ())
-> Either TextEnvelopeError () -> Either TextEnvelopeError ()
forall a b. (a -> b) -> a -> b
$
      TextEnvelopeError -> Either TextEnvelopeError ()
forall a b. a -> Either a b
Left ([TextEnvelopeType] -> TextEnvelopeType -> TextEnvelopeError
TextEnvelopeTypeError [TextEnvelopeType
expectedType] TextEnvelopeType
actualType)


-- ----------------------------------------------------------------------------
-- Serialisation in text envelope format
--

class SerialiseAsCBOR a => HasTextEnvelope a where
    textEnvelopeType :: AsType a -> TextEnvelopeType

    textEnvelopeDefaultDescr :: a -> TextEnvelopeDescr
    textEnvelopeDefaultDescr a
_ = TextEnvelopeDescr
""


serialiseToTextEnvelope :: forall a. HasTextEnvelope a
                        => Maybe TextEnvelopeDescr -> a -> TextEnvelope
serialiseToTextEnvelope :: forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> TextEnvelope
serialiseToTextEnvelope Maybe TextEnvelopeDescr
mbDescr a
a =
    TextEnvelope {
      teType :: TextEnvelopeType
teType    = AsType a -> TextEnvelopeType
forall a. HasTextEnvelope a => AsType a -> TextEnvelopeType
textEnvelopeType AsType a
ttoken
    , teDescription :: TextEnvelopeDescr
teDescription   = TextEnvelopeDescr -> Maybe TextEnvelopeDescr -> TextEnvelopeDescr
forall a. a -> Maybe a -> a
fromMaybe (a -> TextEnvelopeDescr
forall a. HasTextEnvelope a => a -> TextEnvelopeDescr
textEnvelopeDefaultDescr a
a) Maybe TextEnvelopeDescr
mbDescr
    , teRawCBOR :: ByteString
teRawCBOR = a -> ByteString
forall a. SerialiseAsCBOR a => a -> ByteString
serialiseToCBOR a
a
    }
  where
    ttoken :: AsType a
    ttoken :: AsType a
ttoken = Proxy a -> AsType a
forall t. HasTypeProxy t => Proxy t -> AsType t
proxyToAsType Proxy a
forall {k} (t :: k). Proxy t
Proxy


deserialiseFromTextEnvelope :: HasTextEnvelope a
                            => AsType a
                            -> TextEnvelope
                            -> Either TextEnvelopeError a
deserialiseFromTextEnvelope :: forall a.
HasTextEnvelope a =>
AsType a -> TextEnvelope -> Either TextEnvelopeError a
deserialiseFromTextEnvelope AsType a
ttoken TextEnvelope
te = do
    TextEnvelopeType -> TextEnvelope -> Either TextEnvelopeError ()
expectTextEnvelopeOfType (AsType a -> TextEnvelopeType
forall a. HasTextEnvelope a => AsType a -> TextEnvelopeType
textEnvelopeType AsType a
ttoken) TextEnvelope
te
    (DecoderError -> TextEnvelopeError)
-> Either DecoderError a -> Either TextEnvelopeError a
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first DecoderError -> TextEnvelopeError
TextEnvelopeDecodeError (Either DecoderError a -> Either TextEnvelopeError a)
-> Either DecoderError a -> Either TextEnvelopeError a
forall a b. (a -> b) -> a -> b
$
      AsType a -> ByteString -> Either DecoderError a
forall a.
SerialiseAsCBOR a =>
AsType a -> ByteString -> Either DecoderError a
deserialiseFromCBOR AsType a
ttoken (TextEnvelope -> ByteString
teRawCBOR TextEnvelope
te) --TODO: You have switched from CBOR to JSON


deserialiseFromTextEnvelopeAnyOf :: [FromSomeType HasTextEnvelope b]
                                 -> TextEnvelope
                                 -> Either TextEnvelopeError b
deserialiseFromTextEnvelopeAnyOf :: forall b.
[FromSomeType HasTextEnvelope b]
-> TextEnvelope -> Either TextEnvelopeError b
deserialiseFromTextEnvelopeAnyOf [FromSomeType HasTextEnvelope b]
types TextEnvelope
te =
    case (FromSomeType HasTextEnvelope b -> Bool)
-> [FromSomeType HasTextEnvelope b]
-> Maybe (FromSomeType HasTextEnvelope b)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find FromSomeType HasTextEnvelope b -> Bool
matching [FromSomeType HasTextEnvelope b]
types of
      Maybe (FromSomeType HasTextEnvelope b)
Nothing ->
        TextEnvelopeError -> Either TextEnvelopeError b
forall a b. a -> Either a b
Left ([TextEnvelopeType] -> TextEnvelopeType -> TextEnvelopeError
TextEnvelopeTypeError [TextEnvelopeType]
expectedTypes TextEnvelopeType
actualType)

      Just (FromSomeType AsType a
ttoken a -> b
f) ->
        (DecoderError -> TextEnvelopeError)
-> Either DecoderError b -> Either TextEnvelopeError b
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first DecoderError -> TextEnvelopeError
TextEnvelopeDecodeError (Either DecoderError b -> Either TextEnvelopeError b)
-> Either DecoderError b -> Either TextEnvelopeError b
forall a b. (a -> b) -> a -> b
$
          a -> b
f (a -> b) -> Either DecoderError a -> Either DecoderError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AsType a -> ByteString -> Either DecoderError a
forall a.
SerialiseAsCBOR a =>
AsType a -> ByteString -> Either DecoderError a
deserialiseFromCBOR AsType a
ttoken (TextEnvelope -> ByteString
teRawCBOR TextEnvelope
te)
  where
    actualType :: TextEnvelopeType
actualType    = TextEnvelope -> TextEnvelopeType
teType TextEnvelope
te
    expectedTypes :: [TextEnvelopeType]
expectedTypes = [ AsType a -> TextEnvelopeType
forall a. HasTextEnvelope a => AsType a -> TextEnvelopeType
textEnvelopeType AsType a
ttoken
                    | FromSomeType AsType a
ttoken a -> b
_f <- [FromSomeType HasTextEnvelope b]
types ]

    matching :: FromSomeType HasTextEnvelope b -> Bool
matching (FromSomeType AsType a
ttoken a -> b
_f) = TextEnvelopeType
actualType TextEnvelopeType -> TextEnvelopeType -> Bool
forall a. Eq a => a -> a -> Bool
== AsType a -> TextEnvelopeType
forall a. HasTextEnvelope a => AsType a -> TextEnvelopeType
textEnvelopeType AsType a
ttoken

readFileTextEnvelope :: HasTextEnvelope a
                     => AsType a
                     -> FilePath
                     -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope :: forall a.
HasTextEnvelope a =>
AsType a -> String -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope AsType a
ttoken String
path =
    ExceptT (FileError TextEnvelopeError) IO a
-> IO (Either (FileError TextEnvelopeError) a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (FileError TextEnvelopeError) IO a
 -> IO (Either (FileError TextEnvelopeError) a))
-> ExceptT (FileError TextEnvelopeError) IO a
-> IO (Either (FileError TextEnvelopeError) a)
forall a b. (a -> b) -> a -> b
$ do
      ByteString
content <- (IOException -> FileError TextEnvelopeError)
-> IO ByteString
-> ExceptT (FileError TextEnvelopeError) IO ByteString
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (String -> IOException -> FileError TextEnvelopeError
forall e. String -> IOException -> FileError e
FileIOError String
path) (IO ByteString
 -> ExceptT (FileError TextEnvelopeError) IO ByteString)
-> IO ByteString
-> ExceptT (FileError TextEnvelopeError) IO ByteString
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
BS.readFile String
path
      (TextEnvelopeError -> FileError TextEnvelopeError)
-> ExceptT TextEnvelopeError IO a
-> ExceptT (FileError TextEnvelopeError) IO a
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> TextEnvelopeError -> FileError TextEnvelopeError
forall e. String -> e -> FileError e
FileError String
path) (ExceptT TextEnvelopeError IO a
 -> ExceptT (FileError TextEnvelopeError) IO a)
-> ExceptT TextEnvelopeError IO a
-> ExceptT (FileError TextEnvelopeError) IO a
forall a b. (a -> b) -> a -> b
$ Either TextEnvelopeError a -> ExceptT TextEnvelopeError IO a
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either TextEnvelopeError a -> ExceptT TextEnvelopeError IO a)
-> Either TextEnvelopeError a -> ExceptT TextEnvelopeError IO a
forall a b. (a -> b) -> a -> b
$ do
        TextEnvelope
te <- (String -> TextEnvelopeError)
-> Either String TextEnvelope
-> Either TextEnvelopeError TextEnvelope
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> TextEnvelopeError
TextEnvelopeAesonDecodeError (Either String TextEnvelope
 -> Either TextEnvelopeError TextEnvelope)
-> Either String TextEnvelope
-> Either TextEnvelopeError TextEnvelope
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String TextEnvelope
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecodeStrict' ByteString
content
        AsType a -> TextEnvelope -> Either TextEnvelopeError a
forall a.
HasTextEnvelope a =>
AsType a -> TextEnvelope -> Either TextEnvelopeError a
deserialiseFromTextEnvelope AsType a
ttoken TextEnvelope
te


readFileTextEnvelopeAnyOf :: [FromSomeType HasTextEnvelope b]
                          -> FilePath
                          -> IO (Either (FileError TextEnvelopeError) b)
readFileTextEnvelopeAnyOf :: forall b.
[FromSomeType HasTextEnvelope b]
-> String -> IO (Either (FileError TextEnvelopeError) b)
readFileTextEnvelopeAnyOf [FromSomeType HasTextEnvelope b]
types String
path =
    ExceptT (FileError TextEnvelopeError) IO b
-> IO (Either (FileError TextEnvelopeError) b)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (FileError TextEnvelopeError) IO b
 -> IO (Either (FileError TextEnvelopeError) b))
-> ExceptT (FileError TextEnvelopeError) IO b
-> IO (Either (FileError TextEnvelopeError) b)
forall a b. (a -> b) -> a -> b
$ do
      ByteString
content <- (IOException -> FileError TextEnvelopeError)
-> IO ByteString
-> ExceptT (FileError TextEnvelopeError) IO ByteString
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (String -> IOException -> FileError TextEnvelopeError
forall e. String -> IOException -> FileError e
FileIOError String
path) (IO ByteString
 -> ExceptT (FileError TextEnvelopeError) IO ByteString)
-> IO ByteString
-> ExceptT (FileError TextEnvelopeError) IO ByteString
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
BS.readFile String
path
      (TextEnvelopeError -> FileError TextEnvelopeError)
-> ExceptT TextEnvelopeError IO b
-> ExceptT (FileError TextEnvelopeError) IO b
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> TextEnvelopeError -> FileError TextEnvelopeError
forall e. String -> e -> FileError e
FileError String
path) (ExceptT TextEnvelopeError IO b
 -> ExceptT (FileError TextEnvelopeError) IO b)
-> ExceptT TextEnvelopeError IO b
-> ExceptT (FileError TextEnvelopeError) IO b
forall a b. (a -> b) -> a -> b
$ Either TextEnvelopeError b -> ExceptT TextEnvelopeError IO b
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either TextEnvelopeError b -> ExceptT TextEnvelopeError IO b)
-> Either TextEnvelopeError b -> ExceptT TextEnvelopeError IO b
forall a b. (a -> b) -> a -> b
$ do
        TextEnvelope
te <- (String -> TextEnvelopeError)
-> Either String TextEnvelope
-> Either TextEnvelopeError TextEnvelope
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> TextEnvelopeError
TextEnvelopeAesonDecodeError (Either String TextEnvelope
 -> Either TextEnvelopeError TextEnvelope)
-> Either String TextEnvelope
-> Either TextEnvelopeError TextEnvelope
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String TextEnvelope
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecodeStrict' ByteString
content
        [FromSomeType HasTextEnvelope b]
-> TextEnvelope -> Either TextEnvelopeError b
forall b.
[FromSomeType HasTextEnvelope b]
-> TextEnvelope -> Either TextEnvelopeError b
deserialiseFromTextEnvelopeAnyOf [FromSomeType HasTextEnvelope b]
types TextEnvelope
te


readTextEnvelopeFromFile :: FilePath
                         -> IO (Either (FileError TextEnvelopeError) TextEnvelope)
readTextEnvelopeFromFile :: String -> IO (Either (FileError TextEnvelopeError) TextEnvelope)
readTextEnvelopeFromFile String
path =
  ExceptT (FileError TextEnvelopeError) IO TextEnvelope
-> IO (Either (FileError TextEnvelopeError) TextEnvelope)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (FileError TextEnvelopeError) IO TextEnvelope
 -> IO (Either (FileError TextEnvelopeError) TextEnvelope))
-> ExceptT (FileError TextEnvelopeError) IO TextEnvelope
-> IO (Either (FileError TextEnvelopeError) TextEnvelope)
forall a b. (a -> b) -> a -> b
$ do
    ByteString
bs <- (IOException -> FileError TextEnvelopeError)
-> IO ByteString
-> ExceptT (FileError TextEnvelopeError) IO ByteString
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (String -> IOException -> FileError TextEnvelopeError
forall e. String -> IOException -> FileError e
FileIOError String
path) (IO ByteString
 -> ExceptT (FileError TextEnvelopeError) IO ByteString)
-> IO ByteString
-> ExceptT (FileError TextEnvelopeError) IO ByteString
forall a b. (a -> b) -> a -> b
$
            String -> IO ByteString
BS.readFile String
path
    (String -> FileError TextEnvelopeError)
-> ExceptT String IO TextEnvelope
-> ExceptT (FileError TextEnvelopeError) IO TextEnvelope
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> TextEnvelopeError -> FileError TextEnvelopeError
forall e. String -> e -> FileError e
FileError String
path (TextEnvelopeError -> FileError TextEnvelopeError)
-> (String -> TextEnvelopeError)
-> String
-> FileError TextEnvelopeError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> TextEnvelopeError
TextEnvelopeAesonDecodeError)
      (ExceptT String IO TextEnvelope
 -> ExceptT (FileError TextEnvelopeError) IO TextEnvelope)
-> (Either String TextEnvelope -> ExceptT String IO TextEnvelope)
-> Either String TextEnvelope
-> ExceptT (FileError TextEnvelopeError) IO TextEnvelope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either String TextEnvelope -> ExceptT String IO TextEnvelope
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either String TextEnvelope
 -> ExceptT (FileError TextEnvelopeError) IO TextEnvelope)
-> Either String TextEnvelope
-> ExceptT (FileError TextEnvelopeError) IO TextEnvelope
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String TextEnvelope
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecodeStrict' ByteString
bs


readTextEnvelopeOfTypeFromFile ::
     TextEnvelopeType
  -> FilePath
  -> IO (Either (FileError TextEnvelopeError) TextEnvelope)
readTextEnvelopeOfTypeFromFile :: TextEnvelopeType
-> String -> IO (Either (FileError TextEnvelopeError) TextEnvelope)
readTextEnvelopeOfTypeFromFile TextEnvelopeType
expectedType String
path =
  ExceptT (FileError TextEnvelopeError) IO TextEnvelope
-> IO (Either (FileError TextEnvelopeError) TextEnvelope)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (FileError TextEnvelopeError) IO TextEnvelope
 -> IO (Either (FileError TextEnvelopeError) TextEnvelope))
-> ExceptT (FileError TextEnvelopeError) IO TextEnvelope
-> IO (Either (FileError TextEnvelopeError) TextEnvelope)
forall a b. (a -> b) -> a -> b
$ do
    TextEnvelope
te <- IO (Either (FileError TextEnvelopeError) TextEnvelope)
-> ExceptT (FileError TextEnvelopeError) IO TextEnvelope
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (String -> IO (Either (FileError TextEnvelopeError) TextEnvelope)
readTextEnvelopeFromFile String
path)
    (TextEnvelopeError -> FileError TextEnvelopeError)
-> ExceptT TextEnvelopeError IO ()
-> ExceptT (FileError TextEnvelopeError) IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> TextEnvelopeError -> FileError TextEnvelopeError
forall e. String -> e -> FileError e
FileError String
path) (ExceptT TextEnvelopeError IO ()
 -> ExceptT (FileError TextEnvelopeError) IO ())
-> ExceptT TextEnvelopeError IO ()
-> ExceptT (FileError TextEnvelopeError) IO ()
forall a b. (a -> b) -> a -> b
$ Either TextEnvelopeError () -> ExceptT TextEnvelopeError IO ()
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either TextEnvelopeError () -> ExceptT TextEnvelopeError IO ())
-> Either TextEnvelopeError () -> ExceptT TextEnvelopeError IO ()
forall a b. (a -> b) -> a -> b
$
      TextEnvelopeType -> TextEnvelope -> Either TextEnvelopeError ()
expectTextEnvelopeOfType TextEnvelopeType
expectedType TextEnvelope
te
    TextEnvelope
-> ExceptT (FileError TextEnvelopeError) IO TextEnvelope
forall a. a -> ExceptT (FileError TextEnvelopeError) IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TextEnvelope
te