{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE NamedFieldPuns     #-}
{-# LANGUAGE OverloadedStrings  #-}
{-| Serialisable state of a wallet
-}
module Convex.Wallet.WalletState(
  WalletState(..),
  walletState,
  utxoSet,
  chainPoint,
  initialWalletState,
  writeToFile,
  readFromFile
) where

import           Cardano.Api                (BlockHeader (..), ChainPoint (..))
import qualified Cardano.Api                as C
import           Control.Exception          (SomeException, catch)
import           Convex.Constants           (lessRecent)
import           Convex.NodeClient.ChainTip (JSONChainPoint (..))
import           Convex.Utxos               (UtxoSet)
import           Data.Aeson                 (FromJSON (..), ToJSON (..), decode)
import           Data.Aeson.Encode.Pretty   (encodePretty)
import qualified Data.ByteString.Lazy       as BSL
import           GHC.Generics               (Generic)

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

{-| Construct a 'WalletState' from a UTxO set and a block header
-}
walletState :: UtxoSet C.CtxTx () -> BlockHeader -> WalletState
walletState :: UtxoSet CtxTx () -> BlockHeader -> WalletState
walletState UtxoSet CtxTx ()
wsUtxos (BlockHeader SlotNo
slot Hash BlockHeader
hsh BlockNo
_)=
  let wsChainPoint :: JSONChainPoint
wsChainPoint = ChainPoint -> JSONChainPoint
JSONChainPoint forall a b. (a -> b) -> a -> b
$ SlotNo -> Hash BlockHeader -> ChainPoint
ChainPoint SlotNo
slot Hash BlockHeader
hsh
  in WalletState{UtxoSet CtxTx ()
wsUtxos :: UtxoSet CtxTx ()
wsUtxos :: UtxoSet CtxTx ()
wsUtxos, JSONChainPoint
wsChainPoint :: JSONChainPoint
wsChainPoint :: JSONChainPoint
wsChainPoint}

chainPoint :: WalletState -> ChainPoint
chainPoint :: WalletState -> ChainPoint
chainPoint WalletState{wsChainPoint :: WalletState -> JSONChainPoint
wsChainPoint = JSONChainPoint ChainPoint
c} = ChainPoint
c

utxoSet :: WalletState -> UtxoSet C.CtxTx ()
utxoSet :: WalletState -> UtxoSet CtxTx ()
utxoSet WalletState{UtxoSet CtxTx ()
wsUtxos :: UtxoSet CtxTx ()
wsUtxos :: WalletState -> UtxoSet CtxTx ()
wsUtxos} = UtxoSet CtxTx ()
wsUtxos

initialWalletState :: WalletState
initialWalletState :: WalletState
initialWalletState = JSONChainPoint -> UtxoSet CtxTx () -> WalletState
WalletState (ChainPoint -> JSONChainPoint
JSONChainPoint ChainPoint
lessRecent) forall a. Monoid a => a
mempty

{-| Write the wallet state to a JSON file
-}
writeToFile :: FilePath -> WalletState -> IO ()
writeToFile :: String -> WalletState -> IO ()
writeToFile String
file = String -> ByteString -> IO ()
BSL.writeFile String
file forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> ByteString
encodePretty

{-| Read the wallet state from a JSON file
-}
readFromFile :: FilePath -> IO (Maybe WalletState)
readFromFile :: String -> IO (Maybe WalletState)
readFromFile String
fp =
  forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (forall a. FromJSON a => ByteString -> Maybe a
decode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
BSL.readFile String
fp) forall a b. (a -> b) -> a -> b
$ \(SomeException
_ :: SomeException) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing