{-# LANGUAGE GADTs #-}
module Cardano.CLI.Shelley.Run.Address.Info
  ( runAddressInfo
  , ShelleyAddressInfoError(..)
  ) where

import           Cardano.Api
import           Cardano.CLI.Shelley.Parsers (OutputFile (..))
import           Cardano.Prelude
import           Control.Monad.Trans.Except.Extra (left)
import           Data.Aeson (ToJSON (..), object, (.=))
import           Data.Aeson.Encode.Pretty (encodePretty)

import qualified Data.ByteString.Lazy.Char8 as LBS

newtype ShelleyAddressInfoError = ShelleyAddressInvalid Text
  deriving Int -> ShelleyAddressInfoError -> ShowS
[ShelleyAddressInfoError] -> ShowS
ShelleyAddressInfoError -> String
(Int -> ShelleyAddressInfoError -> ShowS)
-> (ShelleyAddressInfoError -> String)
-> ([ShelleyAddressInfoError] -> ShowS)
-> Show ShelleyAddressInfoError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShelleyAddressInfoError] -> ShowS
$cshowList :: [ShelleyAddressInfoError] -> ShowS
show :: ShelleyAddressInfoError -> String
$cshow :: ShelleyAddressInfoError -> String
showsPrec :: Int -> ShelleyAddressInfoError -> ShowS
$cshowsPrec :: Int -> ShelleyAddressInfoError -> ShowS
Show

instance Error ShelleyAddressInfoError where
  displayError :: ShelleyAddressInfoError -> String
displayError (ShelleyAddressInvalid Text
addrTxt) =
    String
"Invalid address: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a b. (Show a, ConvertText String b) => a -> b
show Text
addrTxt

data AddressInfo = AddressInfo
  { AddressInfo -> Text
aiType :: !Text
  , AddressInfo -> Text
aiEra :: !Text
  , AddressInfo -> Text
aiEncoding :: !Text
  , AddressInfo -> Text
aiAddress :: !Text
  , AddressInfo -> Text
aiBase16 :: !Text
  }

instance ToJSON AddressInfo where
  toJSON :: AddressInfo -> Value
toJSON AddressInfo
addrInfo =
    [Pair] -> Value
object
      [ Text
"type" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= AddressInfo -> Text
aiType AddressInfo
addrInfo
      , Text
"era" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= AddressInfo -> Text
aiEra AddressInfo
addrInfo
      , Text
"encoding" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= AddressInfo -> Text
aiEncoding AddressInfo
addrInfo
      , Text
"address" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= AddressInfo -> Text
aiAddress AddressInfo
addrInfo
      , Text
"base16" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= AddressInfo -> Text
aiBase16 AddressInfo
addrInfo
      ]

runAddressInfo :: Text -> Maybe OutputFile -> ExceptT ShelleyAddressInfoError IO ()
runAddressInfo :: Text -> Maybe OutputFile -> ExceptT ShelleyAddressInfoError IO ()
runAddressInfo Text
addrTxt Maybe OutputFile
mOutputFp = do
    AddressInfo
addrInfo <- case (AddressAny -> Either AddressAny StakeAddress
forall a b. a -> Either a b
Left  (AddressAny -> Either AddressAny StakeAddress)
-> Maybe AddressAny -> Maybe (Either AddressAny StakeAddress)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AsType AddressAny -> Text -> Maybe AddressAny
forall addr.
SerialiseAddress addr =>
AsType addr -> Text -> Maybe addr
deserialiseAddress AsType AddressAny
AsAddressAny Text
addrTxt)
                 Maybe (Either AddressAny StakeAddress)
-> Maybe (Either AddressAny StakeAddress)
-> Maybe (Either AddressAny StakeAddress)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (StakeAddress -> Either AddressAny StakeAddress
forall a b. b -> Either a b
Right (StakeAddress -> Either AddressAny StakeAddress)
-> Maybe StakeAddress -> Maybe (Either AddressAny StakeAddress)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AsType StakeAddress -> Text -> Maybe StakeAddress
forall addr.
SerialiseAddress addr =>
AsType addr -> Text -> Maybe addr
deserialiseAddress AsType StakeAddress
AsStakeAddress Text
addrTxt) of

      Maybe (Either AddressAny StakeAddress)
