{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}

module Zenith.Types where

import Data.Aeson
import Data.Aeson.TH (deriveJSON)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Char8 as C
import Data.HexString
import Data.Int (Int64)
import Data.Maybe (fromMaybe)
import Data.Scientific (Scientific)
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import Data.Text.Encoding.Error (lenientDecode)
import qualified Data.UUID as U
import Database.Persist.TH
import GHC.Generics
import ZcashHaskell.Orchard (encodeUnifiedAddress, parseAddress)
import ZcashHaskell.Sapling (encodeSaplingAddress)
import ZcashHaskell.Transparent
  ( encodeExchangeAddress
  , encodeTransparentReceiver
  )
import ZcashHaskell.Types
  ( ExchangeAddress(..)
  , OrchardSpendingKey(..)
  , Phrase(..)
  , Rseed(..)
  , SaplingAddress(..)
  , SaplingSpendingKey(..)
  , Scope(..)
  , TransparentAddress(..)
  , TransparentSpendingKey
  , UnifiedFullViewingKey(..)
  , UnifiedIncomingViewingKey(..)
  , ValidAddress(..)
  , ZcashNet(..)
  )

-- * UI
-- * Database field type wrappers
newtype HexStringDB = HexStringDB
  { getHex :: HexString
  } deriving newtype (Eq, Show, Read)

derivePersistField "HexStringDB"

newtype ZcashNetDB = ZcashNetDB
  { getNet :: ZcashNet
  } deriving newtype (Eq, Show, Read)

instance ToJSON ZcashNetDB where
  toJSON (ZcashNetDB z) = toJSON z

derivePersistField "ZcashNetDB"

newtype UnifiedAddressDB = UnifiedAddressDB
  { getUA :: T.Text
  } deriving newtype (Eq, Show, Read)

derivePersistField "UnifiedAddressDB"

newtype PhraseDB = PhraseDB
  { getPhrase :: Phrase
  } deriving newtype (Eq, Show, Read)

derivePersistField "PhraseDB"

newtype ScopeDB = ScopeDB
  { getScope :: Scope
  } deriving newtype (Eq, Show, Read)

derivePersistField "ScopeDB"

newtype OrchardSpendingKeyDB = OrchardSpendingKeyDB
  { getOrchSK :: OrchardSpendingKey
  } deriving newtype (Eq, Show, Read)

derivePersistField "OrchardSpendingKeyDB"

newtype SaplingSpendingKeyDB = SaplingSpendingKeyDB
  { getSapSK :: SaplingSpendingKey
  } deriving newtype (Eq, Show, Read)

derivePersistField "SaplingSpendingKeyDB"

newtype TransparentSpendingKeyDB = TransparentSpendingKeyDB
  { getTranSK :: TransparentSpendingKey
  } deriving newtype (Eq, Show, Read)

derivePersistField "TransparentSpendingKeyDB"

newtype RseedDB = RseedDB
  { getRseed :: Rseed
  } deriving newtype (Eq, Show, Read)

derivePersistField "RseedDB"

newtype UnifiedFvkDB = UnifiedFvkDB
  { getFvk :: UnifiedFullViewingKey
  } deriving newtype (Eq, Show, Read)

derivePersistField "UnifiedFvkDB"

newtype UnifiedIvkDB = UnifiedIvkDB
  { getIvk :: UnifiedIncomingViewingKey
  } deriving newtype (Eq, Show, Read)

derivePersistField "UnifiedIvkDB"

data AccountType
  = Local
  | FullViewKey
  | IncomingViewKey
  deriving (Eq, Show, Read)

derivePersistField "AccountType"

instance ToJSON AccountType where
  toJSON at =
    case at of
      Local -> Data.Aeson.String "Local"
      FullViewKey -> Data.Aeson.String "FullViewKey"
      IncomingViewKey -> Data.Aeson.String "IncomingViewKey"

instance FromJSON AccountType where
  parseJSON =
    withText "AccountType" $ \case
      "Local" -> return Local
      "FullViewKey" -> return FullViewKey
      "IncomingViewKey" -> return IncomingViewKey
      _ -> fail "Not a valid Account type"

-- * RPC
-- | Type for Configuration parameters
data Config = Config
  { c_dbPath :: !T.Text
  , c_zebraHost :: !T.Text
  , c_zebraPort :: !Int
  , c_zenithUser :: !BS.ByteString
  , c_zenithPwd :: !BS.ByteString
  , c_zenithPort :: !Int
  , c_currencyCode :: !T.Text
  } deriving (Eq, Prelude.Show)

