Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Provide ToText and FromText instances for Hash "Genesis" #482

Merged
merged 4 commits into from
Jun 26, 2019
Merged

Provide ToText and FromText instances for Hash "Genesis" #482

Changes from 2 commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
555b50a
Extract out common code from within `{From,To}Text (Hash t)` instances.
jonathanknowles Jun 26, 2019
3d8b4af
Add `{From,To}Text (Hash "Genesis")` instances.
jonathanknowles Jun 26, 2019
536970d
Add roundtrip `ToText`/`FromText` test for `Hash "Genesis"` type.
jonathanknowles Jun 26, 2019
29f5396
Add negative test for decoding a `Hash "Genesis"` value.
jonathanknowles Jun 26, 2019
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
44 changes: 26 additions & 18 deletions lib/core/src/Cardano/Wallet/Primitive/Types.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -109,7 +109,7 @@ import Data.ByteString
import Data.Map.Strict
( Map )
import Data.Proxy
( Proxy )
( Proxy (..) )
import Data.Quantity
( Percentage, Quantity (..) )
import Data.Set
Expand Down Expand Up @@ -144,7 +144,7 @@ import Fmt
import GHC.Generics
( Generic )
import GHC.TypeLits
( Symbol )
( KnownSymbol, Symbol, symbolVal )
import Numeric.Natural
( Natural )

Expand Down Expand Up @@ -713,29 +713,37 @@ instance Buildable (Hash "Tx") where
where
builder = build . toText $ h

fromTextToHashBase16
:: forall t . KnownSymbol t => Text -> Either TextDecodingError (Hash t)
fromTextToHashBase16 text = either
(const $ Left $ TextDecodingError err)
(pure . Hash)
(convertFromBase Base16 $ T.encodeUtf8 text)
where
err =
"Unable to decode (Hash \"" <> symbolVal (Proxy @t) <> "\"): \
\expected Base16 encoding"

toTextFromHashBase16 :: Hash t -> Text
toTextFromHashBase16 = T.decodeUtf8 . convertToBase Base16 . getHash

instance FromText (Hash "Tx") where
fromText x = either
(const $ Left $ TextDecodingError err)
(pure . Hash)
(convertFromBase Base16 $ T.encodeUtf8 x)
where
err = "Unable to decode (Hash \"Tx\"): \
\expected Base16 encoding"
fromText = fromTextToHashBase16

instance ToText (Hash "Tx") where
toText = T.decodeUtf8 . convertToBase Base16 . getHash
toText = toTextFromHashBase16

instance FromText (Hash "BlockHeader") where
fromText x = either
(const $ Left $ TextDecodingError err)
(pure . Hash)
(convertFromBase Base16 $ T.encodeUtf8 x)
where
err = "Unable to decode (Hash \"BlockHeader\"): \
\expected Base16 encoding"
fromText = fromTextToHashBase16

instance ToText (Hash "BlockHeader") where
toText = T.decodeUtf8 . convertToBase Base16 . getHash
toText = toTextFromHashBase16

instance FromText (Hash "Genesis") where
fromText = fromTextToHashBase16

instance ToText (Hash "Genesis") where
toText = toTextFromHashBase16

-- | A polymorphic wrapper type with a custom show instance to display data
-- through 'Buildable' instances.
Expand Down