Nothing ->
        ShelleyAddressInfoError
-> ExceptT ShelleyAddressInfoError IO AddressInfo
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (ShelleyAddressInfoError
 -> ExceptT ShelleyAddressInfoError IO AddressInfo)
-> ShelleyAddressInfoError
-> ExceptT ShelleyAddressInfoError IO AddressInfo
forall a b. (a -> b) -> a -> b
$ Text -> ShelleyAddressInfoError
ShelleyAddressInvalid Text
addrTxt

      Just (Left (AddressByron Address ByronAddr
payaddr)) ->
            AddressInfo -> ExceptT ShelleyAddressInfoError IO AddressInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AddressInfo -> ExceptT ShelleyAddressInfoError IO AddressInfo)
-> AddressInfo -> ExceptT ShelleyAddressInfoError IO AddressInfo
forall a b. (a -> b) -> a -> b
$ AddressInfo :: Text -> Text -> Text -> Text -> Text -> AddressInfo
AddressInfo
              { aiType :: Text
aiType = Text
"payment"
              , aiEra :: Text
aiEra = Text
"byron"
              , aiEncoding :: Text
aiEncoding = Text
"base58"
              , aiAddress :: Text
aiAddress = Text
addrTxt
              , aiBase16 :: Text
aiBase16 = Address ByronAddr -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText Address ByronAddr
payaddr
              }

      Just (Left (AddressShelley Address ShelleyAddr
payaddr)) ->
            AddressInfo -> ExceptT ShelleyAddressInfoError IO AddressInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AddressInfo -> ExceptT ShelleyAddressInfoError IO AddressInfo)
-> AddressInfo -> ExceptT ShelleyAddressInfoError IO AddressInfo
forall a b. (a -> b) -> a -> b
$ AddressInfo :: Text -> Text -> Text -> Text -> Text -> AddressInfo
AddressInfo
              { aiType :: Text
aiType = Text
"payment"
              , aiEra :: Text
aiEra = Text
"shelley"
              , aiEncoding :: Text
aiEncoding = Text
"bech32"
              , aiAddress :: Text
aiAddress = Text
addrTxt
              , aiBase16 :: Text
aiBase16 = Address ShelleyAddr -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText Address ShelleyAddr
payaddr
              }

      Just (Right StakeAddress
addr) ->
        AddressInfo -> ExceptT ShelleyAddressInfoError IO AddressInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AddressInfo -> ExceptT ShelleyAddressInfoError IO AddressInfo)
-> AddressInfo -> ExceptT ShelleyAddressInfoError IO AddressInfo
forall a b. (a -> b) -> a -> b
$ AddressInfo :: Text -> Text -> Text -> Text -> Text -> AddressInfo
AddressInfo
          { aiType :: Text
aiType = Text
"stake"
          , aiEra :: Text
aiEra = Text
"shelley"
          , aiEncoding :: Text
aiEncoding = Text
"bech32"
          , aiAddress :: Text
aiAddress = Text
addrTxt
          , aiBase16 :: Text
aiBase16 = StakeAddress -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText StakeAddress
addr
          }

    case Maybe OutputFile
mOutputFp of
      Just (OutputFile String
fpath) -> IO () -> ExceptT ShelleyAddressInfoError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyAddressInfoError IO ())
-> IO () -> ExceptT ShelleyAddressInfoError IO ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> IO ()
LBS.writeFile String
fpath (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ AddressInfo -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty AddressInfo
addrInfo
      Maybe OutputFile
Nothing -> IO () -> ExceptT ShelleyAddressInfoError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyAddressInfoError IO ())
-> IO () -> ExceptT ShelleyAddressInfoError IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
LBS.putStrLn (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ AddressInfo -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty AddressInfo
addrInfo