Merge pull request #482 from input-output-hk/jonathanknowles/hash-gen…

…esis-to-from-text

Provide `ToText` and `FromText` instances for `Hash "Genesis"`

lib/core/src/Cardano/Wallet/Primitive/Types.hs

@@ -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
@@ -144,7 +144,7 @@ import Fmt
 import GHC.Generics
     ( Generic )
 import GHC.TypeLits
-    ( Symbol )
+    ( KnownSymbol, Symbol, symbolVal )
 import Numeric.Natural
     ( Natural )
 
@@ -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.

lib/core/test/unit/Cardano/Wallet/Primitive/TypesSpec.hs

@@ -101,6 +101,7 @@ spec = do
         textRoundtrip $ Proxy @TxStatus
         textRoundtrip $ Proxy @WalletName
         textRoundtrip $ Proxy @WalletId
+        textRoundtrip $ Proxy @(Hash "Genesis")
         textRoundtrip $ Proxy @(Hash "Tx")
 
     describe "Buildable" $ do
@@ -147,6 +148,10 @@ spec = do
             let err = "wallet id should be an hex-encoded string \
                       \of 40 characters"
             fromText @WalletId "101" === Left (TextDecodingError err)
+        it "fail fromText (@Hash \"Genesis\")" $ do
+            let err = "Unable to decode (Hash \"Genesis\"): \
+                      \expected Base16 encoding"
+            fromText @(Hash "Genesis") "----" === Left (TextDecodingError err)
 
     describe "Lemma 2.1 - Properties of UTxO operations" $ do
         it "2.1.1) ins⊲ u ⊆ u"
@@ -307,6 +312,10 @@ instance Arbitrary Direction where
     arbitrary = arbitraryBoundedEnum
     shrink = genericShrink
 
+instance Arbitrary (Hash "Genesis") where
+    arbitrary = Hash . BS.pack <$> arbitrary
+    shrink (Hash v) = Hash . BS.pack <$> shrink (BS.unpack v)
+
 instance Arbitrary (Hash "Tx") where
     -- No Shrinking
     arbitrary = oneof