API smart constructors

src/Cardano/Wallet/Api/Types.hs

@@ -7,7 +7,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
-{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -36,6 +36,17 @@ module Cardano.Wallet.Api.Types
     , WalletPutData (..)
     , WalletPutPassphraseData (..)
 
+    -- * Encoding & Decoding
+    , DecodeApiAddressError (..)
+    , decodeApiAddress
+    , encodeApiAddress
+    , DecodeApiEncryptionPassphraseError (..)
+    , decodeApiEncryptionPassphrase
+    , encodeApiEncryptionPassphrase
+    , DecodeApiWalletNameError (..)
+    , decodeApiWalletName
+    , encodeApiWalletName
+
     -- * Limits
     , passphraseMinLength
     , passphraseMaxLength
@@ -45,6 +56,8 @@ module Cardano.Wallet.Api.Types
     -- * Polymorphic Types
     , ApiT (..)
     , ApiMnemonicT (..)
+    , MkApiMnemonic (..)
+    , MkApiMnemonicError (..)
     , getApiMnemonicT
     ) where
 
@@ -73,8 +86,6 @@ import Cardano.Wallet.Primitive.Types
     , WalletPassphraseInfo (..)
     , WalletState (..)
     )
-import Control.Applicative
-    ( (<|>) )
 import Control.Monad
     ( (>=>) )
 import Data.Aeson
@@ -89,6 +100,8 @@ import Data.Aeson
     , omitNothingFields
     , sumEncoding
     )
+import Data.Bifunctor
+    ( first )
 import Data.ByteString.Base58
     ( bitcoinAlphabet, decodeBase58, encodeBase58 )
 import Data.Text
@@ -194,15 +207,29 @@ instance ToJSON (ApiT AddressState) where
     toJSON = genericToJSON defaultSumTypeOptions . getApiT
 
 instance FromJSON (ApiT Address) where
-    parseJSON bytes = do
-        x <- parseJSON bytes
-        maybe
-           (fail "Unable to decode Address: expected Base58 encoding")
-           (pure . ApiT . Address)
-           (decodeBase58 bitcoinAlphabet $ T.encodeUtf8 x)
-instance ToJSON (ApiT Address )where
-    toJSON = toJSON
-        . T.decodeUtf8 . encodeBase58 bitcoinAlphabet . getAddress . getApiT
+    parseJSON = parseJSON >=> eitherToParser . decodeApiAddress
+instance ToJSON (ApiT Address) where
+    toJSON = toJSON . encodeApiAddress
+
+-- | Constructs an address from a Base58-encoded string.
+--
+-- Fails if the specified string is not Base58 encoded.
+--
+decodeApiAddress :: Text -> Either DecodeApiAddressError (ApiT Address)
+decodeApiAddress x = maybe
+    (Left $ DecodeApiAddressError
+        "Unable to decode Address: expected Base58 encoding")
+    (pure . ApiT . Address)
+    (decodeBase58 bitcoinAlphabet $ T.encodeUtf8 x)
+
+-- | Converts an address to a Base58-encoded string.
+--
+encodeApiAddress :: ApiT Address -> Text
+encodeApiAddress =
+    T.decodeUtf8 . encodeBase58 bitcoinAlphabet . getAddress . getApiT
+
+newtype DecodeApiAddressError = DecodeApiAddressError String
+    deriving Show
 
 instance FromJSON ApiWallet where
     parseJSON = genericParseJSON defaultRecordTypeOptions
@@ -225,52 +252,78 @@ instance ToJSON  WalletPutPassphraseData where
     toJSON = genericToJSON defaultRecordTypeOptions
 
 instance FromJSON (ApiT (Passphrase "encryption")) where
-    parseJSON = parseJSON >=> \case
-        t | T.length t < passphraseMinLength ->
-            fail $ "passphrase is too short: expected at least "
-                <> show passphraseMinLength <> " chars"
-        t | T.length t > passphraseMaxLength ->
-            fail $ "passphrase is too long: expected at most "
-                <> show passphraseMaxLength <> " chars"
-        t ->
-            return $ ApiT $ Passphrase $ BA.convert $ T.encodeUtf8 t
+    parseJSON = parseJSON >=> eitherToParser . decodeApiEncryptionPassphrase
 instance ToJSON (ApiT (Passphrase "encryption")) where
-    toJSON (ApiT (Passphrase bytes)) = toJSON $ T.decodeUtf8 $ BA.convert bytes
+    toJSON = toJSON . encodeApiEncryptionPassphrase
+
+decodeApiEncryptionPassphrase
+    :: Text
+    -> Either DecodeApiEncryptionPassphraseError
+        (ApiT (Passphrase "encryption"))
+decodeApiEncryptionPassphrase t
+    | T.length t < passphraseMinLength =
+        Left $ DecodeApiEncryptionPassphraseError $
+            "passphrase is too short: expected at least "
+            <> show passphraseMinLength <> " chars"
+    | T.length t > passphraseMaxLength =
+        Left $ DecodeApiEncryptionPassphraseError $
+            "passphrase is too long: expected at most "
+            <> show passphraseMaxLength <> " chars"
+    | otherwise =
+        pure $ ApiT $ Passphrase $ BA.convert $ T.encodeUtf8 t
+
+encodeApiEncryptionPassphrase :: ApiT (Passphrase "encryption") -> Text
+encodeApiEncryptionPassphrase (ApiT (Passphrase bytes)) =
+    T.decodeUtf8 $ BA.convert bytes
 
 passphraseMinLength :: Int
 passphraseMinLength = 10
 
 passphraseMaxLength :: Int
 passphraseMaxLength = 255
 
