/
TextView.hs
141 lines (115 loc) · 4.84 KB
/
TextView.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
module Cardano.Api.TextView
( -- * \"TextView\" format
TextView (..)
, TextViewError (..)
, TextViewType (..)
, TextViewDescription (..)
, renderTextViewError
, expectTextViewOfType
, textViewJSONConfig
, textViewJSONKeyOrder
, textShow
-- * File IO support
, TextViewFileError (..)
, renderTextViewFileError
) where
import Cardano.Prelude
import Prelude (String)
import Data.Aeson (FromJSON(..), ToJSON(..), object,
withObject, (.=), (.:))
import Data.Aeson.Encode.Pretty (Config(..), defConfig, keyOrder)
import qualified Data.ByteString.Base16 as Base16
import Data.ByteString.Char8 (ByteString)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import Cardano.Binary
newtype TextViewType
= TextViewType { unTextViewType :: ByteString }
deriving (Eq, IsString, Show, Semigroup)
newtype TextViewDescription
= TextViewDescription { unTextViewDescription :: ByteString }
deriving (Eq, IsString, Show, Semigroup)
-- | A 'TextView' is a structured envalope 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 TextView = TextView
{ tvType :: !TextViewType
, tvDescription :: !TextViewDescription
, tvRawCBOR :: !ByteString
} deriving (Eq, Show)
instance ToJSON TextView where
toJSON (TextView (TextViewType tvType) (TextViewDescription desc) rawCBOR) =
object [ "type" .= Text.decodeUtf8 tvType
, "description" .= Text.decodeUtf8 desc
, "cborHex" .= (Text.decodeUtf8 $ Base16.encode rawCBOR)
]
instance FromJSON TextView where
parseJSON = withObject "TextView" $ \v -> TextView
<$> (TextViewType . Text.encodeUtf8 <$> v .: "type")
<*> (TextViewDescription . Text.encodeUtf8 <$> v .: "description")
<*> (fst . Base16.decode . Text.encodeUtf8 <$> v .: "cborHex")
textViewJSONConfig :: Config
textViewJSONConfig = defConfig { confCompare = textViewJSONKeyOrder }
textViewJSONKeyOrder :: Text -> Text -> Ordering
textViewJSONKeyOrder = keyOrder ["type", "description", "cborHex"]
-- | The errors that the pure 'TextView' parsing\/decoding functions can return.
--
data TextViewError
= TextViewFormatError !Text
| TextViewTypeError ![TextViewType] !TextViewType -- ^ expected, actual
| TextViewDecodeError !DecoderError
| TextViewAesonDecodeError !String
deriving (Eq, Show)
renderTextViewError :: TextViewError -> Text
renderTextViewError tve =
case tve of
TextViewFormatError err -> "TextView format error: " <> toS err
TextViewTypeError [expType] actType ->
"TextView type error: "
<> " Expected: " <> Text.decodeLatin1 (unTextViewType expType)
<> " Actual: " <> Text.decodeLatin1 (unTextViewType actType)
TextViewTypeError expTypes actType ->
"TextView type error: "
<> " Expected one of: "
<> Text.intercalate ", "
[ Text.decodeLatin1 (unTextViewType expType) | expType <- expTypes ]
<> " Actual: " <> (Text.decodeLatin1 (unTextViewType actType))
TextViewAesonDecodeError decErr -> "TextView aeson decode error: " <> textShow decErr
TextViewDecodeError decErr -> "TextView decode error: " <> textShow decErr
-- ----------------------------------------------------------------------------
-- | Check that the \"type\" of the 'TextView' is as expected.
--
-- For example, one might check that the type is \"TxSignedShelley\".
--
expectTextViewOfType :: TextViewType -> TextView -> Either TextViewError ()
expectTextViewOfType expectedType tv = do
let actualType = tvType tv
unless (expectedType == actualType) $
throwError (TextViewTypeError [expectedType] actualType)
-- ----------------------------------------------------------------------------
-- | The errors that the IO 'TextView' reading\/decoding actions can return.
--
data TextViewFileError
= TextViewFileError !FilePath !TextViewError
| TextViewFileIOError !FilePath !IOException
deriving (Eq, Show)
renderTextViewFileError :: TextViewFileError -> Text
renderTextViewFileError tvfe =
case tvfe of
TextViewFileError fp err -> toS fp <> ": " <> renderTextViewError err
TextViewFileIOError fp ioExcpt ->
"TextView IO exception at: " <> toS fp <> " Error: " <> textShow ioExcpt
-- ----------------------------------------------------------------------------
textShow :: Show a => a -> Text
textShow = Text.pack . show