zenith/src/Zenith/DB.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeOperators #-}

module Zenith.DB where

import Control.Monad (when)
import Control.Monad.IO.Class (liftIO)
import qualified Data.ByteString as BS
import Data.HexString
import Data.Maybe (fromJust, isJust)
import qualified Data.Text as T
import Database.Persist
import Database.Persist.Sqlite
import Database.Persist.TH
import Haskoin.Transaction.Common (TxOut(..))
import ZcashHaskell.Types
  ( OrchardAction(..)
  , OrchardBundle(..)
  , SaplingBundle(..)
  , Scope(..)
  , ShieldedOutput(..)
  , ShieldedSpend(..)
  , Transaction(..)
  , TransparentBundle(..)
  , ZcashNet
  )
import Zenith.Types
  ( HexStringDB(..)
  , OrchardSpendingKeyDB(..)
  , PhraseDB(..)
  , SaplingSpendingKeyDB(..)
  , ScopeDB(..)
  , TransparentSpendingKeyDB
  , UnifiedAddressDB(..)
  , ZcashNetDB(..)
  )

share
  [mkPersist sqlSettings, mkMigrate "migrateAll"]
  [persistLowerCase|
  ZcashWallet
    name T.Text
    network ZcashNetDB
    seedPhrase PhraseDB
    birthdayHeight Int
    UniqueWallet name network
    deriving Show Eq
  ZcashAccount
    index Int
    walletId ZcashWalletId
    name T.Text
    orchSpendKey OrchardSpendingKeyDB
    sapSpendKey SaplingSpendingKeyDB
    tPrivateKey TransparentSpendingKeyDB
    UniqueAccount index walletId
    UniqueAccName walletId name
    deriving Show Eq
  WalletAddress
    index Int
    accId ZcashAccountId
    name T.Text
    uAddress UnifiedAddressDB
    scope ScopeDB
    UniqueAddress index scope accId
    UniqueAddName accId name
    deriving Show Eq
  WalletTransaction
    addrId WalletAddressId
    txId HexStringDB
    conf Int
    time Int
    deriving Show Eq
  WalletTrNote
    tx WalletTransactionId
    value Int
    rawId TransparentNoteId
    spent Bool
    deriving Show Eq
  WalletSapNote
    tx WalletTransactionId
    value Int
    recipient BS.ByteString
    memo T.Text
    rawId ShieldOutputId
    spent Bool
    deriving Show Eq
  WalletOrchNote
    tx WalletTransactionId
    value Int
    recipient BS.ByteString
    memo T.Text
    rawId OrchActionId
    spent Bool
    deriving Show Eq
  ZcashTransaction
    block Int
    txId HexStringDB
    conf Int
    time Int
    deriving Show Eq
  TransparentNote
    tx ZcashTransactionId
    value Int
    script BS.ByteString
  OrchAction
    tx ZcashTransactionId
    nf HexStringDB
    rk HexStringDB
    cmx HexStringDB
    ephKey HexStringDB
    encCipher HexStringDB
    outCipher HexStringDB
    cv HexStringDB
    auth HexStringDB
    deriving Show Eq
  ShieldOutput
    tx ZcashTransactionId
    cv HexStringDB
    cmu HexStringDB
    ephKey HexStringDB
    encCipher HexStringDB
    outCipher HexStringDB
    proof HexStringDB
    deriving Show Eq
  ShieldSpend
    tx ZcashTransactionId
    cv HexStringDB
    anchor HexStringDB
    nullifier HexStringDB
    rk HexStringDB
    proof HexStringDB
    authSig HexStringDB
    deriving Show Eq
    |]

-- * Database functions
-- | Initializes the database
initDb ::
     T.Text -- ^ The database path to check
  -> IO ()
initDb dbName = do
  runSqlite dbName $ do runMigration migrateAll

-- | Get existing wallets from database
getWallets :: T.Text -> ZcashNet -> IO [Entity ZcashWallet]
getWallets dbFp n =
  runSqlite dbFp $ selectList [ZcashWalletNetwork ==. ZcashNetDB n] []

-- | Save a new wallet to the database
saveWallet ::
     T.Text -- ^ The database path to use
  -> ZcashWallet -- ^ The wallet to add to the database
  -> IO (Maybe (Entity ZcashWallet))
saveWallet dbFp w = runSqlite dbFp $ insertUniqueEntity w

-- | Returns a list of accounts associated with the given wallet
getAccounts ::
     T.Text -- ^ The database path
  -> ZcashWalletId -- ^ The wallet ID to check
  -> IO [Entity ZcashAccount]
getAccounts dbFp w = runSqlite dbFp $ selectList [ZcashAccountWalletId ==. w] []

-- | Returns the largest account index for the given wallet
getMaxAccount ::
     T.Text -- ^ The database path
  -> ZcashWalletId -- ^ The wallet ID to check
  -> IO Int