data ZcashPool
  = TransparentPool
  | SproutPool
  | SaplingPool
  | OrchardPool
  deriving (Show, Read, Eq)

derivePersistField "ZcashPool"

instance ToJSON ZcashPool where
  toJSON zp =
    case zp of
      TransparentPool -> Data.Aeson.String "p2pkh"
      SproutPool -> Data.Aeson.String "sprout"
      SaplingPool -> Data.Aeson.String "sapling"
      OrchardPool -> Data.Aeson.String "orchard"

instance FromJSON ZcashPool where
  parseJSON =
    withText "ZcashPool" $ \case
      "p2pkh" -> return TransparentPool
      "sprout" -> return SproutPool
      "sapling" -> return SaplingPool
      "orchard" -> return OrchardPool
      _ -> fail "Not a known Zcash pool"

newtype ZenithUuid = ZenithUuid
  { getUuid :: U.UUID
  } deriving newtype (Show, Eq, Read, ToJSON, FromJSON)

derivePersistField "ZenithUuid"

-- ** API types
data ZcashWalletAPI = ZcashWalletAPI
  { zw_index :: !Int
  , zw_name :: !T.Text
  , zw_network :: !ZcashNet
  , zw_birthday :: !Int
  , zw_lastSync :: !Int
  , zw_local :: !Bool
  } deriving (Eq, Prelude.Show)

$(deriveJSON defaultOptions {fieldLabelModifier = drop 3} ''ZcashWalletAPI)

data ZcashAccountAPI = ZcashAccountAPI
  { za_index :: !Int
  , za_wallet :: !Int
  , za_name :: !T.Text
  , za_type :: !AccountType
  } deriving (Eq, Prelude.Show)

$(deriveJSON defaultOptions {fieldLabelModifier = drop 3} ''ZcashAccountAPI)

data ZcashAddressAPI = ZcashAddressAPI
  { zd_index :: !Int
  , zd_account :: !Int
  , zd_name :: !T.Text
  , zd_ua :: !T.Text
  , zd_legacy :: !(Maybe T.Text)
  , zd_transparent :: !(Maybe T.Text)
  } deriving (Eq, Prelude.Show)

$(deriveJSON defaultOptions {fieldLabelModifier = drop 3} ''ZcashAddressAPI)

data ZcashNoteAPI = ZcashNoteAPI
  { zn_txid :: !HexString
  , zn_pool :: !ZcashPool
  , zn_amount :: !Float
  , zn_amountZats :: !Int64
  , zn_memo :: !T.Text
  , zn_confirmed :: !Bool
  , zn_blockheight :: !Int
  , zn_blocktime :: !Int
  , zn_outindex :: !Int
  , zn_change :: !Bool
  } deriving (Eq, Prelude.Show)

$(deriveJSON defaultOptions {fieldLabelModifier = drop 3} ''ZcashNoteAPI)

data AccountBalance = AccountBalance
  { acb_transparent :: !Int64
  , acb_sapling :: !Int64
  , acb_orchard :: !Int64
  } deriving (Eq, Prelude.Show)

$(deriveJSON defaultOptions {fieldLabelModifier = drop 4} ''AccountBalance)

data ZenithStatus
  = Processing
  | Failed
  | Successful
  deriving (Eq, Prelude.Show, Read)

$(deriveJSON defaultOptions ''ZenithStatus)

derivePersistField "ZenithStatus"

data PrivacyPolicy
  = None
  | Low
  | Medium
  | Full
  deriving (Eq, Show, Read, Ord)

$(deriveJSON defaultOptions ''PrivacyPolicy)

newtype ValidAddressAPI = ValidAddressAPI
  { getVA :: ValidAddress
  } deriving newtype (Eq, Show)

instance ToJSON ValidAddressAPI where
  toJSON (ValidAddressAPI va) =
    case va of
      Unified ua -> Data.Aeson.String $ encodeUnifiedAddress ua
      Sapling sa ->
        maybe
          Data.Aeson.Null
          Data.Aeson.String
          (encodeSaplingAddress (net_type sa) (sa_receiver sa))
      Transparent ta ->
        Data.Aeson.String $
        encodeTransparentReceiver (ta_network ta) (ta_receiver ta)
      Exchange ea ->
        maybe
          Data.Aeson.Null
          Data.Aeson.String
          (encodeExchangeAddress (ex_network ea) (ex_address ea))

data ProposedNote = ProposedNote
  { pn_addr :: !ValidAddressAPI
  , pn_amt :: !Scientific
  , pn_memo :: !(Maybe T.Text)
  } deriving (Eq, Prelude.Show)

