{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE TypeFamilies #-} module Network.Haskoin.Wallet.Store.DbCoin ( dbCoins , dbBalance , yamlCoin , toCoin ) where import Control.Applicative ((<$>)) import Control.Monad.Trans.Either (EitherT) import Data.Yaml ( Value , object , (.=) ) import Data.Maybe (isJust, fromJust) import Database.Persist ( PersistStore , PersistQuery , PersistMonadBackend , Entity(..) , entityVal , selectList , (==.) , SelectOpt(Asc) ) import Database.Persist.Sqlite (SqlBackend) import Network.Haskoin.Wallet.TxBuilder import Network.Haskoin.Wallet.Store.Util import Network.Haskoin.Protocol import Network.Haskoin.Util toCoin :: DbCoinGeneric b -> Either String Coin toCoin c = do scp <- decodeScriptOps =<< maybeToEither scpErr (hexToBS $ dbCoinScript c) rdm <- if isJust $ dbCoinRdmScript c then do bs <- maybeToEither rdmErr $ hexToBS =<< dbCoinRdmScript c Just <$> decodeScriptOps bs else return Nothing h <- maybeToEither tidErr $ decodeTxid $ dbCoinTxid c return $ Coin (TxOut (fromIntegral $ dbCoinValue c) scp) (OutPoint h (fromIntegral $ dbCoinPos c)) rdm where scpErr = "toCoin: Could not decode coin script" tidErr = "toCoin: Could not decode coin txid" rdmErr = "toCoin: Could not decode coin redeem script" yamlCoin :: DbCoinGeneric b -> Value yamlCoin coin = object $ concat [ [ "TxID" .= dbCoinTxid coin , "Index" .= dbCoinPos coin , "Value" .= dbCoinValue coin , "Script" .= dbCoinScript coin , "Address" .= dbCoinAddress coin ] , if isJust $ dbCoinRdmScript coin then ["Redeem" .= fromJust (dbCoinRdmScript coin)] else [] , if dbCoinOrphan coin then ["Orphan" .= True] else [] ] dbBalance :: (PersistQuery m, PersistMonadBackend m ~ b) => Entity (DbAccountGeneric b) -> EitherT String m Int dbBalance (Entity ai _) = do coins <- selectList [ DbCoinAccount ==. ai , DbCoinStatus ==. Unspent , DbCoinOrphan ==. False ] [] return $ sum $ map (dbCoinValue . entityVal) coins dbCoins :: (PersistQuery m, PersistMonadBackend m ~ SqlBackend) => DbAccountId -> EitherT String m [DbCoinGeneric SqlBackend] dbCoins ai = do coins <- selectList [ DbCoinAccount ==. ai , DbCoinStatus ==. Unspent , DbCoinOrphan ==. False ] [Asc DbCoinCreated] return $ map entityVal coins