Give DTOs explicit types

marlowe-dashboard-client/generated/Marlowe.purs

@@ -23,7 +23,8 @@ import Data.Maybe (Maybe(..))
 import Data.Newtype (unwrap)
 import Data.String (joinWith)
 import Effect.Aff.Class (class MonadAff, liftAff)
-import Marlowe.Run.Wallet.API (GetTotalFundsDto)
+import Marlowe.Run.Dto (WalletIdDto)
+import Marlowe.Run.Wallet.API (GetTotalFundsResponse)
 import Marlowe.Run.Wallet.CentralizedTestnet.Types
   ( CheckPostData
   , RestoreError
@@ -106,8 +107,8 @@ getApiWalletByWalletidGettotalfunds
   => MonadAsk env m
   => MonadError AjaxError m
   => MonadAff m
-  => String
-  -> m GetTotalFundsDto
+  => WalletIdDto
+  -> m GetTotalFundsResponse
 getApiWalletByWalletidGettotalfunds wallet_id = do
   spSettings <- asks spSettings
   let baseURL = spSettings.baseURL

marlowe-dashboard-client/generated/Marlowe/Run/Dto.purs

@@ -0,0 +1,121 @@
+-- File auto generated by purescript-bridge! --
+module Marlowe.Run.Dto where
+
+import Prelude
+
+import Control.Lazy (defer)
+import Data.Argonaut.Core (jsonNull)
+import Data.Argonaut.Decode (class DecodeJson)
+import Data.Argonaut.Decode.Aeson ((</$\>), (</*\>), (</\>))
+import Data.Argonaut.Decode.Aeson as D
+import Data.Argonaut.Encode (class EncodeJson, encodeJson)
+import Data.Argonaut.Encode.Aeson ((>$<), (>/\<))
+import Data.Argonaut.Encode.Aeson as E
+import Data.BigInt.Argonaut (BigInt)
+import Data.Generic.Rep (class Generic)
+import Data.Lens (Iso', Lens', Prism', iso, prism')
+import Data.Lens.Iso.Newtype (_Newtype)
+import Data.Lens.Record (prop)
+import Data.Map (Map)
+import Data.Map as Map
+import Data.Maybe (Maybe(..))
+import Data.Newtype (class Newtype, unwrap)
+import Data.Show.Generic (genericShow)
+import Data.Tuple.Nested ((/\))
+import Type.Proxy (Proxy(Proxy))
+
+newtype CurrencySymbolDto = CurrencySymbolDto String
+
+derive instance eqCurrencySymbolDto :: Eq CurrencySymbolDto
+
+instance showCurrencySymbolDto :: Show CurrencySymbolDto where
+  show a = genericShow a
+
+instance encodeJsonCurrencySymbolDto :: EncodeJson CurrencySymbolDto where
+  encodeJson = defer \_ -> E.encode $ unwrap >$< E.value
+
+instance decodeJsonCurrencySymbolDto :: DecodeJson CurrencySymbolDto where
+  decodeJson = defer \_ -> D.decode $ (CurrencySymbolDto <$> D.value)
+
+derive instance genericCurrencySymbolDto :: Generic CurrencySymbolDto _
+
+derive instance newtypeCurrencySymbolDto :: Newtype CurrencySymbolDto _
+
+--------------------------------------------------------------------------------
+
+_CurrencySymbolDto :: Iso' CurrencySymbolDto String
+_CurrencySymbolDto = _Newtype
+
+--------------------------------------------------------------------------------
+
+newtype TokenNameDto = TokenNameDto String
+
+derive instance eqTokenNameDto :: Eq TokenNameDto
+
+instance showTokenNameDto :: Show TokenNameDto where
+  show a = genericShow a
+
+instance encodeJsonTokenNameDto :: EncodeJson TokenNameDto where
+  encodeJson = defer \_ -> E.encode $ unwrap >$< E.value
+
+instance decodeJsonTokenNameDto :: DecodeJson TokenNameDto where
+  decodeJson = defer \_ -> D.decode $ (TokenNameDto <$> D.value)
+
+derive instance genericTokenNameDto :: Generic TokenNameDto _
+
+derive instance newtypeTokenNameDto :: Newtype TokenNameDto _
+
+--------------------------------------------------------------------------------
+
+_TokenNameDto :: Iso' TokenNameDto String
+_TokenNameDto = _Newtype
+
+--------------------------------------------------------------------------------
+
+newtype WalletIdDto = WalletIdDto String
+
+derive instance eqWalletIdDto :: Eq WalletIdDto
+
+instance showWalletIdDto :: Show WalletIdDto where
+  show a = genericShow a
+
+instance encodeJsonWalletIdDto :: EncodeJson WalletIdDto where
+  encodeJson = defer \_ -> E.encode $ unwrap >$< E.value
+
+instance decodeJsonWalletIdDto :: DecodeJson WalletIdDto where
+  decodeJson = defer \_ -> D.decode $ (WalletIdDto <$> D.value)
+
+derive instance genericWalletIdDto :: Generic WalletIdDto _
+
+derive instance newtypeWalletIdDto :: Newtype WalletIdDto _
+
+--------------------------------------------------------------------------------
+
+_WalletIdDto :: Iso' WalletIdDto String
+_WalletIdDto = _Newtype
+
+--------------------------------------------------------------------------------
+
+newtype AssetsDto = AssetsDto (Map CurrencySymbolDto (Map TokenNameDto BigInt))
+
+derive instance eqAssetsDto :: Eq AssetsDto
+
+instance showAssetsDto :: Show AssetsDto where
+  show a = genericShow a
+
+instance encodeJsonAssetsDto :: EncodeJson AssetsDto where
+  encodeJson = defer \_ -> E.encode $ unwrap >$<
+    (E.dictionary E.value (E.dictionary E.value E.value))
+
+instance decodeJsonAssetsDto :: DecodeJson AssetsDto where
+  decodeJson = defer \_ -> D.decode $
+    (AssetsDto <$> (D.dictionary D.value (D.dictionary D.value D.value)))
+
+derive instance genericAssetsDto :: Generic AssetsDto _
+
+derive instance newtypeAssetsDto :: Newtype AssetsDto _
+
+--------------------------------------------------------------------------------
+
+_AssetsDto :: Iso' AssetsDto (Map CurrencySymbolDto (Map TokenNameDto BigInt))
+_AssetsDto = _Newtype

marlowe-dashboard-client/generated/Marlowe/Run/Wallet/API.purs

@@ -11,55 +11,50 @@ import Data.Argonaut.Decode.Aeson as D
 import Data.Argonaut.Encode (class EncodeJson, encodeJson)
 import Data.Argonaut.Encode.Aeson ((>$<), (>/\<))
 import Data.Argonaut.Encode.Aeson as E
-import Data.BigInt.Argonaut (BigInt)
 import Data.Generic.Rep (class Generic)
 import Data.Lens (Iso', Lens', Prism', iso, prism')
 import Data.Lens.Iso.Newtype (_Newtype)
 import Data.Lens.Record (prop)
-import Data.Map (Map)
 import Data.Map as Map
 import Data.Maybe (Maybe(..))
 import Data.Newtype (class Newtype, unwrap)
 import Data.Show.Generic (genericShow)
 import Data.Tuple.Nested ((/\))
+import Marlowe.Run.Dto (AssetsDto)
 import Type.Proxy (Proxy(Proxy))
 
-newtype GetTotalFundsDto = GetTotalFundsDto
-  { assets :: Map String (Map String BigInt)
+newtype GetTotalFundsResponse = GetTotalFundsResponse
+  { assets :: AssetsDto
   , sync :: Number
   }
 
-derive instance eqGetTotalFundsDto :: Eq GetTotalFundsDto
+derive instance eqGetTotalFundsResponse :: Eq GetTotalFundsResponse
 
-instance showGetTotalFundsDto :: Show GetTotalFundsDto where
+instance showGetTotalFundsResponse :: Show GetTotalFundsResponse where
   show a = genericShow a
 
-instance encodeJsonGetTotalFundsDto :: EncodeJson GetTotalFundsDto where
+instance encodeJsonGetTotalFundsResponse :: EncodeJson GetTotalFundsResponse where
   encodeJson = defer \_ -> E.encode $ unwrap >$<
     ( E.record
-        { assets:
-            (E.dictionary E.value (E.dictionary E.value E.value)) :: _
-              (Map String (Map String BigInt))
+        { assets: E.value :: _ AssetsDto
         , sync: E.value :: _ Number
         }
     )
 
-instance decodeJsonGetTotalFundsDto :: DecodeJson GetTotalFundsDto where
+instance decodeJsonGetTotalFundsResponse :: DecodeJson GetTotalFundsResponse where
   decodeJson = defer \_ -> D.decode $
-    ( GetTotalFundsDto <$> D.record "GetTotalFundsDto"
-        { assets:
-            (D.dictionary D.value (D.dictionary D.value D.value)) :: _
-              (Map String (Map String BigInt))
+    ( GetTotalFundsResponse <$> D.record "GetTotalFundsResponse"
+        { assets: D.value :: _ AssetsDto
         , sync: D.value :: _ Number
         }
     )
 
-derive instance genericGetTotalFundsDto :: Generic GetTotalFundsDto _
+derive instance genericGetTotalFundsResponse :: Generic GetTotalFundsResponse _
 
-derive instance newtypeGetTotalFundsDto :: Newtype GetTotalFundsDto _
+derive instance newtypeGetTotalFundsResponse :: Newtype GetTotalFundsResponse _
 
 --------------------------------------------------------------------------------
 
-_GetTotalFundsDto :: Iso' GetTotalFundsDto
-  { assets :: Map String (Map String BigInt), sync :: Number }
-_GetTotalFundsDto = _Newtype
+_GetTotalFundsResponse :: Iso' GetTotalFundsResponse
+  { assets :: AssetsDto, sync :: Number }
+_GetTotalFundsResponse = _Newtype

marlowe-dashboard-server/app/PSGenerator.hs

@@ -7,7 +7,6 @@
 {-# LANGUAGE ScopedTypeVariables   #-}
 {-# LANGUAGE TypeApplications      #-}
 {-# LANGUAGE TypeFamilies          #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module PSGenerator
   ( generate,
@@ -20,12 +19,13 @@ import Data.Monoid ()
 import Data.Proxy (Proxy (Proxy))
 import qualified Data.Text.Encoding as T ()
 import qualified Data.Text.IO as T ()
-import Language.PureScript.Bridge (BridgePart, Language (Haskell), SumType, argonaut, buildBridge, typeModule, typeName,
+import Language.PureScript.Bridge (BridgePart, Language (Haskell), SumType, argonaut, buildBridge, typeName,
                                    writePSTypes, (^==))
 import Language.PureScript.Bridge.PSTypes (psNumber, psString)
 import Language.PureScript.Bridge.SumType (equal, genericShow, mkSumType, order)
 import Marlowe.Run.API (HTTPAPI)
-import Marlowe.Run.Wallet.API (GetTotalFundsDto)
+import Marlowe.Run.Dto
+import Marlowe.Run.Wallet.API (GetTotalFundsResponse)
 import Marlowe.Run.Wallet.CentralizedTestnet.Types (CheckPostData, RestoreError, RestorePostData)
 import Marlowe.Run.WebSocket (StreamToClient, StreamToServer)
 import qualified PSGenerator.Common
@@ -37,21 +37,6 @@ doubleBridge = typeName ^== "Double" >> return psNumber
 dayBridge :: BridgePart
 dayBridge = typeName ^== "Day" >> return psString
 
-currencySymbolBridge :: BridgePart
-currencySymbolBridge = do
-  typeName ^== "CurrencySymbolDto"
-  typeModule ^== "Marlowe.Run.Types"
-  pure psString
-
-tokenNameBridge :: BridgePart
-tokenNameBridge = do
-  typeName ^== "TokenNameDto"
-  typeModule ^== "Marlowe.Run.Types"
-  pure psString
-
-dtoBridge :: BridgePart
-dtoBridge = currencySymbolBridge <|> tokenNameBridge
-
 myBridge :: BridgePart
 myBridge =
   PSGenerator.Common.aesonBridge <|> PSGenerator.Common.containersBridge
@@ -62,7 +47,6 @@ myBridge =
     <|> doubleBridge
     <|> dayBridge
     <|> defaultBridge
-    <|> dtoBridge
 
 data MyBridge
 
@@ -72,20 +56,31 @@ myBridgeProxy = Proxy
 instance HasBridge MyBridge where
   languageBridge _ = buildBridge myBridge
 
+dto :: SumType 'Haskell -> SumType 'Haskell
+dto = equal . genericShow . argonaut
+
+-- FIXME: remove all of this shared stuff from plutus-apps. We should only be
+-- exporting API types to PureScript, and those should all be defined
+-- internally in this project. With a multi-repo setup, there is far too much
+-- potential for breakage with updates.
 myTypes :: [SumType 'Haskell]
 myTypes =
     PSGenerator.Common.ledgerTypes <>
     PSGenerator.Common.walletTypes <>
-    -- FIXME: this includes the EndpointDescription, probably they should be sepparated from the playground
     PSGenerator.Common.playgroundTypes <>
-
-  [ equal . genericShow . argonaut $ mkSumType @StreamToServer,
-    equal . genericShow . argonaut $ mkSumType @StreamToClient,
-    equal . order . genericShow . argonaut $ mkSumType @RestoreError,
-    equal . genericShow . argonaut $ mkSumType @RestorePostData,
-    equal . genericShow . argonaut $ mkSumType @CheckPostData,
-    equal . genericShow . argonaut $ mkSumType @GetTotalFundsDto
-  ]
+    ( dto <$>
+      [ mkSumType @StreamToServer,
+        mkSumType @StreamToClient,
+        mkSumType @RestorePostData,
+        mkSumType @CheckPostData,
+        mkSumType @GetTotalFundsResponse,
+        mkSumType @CurrencySymbolDto,
+        mkSumType @TokenNameDto,
+        mkSumType @WalletIdDto,
+        mkSumType @AssetsDto,
+        order . mkSumType @RestoreError
+      ]
+    )
 
 mySettings :: Settings
 mySettings = defaultSettings & set apiModuleName "Marlowe"

marlowe-dashboard-server/marlowe-dashboard-server.cabal

@@ -21,6 +21,7 @@ library
         Marlowe.Run
         Marlowe.Run.Server
         Marlowe.Run.API
+        Marlowe.Run.Dto
         Marlowe.Run.Wallet.API
         Marlowe.Run.WebSocket
         Marlowe.Run.Types