getMaxAccount dbFp w = do
  a <-
    runSqlite dbFp $
    selectFirst [ZcashAccountWalletId ==. w] [Desc ZcashAccountIndex]
  case a of
    Nothing -> return $ -1
    Just x -> return $ zcashAccountIndex $ entityVal x

-- | Save a new account to the database
saveAccount ::
     T.Text -- ^ The database path
  -> ZcashAccount -- ^ The account to add to the database
  -> IO (Maybe (Entity ZcashAccount))
saveAccount dbFp a = runSqlite dbFp $ insertUniqueEntity a

-- | Returns the largest block in storage
getMaxBlock ::
     T.Text -- ^ The database path
  -> IO Int
getMaxBlock dbPath = do
  b <-
    runSqlite dbPath $
    selectFirst [ZcashTransactionBlock >. 0] [Desc ZcashTransactionBlock]
  case b of
    Nothing -> return $ -1
    Just x -> return $ zcashTransactionBlock $ entityVal x

-- | Returns a list of addresses associated with the given account
getAddresses ::
     T.Text -- ^ The database path
  -> ZcashAccountId -- ^ The account ID to check
  -> IO [Entity WalletAddress]
getAddresses dbFp a =
  runSqlite dbFp $
  selectList
    [WalletAddressAccId ==. a, WalletAddressScope ==. ScopeDB External]
    []

-- | Returns the largest address index for the given account
getMaxAddress ::
     T.Text -- ^ The database path
  -> ZcashAccountId -- ^ The account ID to check
  -> Scope -- ^ The scope of the address
  -> IO Int
getMaxAddress dbFp aw s = do
  a <-
    runSqlite dbFp $
    selectFirst
      [WalletAddressAccId ==. aw, WalletAddressScope ==. ScopeDB s]
      [Desc WalletAddressIndex]
  case a of
    Nothing -> return $ -1
    Just x -> return $ walletAddressIndex $ entityVal x

-- | Save a new address to the database
saveAddress ::
     T.Text -- ^ the database path
  -> WalletAddress -- ^ The wallet to add to the database
  -> IO (Maybe (Entity WalletAddress))
saveAddress dbFp w = runSqlite dbFp $ insertUniqueEntity w

-- | Save a transaction to the data model
saveTransaction ::
     T.Text -- ^ the database path
  -> Int -- ^ block time
  -> Transaction -- ^ The transaction to save
  -> IO (Key ZcashTransaction)
saveTransaction dbFp t wt =
  runSqlite dbFp $ do
    w <-
      insert $
      ZcashTransaction (tx_height wt) (HexStringDB $ tx_id wt) (tx_conf wt) t
    when (isJust $ tx_transpBundle wt) $
      insertMany_ $
      map (storeTxOut w) $ (tb_vout . fromJust . tx_transpBundle) wt
    when (isJust $ tx_saplingBundle wt) $ do
      _ <-
        insertMany_ $
        map (storeSapSpend w) $ (sbSpends . fromJust . tx_saplingBundle) wt
      _ <-
        insertMany_ $
        map (storeSapOutput w) $ (sbOutputs . fromJust . tx_saplingBundle) wt
      return ()
    when (isJust $ tx_orchardBundle wt) $
      insertMany_ $
      map (storeOrchAction w) $ (obActions . fromJust . tx_orchardBundle) wt
    return w
  where
    storeTxOut :: ZcashTransactionId -> TxOut -> TransparentNote
    storeTxOut wid (TxOut v s) = TransparentNote wid (fromIntegral v) s
    storeSapSpend :: ZcashTransactionId -> ShieldedSpend -> ShieldSpend
    storeSapSpend wid sp =
      ShieldSpend
        wid
        (HexStringDB $ sp_cv sp)
        (HexStringDB $ sp_anchor sp)
        (HexStringDB $ sp_nullifier sp)
        (HexStringDB $ sp_rk sp)
        (HexStringDB $ sp_proof sp)
        (HexStringDB $ sp_auth sp)
    storeSapOutput :: ZcashTransactionId -> ShieldedOutput -> ShieldOutput
    storeSapOutput wid so =
      ShieldOutput
        wid
        (HexStringDB $ s_cv so)
        (HexStringDB $ s_cmu so)
        (HexStringDB $ s_ephKey so)
        (HexStringDB $ s_encCipherText so)
        (HexStringDB $ s_outCipherText so)
        (HexStringDB $ s_proof so)
    storeOrchAction :: ZcashTransactionId -> OrchardAction -> OrchAction
    storeOrchAction wid oa =
      OrchAction
        wid
        (HexStringDB $ nf oa)
        (HexStringDB $ rk oa)
        (HexStringDB $ cmx oa)
        (HexStringDB $ eph_key oa)
        (HexStringDB $ enc_ciphertext oa)
        (HexStringDB $ out_ciphertext oa)
        (HexStringDB $ cv oa)
        (HexStringDB $ auth oa)