WIP

cardano-api/src/Cardano/Api/Typed.hs

@@ -635,17 +635,31 @@ instance SerialiseAsRawBytes StakeAddress where
 
 
 instance SerialiseAsBech32 (Address Shelley) where
-  humanReadablePrefix _ =
-    case Bech32.humanReadablePartFromText "addr_" of
-      Left err -> error $ "Impossible: " <> show err
-      Right prefix -> prefix
+  humanReadablePrefix (ByronAddress _) =
+    error "TODO @intricate: What do we do about this?"
+  humanReadablePrefix (ShelleyAddress nw _ _) =
+      case Bech32.humanReadablePartFromText prefix of
+        Left err -> error $ "Impossible: " <> show err
+        Right hrp -> hrp
+    where
+      prefix :: Text
+      prefix =
+        case nw of
+          Shelley.Mainnet -> "addr_"
+          Shelley.Testnet -> "addr_test_"
 
 
 instance SerialiseAsBech32 StakeAddress where
-  humanReadablePrefix _ =
-    case Bech32.humanReadablePartFromText "stake_" of
+  humanReadablePrefix (StakeAddress nw _ ) =
+    case Bech32.humanReadablePartFromText prefix of
       Left err -> error $ "Impossible: " <> show err
-      Right prefix -> prefix
+      Right hrp -> hrp
+    where
+      prefix :: Text
+      prefix =
+        case nw of
+          Shelley.Mainnet -> "stake_"
+          Shelley.Testnet -> "stake_test_"
 
 
 makeByronAddress :: VerificationKey ByronKey
@@ -2243,43 +2257,53 @@ deserialiseFromRawBytesHex proxy hex =
 --
 
 class (HasTypeProxy a, SerialiseAsRawBytes a) => SerialiseAsBech32 a where
-  humanReadablePrefix :: AsType a -> Bech32.HumanReadablePart
+  humanReadablePrefix :: a -> Bech32.HumanReadablePart
 
   serialiseToBech32 :: a -> Either Bech32EncodeError Text
-  serialiseToBech32 =
+  serialiseToBech32 a =
     first Bech32EncodingError
-      . Bech32.encode (humanReadablePrefix (proxyToAsType Proxy :: AsType a))
+      . Bech32.encode (humanReadablePrefix a)
       . Bech32.dataPartFromBytes
       . serialiseToRawBytes
+      $ a
 
   deserialiseFromBech32 :: AsType a -> Text -> Either Bech32DecodeError a
   deserialiseFromBech32 asType bech32Str =
       case Bech32.decode bech32Str of
         Left decErr -> Left (Bech32DecodingError decErr)
-        Right (humanReadablePart, dataPart) -> do
-          let expected = Bech32.humanReadablePartToText (humanReadablePrefix asType)
-              actual = Bech32.humanReadablePartToText humanReadablePart
-          if expected == actual
-            then withDataPartAsBytes dataPart eitherDeserialiseRawBytes
-            else Left (Bech32IncorrectHumanReadablePrefixError expected actual)
+        Right (humanReadablePart, dataPart) ->
+          case deserialiseFromDataPartBytes dataPart tryDeserialise of
+            Left err -> Left err
+            Right res -> validatePrefix humanReadablePart res
     where
-      withDataPartAsBytes
+      deserialiseFromDataPartBytes
         :: Bech32.DataPart
         -> (ByteString -> Either Bech32DecodeError b)
         -> Either Bech32DecodeError b
-      withDataPartAsBytes dp f =
+      deserialiseFromDataPartBytes dp deserialise =
         maybe
           (Left $ Bech32DataPartToBytesError $ Bech32.dataPartToText dp)
-          f
+          deserialise
           (Bech32.dataPartToBytes dp)
 
-      eitherDeserialiseRawBytes :: ByteString -> Either Bech32DecodeError a
-      eitherDeserialiseRawBytes bs =
+      tryDeserialise :: ByteString -> Either Bech32DecodeError a
+      tryDeserialise bs =
         maybe
           (Left $ Bech32DeserialiseFromBytesError bs)
           Right
           (deserialiseFromRawBytes asType bs)
 
+      validatePrefix
+        :: Bech32.HumanReadablePart
+        -> a
+        -> Either Bech32DecodeError a
+      validatePrefix actualHrp a = do
+        let expected = Bech32.humanReadablePartToText (humanReadablePrefix a)
+            actual = Bech32.humanReadablePartToText actualHrp
+        if expected == actual
+          then Right a
+          else Left (Bech32IncorrectHumanReadablePrefixError expected actual)
+
 -- | Bech32 encoding error.
 data Bech32EncodeError
   = Bech32EncodingError !Bech32.EncodingError

cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs

@@ -740,21 +740,14 @@ pWithdrawal =
       (  Opt.long "withdrawal"
       <> Opt.metavar "WITHDRAWAL"
       <> Opt.help "The reward withdrawal as StakeAddress+Lovelace where \
-                  \StakeAddress is the hex encoded stake address \
+                  \StakeAddress is the Bech32-encoded stake address \
                   \followed by the amount in Lovelace."
       )
   where
     parseWithdrawal :: Atto.Parser (Typed.StakeAddress, Typed.Lovelace)
     parseWithdrawal =
       (,) <$> parseStakeAddress <* Atto.char '+' <*> parseLovelace
 
-    parseStakeAddress :: Atto.Parser Typed.StakeAddress
-    parseStakeAddress = do
-      bstr <- Atto.takeWhile1 Char.isHexDigit
-      case Typed.deserialiseFromRawBytesHex Typed.AsStakeAddress bstr of
-        Just addr -> return addr
-        Nothing -> fail $ "Incorrect stake address format: " ++ show bstr
-
 
 pUpdateProposalFile :: Parser UpdateProposalFile
 pUpdateProposalFile =
@@ -1061,26 +1054,15 @@ pTxOut =
   Opt.option (readerFromAttoParser parseTxOut)
     (  Opt.long "tx-out"
     <> Opt.metavar "TX-OUT"
-    <> Opt.help "The ouput transaction as TxOut+Lovelace where TxOut is the hex encoded address followed by the amount in Lovelace."
+    <> Opt.help "The ouput transaction as Address+Lovelace where Address is \
+                \the Bech32-encoded address followed by the amount in \
+                \Lovelace."
     )
   where
     parseTxOut :: Atto.Parser (Typed.TxOut Typed.Shelley)
     parseTxOut =
       Typed.TxOut <$> parseAddress <* Atto.char '+' <*> parseLovelace
 
-    parseAddress :: Atto.Parser (Typed.Address Typed.Shelley)
-    parseAddress = do
-      str <- Text.decodeLatin1 <$> Atto.takeWhile1 Char.isAlphaNum
-      case deserialiseFromBech32 AsShelleyAddress str of
-        Left err -> fail . Text.unpack . renderBech32DecodeError $ err
-        Right addr -> pure addr
-
-      -- TODO @intricate: Should we continue to support hex-encoded addresses?
-      -- bstr <- Atto.takeWhile1 Char.isHexDigit
-      -- case Typed.deserialiseFromRawBytesHex Typed.AsShelleyAddress bstr of
-      --   Just addr -> return addr
-      --   Nothing -> fail $ "Incorrect address format: " ++ show bstr
-
 pTxTTL :: Parser SlotNo
 pTxTTL =
   SlotNo <$>
@@ -1618,6 +1600,20 @@ pProtocolVersion =
 parseLovelace :: Atto.Parser Typed.Lovelace
 parseLovelace = Typed.Lovelace <$> Atto.decimal
 
+parseAddress :: Atto.Parser (Typed.Address Typed.Shelley)
+parseAddress = do
+  str <- Text.decodeLatin1 <$> Atto.takeWhile1 (\c -> c == '_' || Char.isAlphaNum c)
+  case deserialiseFromBech32 AsShelleyAddress str of
+    Left err -> fail . Text.unpack . renderBech32DecodeError $ err
+    Right addr -> pure addr
+
+parseStakeAddress :: Atto.Parser Typed.StakeAddress
+parseStakeAddress = do
+  str <- Text.decodeLatin1 <$> Atto.takeWhile1 (\c -> c == '_' || Char.isAlphaNum c)
+  case deserialiseFromBech32 AsStakeAddress str of
+    Left err -> fail . Text.unpack . renderBech32DecodeError $ err
+    Right addr -> pure addr
+
 --------------------------------------------------------------------------------
 -- Helpers
 --------------------------------------------------------------------------------

cardano-cli/src/Cardano/CLI/Shelley/Run/Address/Info.hs

@@ -41,6 +41,7 @@ runAddressInfo addrTxt = do
     | Text.all isBase58Char addrTxt -> do
         liftIO $ putStrLn "Encoding: Base58"
         runAddressInfoBase58 addrTxt
+    -- TODO: Add Bech32 support.
     | otherwise -> left $ ShelleyAddressDescribeError ("Unknown address type: " <> addrTxt)
   where
     isBase58Char :: Char -> Bool