instance FromJSON ProposedNote where
  parseJSON =
    withObject "ProposedNote" $ \obj -> do
      a <- obj .: "address"
      n <- obj .: "amount"
      m <- obj .:? "memo"
      case parseAddress (E.encodeUtf8 a) of
        Nothing -> fail "Invalid address"
        Just a' ->
          if n > 0 && n < 21000000
            then pure $ ProposedNote (ValidAddressAPI a') n m
            else fail "Invalid amount"

instance ToJSON ProposedNote where
  toJSON (ProposedNote a n m) =
    object ["address" .= a, "amount" .= n, "memo" .= m]

data ShieldDeshieldOp
  = Shield
  | Deshield
  deriving (Eq, Show, Read, Ord)

-- ** `zebrad`
-- | Type for modeling the tree state response
data ZebraTreeInfo = ZebraTreeInfo
  { ztiHeight :: !Int
  , ztiTime :: !Int
  , ztiSapling :: !HexString
  , ztiOrchard :: !HexString
  } deriving (Eq, Show, Read)

instance FromJSON ZebraTreeInfo where
  parseJSON =
    withObject "ZebraTreeInfo" $ \obj -> do
      h <- obj .: "height"
      t <- obj .: "time"
      s <- obj .: "sapling"
      o <- obj .: "orchard"
      sc <- s .: "commitments"
      oc <- o .: "commitments"
      sf <- sc .: "finalState"
      ocf <- oc .: "finalState"
      pure $ ZebraTreeInfo h t sf ocf

-- ** `zcashd`
-- | Type for modelling the different address sources for `zcashd` 5.0.0
data AddressSource
  = LegacyRandom
  | Imported
  | ImportedWatchOnly
  | KeyPool
  | LegacySeed
  | MnemonicSeed
  deriving (Read, Show, Eq, Generic, ToJSON)

instance FromJSON AddressSource where
  parseJSON =
    withText "AddressSource" $ \case
      "legacy_random" -> return LegacyRandom
      "imported" -> return Imported
      "imported_watchonly" -> return ImportedWatchOnly
      "keypool" -> return KeyPool
      "legacy_hdseed" -> return LegacySeed
      "mnemonic_seed" -> return MnemonicSeed
      _ -> fail "Not a known address source"

data ZcashAddress = ZcashAddress
  { source :: AddressSource
  , pool :: [ZcashPool]
  , account :: Maybe Integer
  , addy :: T.Text
  } deriving (Eq)

instance Show ZcashAddress where
  show (ZcashAddress s p i a) =
    T.unpack (T.take 8 a) ++
    "..." ++ T.unpack (T.takeEnd 8 a) ++ " Pools: " ++ show p

newtype NodeVersion =
  NodeVersion Integer
  deriving (Eq, Show)

instance FromJSON NodeVersion where
  parseJSON =
    withObject "NodeVersion" $ \obj -> do
      v <- obj .: "version"
      pure $ NodeVersion v

-- | A type to model an address group
data AddressGroup = AddressGroup
  { agsource :: !AddressSource
  , agtransparent :: ![ZcashAddress]
  , agsapling :: ![ZcashAddress]
  , agunified :: ![ZcashAddress]
  } deriving (Show, Generic)

instance FromJSON AddressGroup where
  parseJSON =
    withObject "AddressGroup" $ \obj -> do
      s <- obj .: "source"
      t <- obj .:? "transparent"
      sap <- obj .:? "sapling"
      uni <- obj .:? "unified"
      sL <- processSapling sap s
      tL <- processTransparent t s
      uL <- processUnified uni
      return $ AddressGroup s tL (concat sL) (concat uL)
    where
      processTransparent c s1 =
        case c of
          Nothing -> return []
          Just x -> do
            x' <- x .:? "addresses"
            return $
              maybe [] (map (ZcashAddress s1 [TransparentPool] Nothing)) x'
      processSapling k s2 =
        case k of
          Nothing -> return []
          Just y -> mapM (processOneSapling s2) y
            where processOneSapling sx =
                    withObject "Sapling" $ \oS -> do
                      oS' <- oS .: "addresses"
                      return $ map (ZcashAddress sx [SaplingPool] Nothing) oS'
      processUnified u =
        case u of
          Nothing -> return []
          Just z -> mapM processOneAccount z
            where processOneAccount =
                    withObject "UAs" $ \uS -> do
                      acct <- uS .: "account"
                      uS' <- uS .: "addresses"
                      mapM (processUAs acct) uS'
                    where
                      processUAs a =
                        withObject "UAs" $ \v -> do
                          addr <- v .: "address"
                          p <- v .: "receiver_types"
                          return $ ZcashAddress MnemonicSeed p a addr

-- | A type to model a Zcash transaction
data ZcashTx = ZcashTx
  { ztxid :: !T.Text
  , zamount :: !Double
  , zamountZat :: !Integer
  , zblockheight :: !Integer
  , zblocktime :: !Integer
  , zchange :: !Bool
  , zconfirmations :: !Integer
  , zmemo :: !T.Text
  } deriving (Show, Generic)

instance FromJSON ZcashTx where
  parseJSON =
    withObject "ZcashTx" $ \obj -> do
      t <- obj .: "txid"
      a <- obj .: "amount"
      aZ <- obj .: "amountZat"
      bh <- obj .: "blockheight"
      bt <- obj .: "blocktime"
      c <- obj .:? "change"
      conf <- obj .: "confirmations"
      m <- obj .:? "memo"
      pure $
        ZcashTx
          t
          a
          aZ
          bh
          bt
          (fromMaybe False c)
          conf
          (case m of
             Nothing -> ""
             Just m' -> T.filter (/= '\NUL') $ decodeHexText m')

instance ToJSON ZcashTx where
  toJSON (ZcashTx t a aZ bh bt c conf m) =
    object
      [ "amount" .= a
      , "amountZat" .= aZ
      , "txid" .= t
      , "blockheight" .= bh
      , "blocktime" .= bt
      , "change" .= c
      , "confirmations" .= conf
      , "memo" .= m
      ]

-- | Type for the UA balance
data UABalance = UABalance
  { uatransparent :: !Integer
  , uasapling :: !Integer
  , uaorchard :: !Integer
  } deriving (Eq)

instance Show UABalance where
  show (UABalance t s o) =
    " T: " ++ show t ++ " S: " ++ show s ++ " O: " ++ show o

instance FromJSON UABalance where
  parseJSON =
    withObject "UABalance" $ \obj -> do
      p <- obj .: "pools"
      t <- p .:? "transparent"
      s <- p .:? "sapling"
      o <- p .:? "orchard"
      vT <-
        case t of
          Nothing -> return 0
          Just t' -> t' .: "valueZat"
      vS <-
        case s of
          Nothing -> return 0
          Just s' -> s' .: "valueZat"
      vO <-
        case o of
          Nothing -> return 0
          Just o' -> o' .: "valueZat"
      pure $ UABalance vT vS vO

-- | Type for Operation Result
data OpResult = OpResult
  { opsuccess :: !T.Text
  , opmessage :: !(Maybe T.Text)
  , optxid :: !(Maybe T.Text)
  } deriving (Show, Eq)

instance FromJSON OpResult where
  parseJSON =
    withObject "OpResult" $ \obj -> do
      s <- obj .: "status"
      r <- obj .:? "result"
      e <- obj .:? "error"
      t <-
        case r of
          Nothing -> return Nothing
          Just r' -> r' .: "txid"
      m <-
        case e of
          Nothing -> return Nothing
          Just m' -> m' .: "message"
      pure $ OpResult s m t

-- * Helper functions
-- | Helper function to turn a hex-encoded memo strings to readable text
decodeHexText :: String -> T.Text
decodeHexText h = E.decodeUtf8With lenientDecode $ BS.pack $ hexRead h
  where
    hexRead hexText
      | null chunk = []
      | otherwise =
        fromIntegral (read ("0x" <> chunk)) : hexRead (drop 2 hexText)
      where
        chunk = take 2 hexText

-- | Helper function to turn a text into a hex-encoded string
encodeHexText' :: T.Text -> String
encodeHexText' t =
  if T.length t > 0
    then C.unpack . B64.encode $ E.encodeUtf8 t
    else C.unpack . B64.encode $ E.encodeUtf8 "Sent from Zenith"

-- | Define a data structure for the parsed components
data ZcashPaymentURI = ZcashPaymentURI
  { uriAddress :: String
  , uriAmount :: Maybe Double
  , uriMemo :: T.Text
  , uriLabel :: Maybe String
  , uriMessage :: Maybe String
  } deriving (Show, Eq)

-- | Define a data structure for the URI QR image
data URIQrCode = URIQrCode
  { uriBytes :: BS.ByteString -- Image as ByteString
  , uriWidth :: Double -- Number of columns in QR Image
  , uriHeight :: Double -- Number of rows in a QR Image
  } deriving (Show, Eq)