+newtype DecodeApiEncryptionPassphraseError
+    = DecodeApiEncryptionPassphraseError String
+    deriving Show
+
+class MkApiMnemonic sizes purpose where
+    mkApiMnemonic
+        :: [Text] -> Either MkApiMnemonicError (ApiMnemonicT sizes purpose)
+
+newtype MkApiMnemonicError = MkApiMnemonicError String
+    deriving Show
+
 instance {-# OVERLAPS #-}
     ( n ~ EntropySize mw
     , csz ~ CheckSumBits n
     , ConsistentEntropy n mw csz
-    , FromJSON (ApiMnemonicT rest purpose)
+    , MkApiMnemonic rest purpose
     ) =>
-    FromJSON (ApiMnemonicT (mw ': rest) purpose)
+    MkApiMnemonic (mw ': rest) purpose
   where
-    parseJSON bytes = parseMW <|> parseRest where
+    mkApiMnemonic parts = either (const parseRest) Right parseMW where
         parseMW = do
-            ApiMnemonicT x <- parseJSON @(ApiMnemonicT '[mw] purpose) bytes
+            ApiMnemonicT x <- mkApiMnemonic @'[mw] @purpose parts
             return $ ApiMnemonicT x
         parseRest = do
-            ApiMnemonicT x <- parseJSON @(ApiMnemonicT rest purpose) bytes
+            ApiMnemonicT x <- mkApiMnemonic @rest @purpose parts
             return $ ApiMnemonicT x
 
 instance
     ( n ~ EntropySize mw
     , csz ~ CheckSumBits n
     , ConsistentEntropy n mw csz
     ) =>
-    FromJSON (ApiMnemonicT (mw ': '[]) purpose)
+    MkApiMnemonic (mw ': '[]) purpose
   where
-    parseJSON bytes = do
-        xs <- parseJSON bytes
-        m <- eitherToParser $ mkMnemonic @mw xs
+    mkApiMnemonic parts = do
+        m <- first (MkApiMnemonicError . show) (mkMnemonic @mw parts)
         let pwd = Passphrase $ entropyToBytes $ mnemonicToEntropy m
-        return $ ApiMnemonicT (pwd, xs)
+        return $ ApiMnemonicT (pwd, parts)
+
+instance MkApiMnemonic sizes purpose => FromJSON (ApiMnemonicT sizes purpose)
+  where
+    parseJSON = parseJSON >=> eitherToParser . mkApiMnemonic @sizes @purpose
 
 instance ToJSON (ApiMnemonicT sizes purpose) where
     toJSON (ApiMnemonicT (!_, xs)) = toJSON xs
@@ -298,17 +351,29 @@ instance ToJSON (ApiT (WalletDelegation (ApiT PoolId))) where
     toJSON = genericToJSON walletDelegationOptions . getApiT
 
 instance FromJSON (ApiT WalletName) where
-    parseJSON = parseJSON >=> \case
-        t | T.length t < walletNameMinLength ->
-            fail $ "name is too short: expected at least "
+    parseJSON = parseJSON >=> eitherToParser . decodeApiWalletName
+instance ToJSON (ApiT WalletName) where
+    toJSON = toJSON . encodeApiWalletName
+
+decodeApiWalletName :: Text -> Either DecodeApiWalletNameError (ApiT WalletName)
+decodeApiWalletName t
+    | T.length t < walletNameMinLength =
+        Left $ DecodeApiWalletNameError $
+            "name is too short: expected at least "
                 <> show walletNameMinLength <> " chars"
-        t | T.length t > walletNameMaxLength ->
-            fail $ "name is too long: expected at most "
+    | T.length t > walletNameMaxLength =
+        Left $ DecodeApiWalletNameError $
+            "name is too long: expected at most "
                 <> show walletNameMaxLength <> " chars"
-        t ->
-            return $ ApiT $ WalletName t
-instance ToJSON (ApiT WalletName) where
-    toJSON = toJSON . getWalletName . getApiT
+    | otherwise =
+        return $ ApiT $ WalletName t
+
+encodeApiWalletName :: ApiT WalletName -> Text
+encodeApiWalletName = getWalletName . getApiT
+
+newtype DecodeApiWalletNameError
+    = DecodeApiWalletNameError String
+    deriving Show
 
 walletNameMinLength :: Int
 walletNameMinLength = 1