{-# LANGUAGE DeriveAnyClass  #-}
{-# LANGUAGE DerivingVia     #-}
{-# LANGUAGE TemplateHaskell #-}

module Cardano.Wallet.Types
    ( -- * Wallet configuration
      WalletConfig (..)
    , LocalWalletSettings (..)
    , WalletUrl (..)
    , defaultWalletConfig
      -- * Lens and Prisms
    , walletSettingsL
    , baseUrlL
    , _LocalWalletConfig
    , _RemoteWalletConfig
    ) where

import Control.Lens (Lens', Traversal', lens, makePrisms)
import Data.Aeson (FromJSON, ToJSON)
import Data.Default (Default (def))
import GHC.Generics (Generic)
import Servant.Client (BaseUrl (BaseUrl), Scheme (Http))

data WalletConfig =
      LocalWalletConfig { WalletConfig -> LocalWalletSettings
walletSettings :: LocalWalletSettings }
    | RemoteWalletConfig
    deriving (Int -> WalletConfig -> ShowS
[WalletConfig] -> ShowS
WalletConfig -> String
(Int -> WalletConfig -> ShowS)
-> (WalletConfig -> String)
-> ([WalletConfig] -> ShowS)
-> Show WalletConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WalletConfig] -> ShowS
$cshowList :: [WalletConfig] -> ShowS
show :: WalletConfig -> String
$cshow :: WalletConfig -> String
showsPrec :: Int -> WalletConfig -> ShowS
$cshowsPrec :: Int -> WalletConfig -> ShowS
Show, WalletConfig -> WalletConfig -> Bool
(WalletConfig -> WalletConfig -> Bool)
-> (WalletConfig -> WalletConfig -> Bool) -> Eq WalletConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WalletConfig -> WalletConfig -> Bool
$c/= :: WalletConfig -> WalletConfig -> Bool
== :: WalletConfig -> WalletConfig -> Bool
$c== :: WalletConfig -> WalletConfig -> Bool
Eq, (forall x. WalletConfig -> Rep WalletConfig x)
-> (forall x. Rep WalletConfig x -> WalletConfig)
-> Generic WalletConfig
forall x. Rep WalletConfig x -> WalletConfig
forall x. WalletConfig -> Rep WalletConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WalletConfig x -> WalletConfig
$cfrom :: forall x. WalletConfig -> Rep WalletConfig x
Generic)
    deriving anyclass (Value -> Parser [WalletConfig]
Value -> Parser WalletConfig
(Value -> Parser WalletConfig)
-> (Value -> Parser [WalletConfig]) -> FromJSON WalletConfig
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [WalletConfig]
$cparseJSONList :: Value -> Parser [WalletConfig]
parseJSON :: Value -> Parser WalletConfig
$cparseJSON :: Value -> Parser WalletConfig
FromJSON, [WalletConfig] -> Encoding
[WalletConfig] -> Value
WalletConfig -> Encoding
WalletConfig -> Value
(WalletConfig -> Value)
-> (WalletConfig -> Encoding)
-> ([WalletConfig] -> Value)
-> ([WalletConfig] -> Encoding)
-> ToJSON WalletConfig
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [WalletConfig] -> Encoding
$ctoEncodingList :: [WalletConfig] -> Encoding
toJSONList :: [WalletConfig] -> Value
$ctoJSONList :: [WalletConfig] -> Value
toEncoding :: WalletConfig -> Encoding
$ctoEncoding :: WalletConfig -> Encoding
toJSON :: WalletConfig -> Value
$ctoJSON :: WalletConfig -> Value
ToJSON)

instance Default WalletConfig where
  def :: WalletConfig
def = WalletConfig
defaultWalletConfig

defaultWalletConfig :: WalletConfig
defaultWalletConfig :: WalletConfig
defaultWalletConfig =
  LocalWalletSettings -> WalletConfig
LocalWalletConfig (LocalWalletSettings -> WalletConfig)
-> LocalWalletSettings -> WalletConfig
forall a b. (a -> b) -> a -> b
$ LocalWalletSettings :: WalletUrl -> LocalWalletSettings
LocalWalletSettings
    -- See Note [pab-ports] in "test/full/Plutus/PAB/CliSpec.hs".
    { baseUrl :: WalletUrl
baseUrl = BaseUrl -> WalletUrl
WalletUrl (BaseUrl -> WalletUrl) -> BaseUrl -> WalletUrl
forall a b. (a -> b) -> a -> b
$ Scheme -> String -> Int -> String -> BaseUrl
BaseUrl Scheme
Http String
"localhost" Int
9081 String
""
    }

walletSettingsL :: Traversal' WalletConfig LocalWalletSettings
walletSettingsL :: (LocalWalletSettings -> f LocalWalletSettings)
-> WalletConfig -> f WalletConfig
walletSettingsL LocalWalletSettings -> f LocalWalletSettings
f (LocalWalletConfig LocalWalletSettings
settings) =
    (\LocalWalletSettings
settings' -> LocalWalletSettings -> WalletConfig
LocalWalletConfig LocalWalletSettings
settings') (LocalWalletSettings -> WalletConfig)
-> f LocalWalletSettings -> f WalletConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LocalWalletSettings -> f LocalWalletSettings
f LocalWalletSettings
settings
walletSettingsL LocalWalletSettings -> f LocalWalletSettings
_ c :: WalletConfig
c@RemoteWalletConfig {} = WalletConfig -> f WalletConfig
forall (f :: * -> *) a. Applicative f => a -> f a
pure WalletConfig
c

newtype LocalWalletSettings = LocalWalletSettings { LocalWalletSettings -> WalletUrl
baseUrl :: WalletUrl }
    deriving (Int -> LocalWalletSettings -> ShowS
[LocalWalletSettings] -> ShowS
LocalWalletSettings -> String
(Int -> LocalWalletSettings -> ShowS)
-> (LocalWalletSettings -> String)
-> ([LocalWalletSettings] -> ShowS)
-> Show LocalWalletSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LocalWalletSettings] -> ShowS
$cshowList :: [LocalWalletSettings] -> ShowS
show :: LocalWalletSettings -> String
$cshow :: LocalWalletSettings -> String
showsPrec :: Int -> LocalWalletSettings -> ShowS
$cshowsPrec :: Int -> LocalWalletSettings -> ShowS
Show, LocalWalletSettings -> LocalWalletSettings -> Bool
(LocalWalletSettings -> LocalWalletSettings -> Bool)
-> (LocalWalletSettings -> LocalWalletSettings -> Bool)
-> Eq LocalWalletSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LocalWalletSettings -> LocalWalletSettings -> Bool
$c/= :: LocalWalletSettings -> LocalWalletSettings -> Bool
== :: LocalWalletSettings -> LocalWalletSettings -> Bool
$c== :: LocalWalletSettings -> LocalWalletSettings -> Bool
Eq, (forall x. LocalWalletSettings -> Rep LocalWalletSettings x)
-> (forall x. Rep LocalWalletSettings x -> LocalWalletSettings)
-> Generic LocalWalletSettings
forall x. Rep LocalWalletSettings x -> LocalWalletSettings
forall x. LocalWalletSettings -> Rep LocalWalletSettings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LocalWalletSettings x -> LocalWalletSettings
$cfrom :: forall x. LocalWalletSettings -> Rep LocalWalletSettings x
Generic)
    deriving anyclass (Value -> Parser [LocalWalletSettings]
Value -> Parser LocalWalletSettings
(Value -> Parser LocalWalletSettings)
-> (Value -> Parser [LocalWalletSettings])
-> FromJSON LocalWalletSettings
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [LocalWalletSettings]
$cparseJSONList :: Value -> Parser [LocalWalletSettings]
parseJSON :: Value -> Parser LocalWalletSettings
$cparseJSON :: Value -> Parser LocalWalletSettings
FromJSON, [LocalWalletSettings] -> Encoding
[LocalWalletSettings] -> Value
LocalWalletSettings -> Encoding
LocalWalletSettings -> Value
(LocalWalletSettings -> Value)
-> (LocalWalletSettings -> Encoding)
-> ([LocalWalletSettings] -> Value)
-> ([LocalWalletSettings] -> Encoding)
-> ToJSON LocalWalletSettings
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [LocalWalletSettings] -> Encoding
$ctoEncodingList :: [LocalWalletSettings] -> Encoding
toJSONList :: [LocalWalletSettings] -> Value
$ctoJSONList :: [LocalWalletSettings] -> Value
toEncoding :: LocalWalletSettings -> Encoding
$ctoEncoding :: LocalWalletSettings -> Encoding
toJSON :: LocalWalletSettings -> Value
$ctoJSON :: LocalWalletSettings -> Value
ToJSON)

newtype WalletUrl = WalletUrl BaseUrl
    deriving (WalletUrl -> WalletUrl -> Bool
(WalletUrl -> WalletUrl -> Bool)
-> (WalletUrl -> WalletUrl -> Bool) -> Eq WalletUrl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WalletUrl -> WalletUrl -> Bool
$c/= :: WalletUrl -> WalletUrl -> Bool
== :: WalletUrl -> WalletUrl -> Bool
$c== :: WalletUrl -> WalletUrl -> Bool
Eq, Int -> WalletUrl -> ShowS
[WalletUrl] -> ShowS
WalletUrl -> String
(Int -> WalletUrl -> ShowS)
-> (WalletUrl -> String)
-> ([WalletUrl] -> ShowS)
-> Show WalletUrl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WalletUrl] -> ShowS
$cshowList :: [WalletUrl] -> ShowS
show :: WalletUrl -> String
$cshow :: WalletUrl -> String
showsPrec :: Int -> WalletUrl -> ShowS
$cshowsPrec :: Int -> WalletUrl -> ShowS
Show, [WalletUrl] -> Encoding
[WalletUrl] -> Value
WalletUrl -> Encoding
WalletUrl -> Value
(WalletUrl -> Value)
-> (WalletUrl -> Encoding)
-> ([WalletUrl] -> Value)
-> ([WalletUrl] -> Encoding)
-> ToJSON WalletUrl
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [WalletUrl] -> Encoding
$ctoEncodingList :: [WalletUrl] -> Encoding
toJSONList :: [WalletUrl] -> Value
$ctoJSONList :: [WalletUrl] -> Value
toEncoding :: WalletUrl -> Encoding
$ctoEncoding :: WalletUrl -> Encoding
toJSON :: WalletUrl -> Value
$ctoJSON :: WalletUrl -> Value
ToJSON, Value -> Parser [WalletUrl]
Value -> Parser WalletUrl
(Value -> Parser WalletUrl)
-> (Value -> Parser [WalletUrl]) -> FromJSON WalletUrl
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [WalletUrl]
$cparseJSONList :: Value -> Parser [WalletUrl]
parseJSON :: Value -> Parser WalletUrl
$cparseJSON :: Value -> Parser WalletUrl
FromJSON) via BaseUrl

baseUrlL :: Lens' LocalWalletSettings WalletUrl
baseUrlL :: (WalletUrl -> f WalletUrl)
-> LocalWalletSettings -> f LocalWalletSettings
baseUrlL = (LocalWalletSettings -> WalletUrl)
-> (LocalWalletSettings -> WalletUrl -> LocalWalletSettings)
-> Lens LocalWalletSettings LocalWalletSettings WalletUrl WalletUrl
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens LocalWalletSettings -> WalletUrl
g LocalWalletSettings -> WalletUrl -> LocalWalletSettings
s where
    g :: LocalWalletSettings -> WalletUrl
g = LocalWalletSettings -> WalletUrl
baseUrl
    s :: LocalWalletSettings -> WalletUrl -> LocalWalletSettings
s LocalWalletSettings
settings WalletUrl
url = LocalWalletSettings
settings { baseUrl :: WalletUrl
baseUrl = WalletUrl
url }

makePrisms ''WalletConfig