Encode PoolId as Bech32 instead of Base16 wrt #2023

cardano-foundation · Aug 27, 2020 · e96b26b · e96b26b
1 parent c36ba7d
commit e96b26b
Show file tree

Hide file tree

Showing 12 changed files with 606 additions and 575 deletions.
diff --git a/lib/core/src/Cardano/Wallet/Api/Types.hs b/lib/core/src/Cardano/Wallet/Api/Types.hs
@@ -177,6 +177,8 @@ import Cardano.Wallet.Primitive.Types
     , WalletBalance (..)
     , WalletId (..)
     , WalletName (..)
+    , decodePoolIdBech32
+    , encodePoolIdBech32
     , isValidCoin
     , unsafeEpochNo
     )
@@ -1096,9 +1098,11 @@ instance ToJSON ApiByronWalletBalance where
     toJSON = genericToJSON defaultRecordTypeOptions
 
 instance FromJSON (ApiT PoolId) where
-    parseJSON = parseJSON >=> eitherToParser . bimap ShowFmt ApiT . fromText
+    parseJSON = parseJSON >=> eitherToParser
+           . bimap ShowFmt ApiT
+           . decodePoolIdBech32
 instance ToJSON (ApiT PoolId) where
-    toJSON = toJSON . toText . getApiT
+    toJSON = toJSON . encodePoolIdBech32 . getApiT
 
 instance FromJSON ApiWalletDelegationStatus where
     parseJSON = genericParseJSON defaultSumTypeOptions
@@ -1453,12 +1457,16 @@ instance FromHttpApiData ApiPoolId where
         | t == "*" =
             Right ApiPoolIdPlaceholder
         | otherwise =
-            bimap pretty ApiPoolId (fromText t)
+            ApiPoolId <$> case fromText t of
+                Left _ ->
+                    left (T.pack . show . ShowFmt) $ decodePoolIdBech32 t
+                Right r ->
+                    Right r
 
 instance ToHttpApiData ApiPoolId where
     toUrlPiece = \case
         ApiPoolIdPlaceholder -> "*"
-        ApiPoolId pid -> toText pid
+        ApiPoolId pid -> encodePoolIdBech32 pid
 
 {-------------------------------------------------------------------------------
                                 Aeson Options

diff --git a/lib/core/src/Cardano/Wallet/Primitive/Types.hs b/lib/core/src/Cardano/Wallet/Primitive/Types.hs
@@ -130,6 +130,8 @@ module Cardano.Wallet.Primitive.Types
     , PoolOwner(..)
     , StakeDistribution (..)
     , poolIdBytesLength
+    , decodePoolIdBech32
+    , encodePoolIdBech32
     , StakePoolMetadata (..)
     , StakePoolMetadataHash (..)
     , StakePoolMetadataUrl (..)
@@ -694,6 +696,28 @@ instance FromText PoolId where
             , "bytes in length."
             ]
 
+-- | Encode 'PoolId' as Bech32 with "pool" hrp.
+encodePoolIdBech32 :: PoolId -> T.Text
+encodePoolIdBech32 =
+    Bech32.encodeLenient hrp
+        . Bech32.dataPartFromBytes
+        . getPoolId
+  where
+    hrp = [Bech32.humanReadablePart|pool|]
+
+-- | Decode a Bech32 encoded 'PoolId'.
+decodePoolIdBech32 :: T.Text -> Either TextDecodingError PoolId
+decodePoolIdBech32 t =
+    case fmap Bech32.dataPartToBytes <$> Bech32.decodeLenient t of
+        Left _ -> Left textDecodingError
+        Right (_, Just bytes) ->
+            Right $ PoolId bytes
+        Right _ -> Left textDecodingError
+      where
+        textDecodingError = TextDecodingError $ unwords
+            [ "Invalid stake pool id: expecting a Bech32 encoded value with human readable part of 'pool'."
+            ]
+
 -- | A stake pool owner, which is a public key encoded in bech32 with prefix
 -- ed25519_pk.
 newtype PoolOwner = PoolOwner { getPoolOwner :: ByteString }