{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

-- |
-- Copyright: © 2018-2020 IOHK
-- License: Apache-2.0
--
-- This module contains instances and types necessary for storing wallets in a
-- SQL database with Persistent.
--
-- It's in a separate module due to the GHC stage restriction.
--
-- The ToJSON/FromJSON and Read instance orphans exist due to class constraints
-- on Persistent functions.

module Cardano.Wallet.DB.Sqlite.Types where

import Prelude

import Cardano.Address.Script
    ( Cosigner, Script, ScriptHash (..) )
import Cardano.Api
    ( TxMetadataJsonSchema (..)
    , displayError
    , metadataFromJson
    , metadataToJson
    )
import Cardano.Slotting.Slot
    ( SlotNo (..) )
import Cardano.Wallet.Primitive.AddressDerivation
    ( Role (..) )
import Cardano.Wallet.Primitive.AddressDiscovery.Sequential
    ( AddressPoolGap (..)
    , DerivationPrefix
    , getAddressPoolGap
    , mkAddressPoolGap
    )
import Cardano.Wallet.Primitive.AddressDiscovery.Shared
    ( CredentialType )
import Cardano.Wallet.Primitive.Passphrase.Types
    ( Passphrase (..), PassphraseScheme (..) )
import Cardano.Wallet.Primitive.Types
    ( EpochNo (..)
    , FeePolicy
    , PoolId
    , PoolMetadataSource (..)
    , PoolOwner (..)
    , StakeKeyCertificate (..)
    , StakePoolMetadataHash (..)
    , StakePoolMetadataUrl (..)
    , StakePoolTicker
    , WalletId (..)
    , isValidEpochNo
    , unsafeEpochNo
    , unsafeToPMS
    )
import Cardano.Wallet.Primitive.Types.Address
    ( Address (..), AddressState (..) )
import Cardano.Wallet.Primitive.Types.Coin
    ( Coin (..) )
import Cardano.Wallet.Primitive.Types.Hash
    ( Hash (..) )
import Cardano.Wallet.Primitive.Types.RewardAccount
    ( RewardAccount (..) )
import Cardano.Wallet.Primitive.Types.TokenPolicy
    ( TokenName, TokenPolicyId )
import Cardano.Wallet.Primitive.Types.TokenQuantity
    ( TokenQuantity (..) )
import Cardano.Wallet.Primitive.Types.Tx
    ( Direction (..)
    , SealedTx (..)
    , TxMetadata
    , TxScriptValidity (..)
    , TxStatus (..)
    , persistSealedTx
    , unPersistSealedTx
    )
import Control.Arrow
    ( left )
import Control.Monad
    ( (<=<), (>=>) )
import Data.Aeson
    ( FromJSON (..), ToJSON (..), Value (..), withText )
import Data.Aeson.Types
    ( Parser )
import Data.Bifunctor
    ( bimap, first )
import Data.ByteArray.Encoding
    ( Base (..), convertFromBase, convertToBase )
import Data.ByteString
    ( ByteString )
import Data.Maybe
    ( fromMaybe, mapMaybe )
import Data.Proxy
    ( Proxy (..) )
import Data.Quantity
    ( Percentage )
import Data.Text
    ( Text )
import Data.Text.Class
    ( FromText (..)
    , TextDecodingError (..)
    , ToText (..)
    , fromTextMaybe
    , getTextDecodingError
    )
import Data.Text.Encoding
    ( decodeUtf8, encodeUtf8 )
import Data.Time.Clock.POSIX
    ( POSIXTime, posixSecondsToUTCTime, utcTimeToPOSIXSeconds )
import Data.Time.Format
    ( defaultTimeLocale, formatTime, iso8601DateFormat, parseTimeM )
import Data.Word
    ( Word32, Word64 )
import Data.Word.Odd
    ( Word31 )
import Database.Persist.Sqlite
    ( PersistField (..), PersistFieldSql (..), PersistValue (..) )
import Database.Persist.TH
    ( MkPersistSettings (..), sqlSettings )
import GHC.Generics
    ( Generic )
import Network.URI
    ( parseAbsoluteURI )
import System.Random.Internal
    ( StdGen (..) )
import System.Random.SplitMix
    ( seedSMGen, unseedSMGen )
import Text.Read
    ( readMaybe )
import Web.HttpApiData
    ( FromHttpApiData (..), ToHttpApiData (..) )
import Web.PathPieces
    ( PathPiece (..) )

import qualified Cardano.Wallet.Primitive.Types.Coin as Coin
import qualified Data.Aeson as Aeson
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL
import qualified Data.Text as T
import qualified Data.Text.Encoding as T

----------------------------------------------------------------------------

-- | Settings for generating the Persistent types.
sqlSettings' :: MkPersistSettings
sqlSettings' :: MkPersistSettings
sqlSettings' = MkPersistSettings
sqlSettings { mpsPrefixFields :: Bool
mpsPrefixFields = Bool
False }

----------------------------------------------------------------------------
-- Helper functions

-- | 'fromText' but with a simpler error type.
fromText' :: FromText a => Text -> Either Text a
fromText' :: Text -> Either Text a
fromText' = (TextDecodingError -> Text)
-> Either TextDecodingError a -> Either Text a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> Text
T.pack (String -> Text)
-> (TextDecodingError -> String) -> TextDecodingError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextDecodingError -> String
getTextDecodingError) (Either TextDecodingError a -> Either Text a)
-> (Text -> Either TextDecodingError a) -> Text -> Either Text a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either TextDecodingError a
forall a. FromText a => Text -> Either TextDecodingError a
fromText

-- | Aeson parser defined in terms of 'fromText'
aesonFromText :: FromText a => String -> Value -> Parser a
aesonFromText :: String -> Value -> Parser a
aesonFromText String
what = String -> (Text -> Parser a) -> Value -> Parser a
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
what ((Text -> Parser a) -> Value -> Parser a)
-> (Text -> Parser a) -> Value -> Parser a
forall a b. (a -> b) -> a -> b
$ (TextDecodingError -> Parser a)
-> (a -> Parser a) -> Either TextDecodingError a -> Parser a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser a)
-> (TextDecodingError -> String) -> TextDecodingError -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextDecodingError -> String
forall a. Show a => a -> String
show) a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either TextDecodingError a -> Parser a)
-> (Text -> Either TextDecodingError a) -> Text -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either TextDecodingError a
forall a. FromText a => Text -> Either TextDecodingError a
fromText

-- | 'fromPersistValue' defined in terms of 'fromText'
fromPersistValueFromText :: FromText a => PersistValue -> Either Text a
fromPersistValueFromText :: PersistValue -> Either Text a
fromPersistValueFromText = PersistValue -> Either Text Text
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue (PersistValue -> Either Text Text)
-> (Text -> Either Text a) -> PersistValue -> Either Text a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Text -> Either Text a
fromTextWithErr
    where fromTextWithErr :: Text -> Either Text a
fromTextWithErr = (Text -> Text) -> Either Text a -> Either Text a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text
"not a valid value: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Either Text a -> Either Text a)
-> (Text -> Either Text a) -> Text -> Either Text a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text a
forall a. FromText a => Text -> Either Text a
fromText'

-- | 'fromPersistValue' defined in terms of the 'Read' class
fromPersistValueRead :: Read a => PersistValue -> Either Text a
fromPersistValueRead :: PersistValue -> Either Text a
fromPersistValueRead PersistValue
pv = PersistValue -> Either Text Text
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue PersistValue
pv Either Text Text -> (Text -> Either Text a) -> Either Text a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Either Text a
readWithErr
  where
    readWithErr :: Text -> Either Text a
readWithErr = Maybe a -> Either Text a
forall b. Maybe b -> Either Text b
toEither (Maybe a -> Either Text a)
-> (Text -> Maybe a) -> Text -> Either Text a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe a) -> (Text -> String) -> Text -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
    toEither :: Maybe b -> Either Text b
toEither = Either Text b -> (b -> Either Text b) -> Maybe b -> Either Text b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Either Text b
forall a b. a -> Either a b
Left (Text -> Either Text b) -> Text -> Either Text b
forall a b. (a -> b) -> a -> b
$ Text
"not a valid value: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (PersistValue -> String
forall a. Show a => a -> String
show PersistValue
pv)) b -> Either Text b
forall a b. b -> Either a b
Right


----------------------------------------------------------------------------
-- StakeKeyCertificate

instance PersistField StakeKeyCertificate where
    toPersistValue :: StakeKeyCertificate -> PersistValue
toPersistValue = String -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (String -> PersistValue)
-> (StakeKeyCertificate -> String)
-> StakeKeyCertificate
-> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StakeKeyCertificate -> String
forall a. Show a => a -> String
show
    fromPersistValue :: PersistValue -> Either Text StakeKeyCertificate
fromPersistValue = PersistValue -> Either Text StakeKeyCertificate
forall a. Read a => PersistValue -> Either Text a
fromPersistValueRead

instance PersistFieldSql StakeKeyCertificate where
    sqlType :: Proxy StakeKeyCertificate -> SqlType
sqlType Proxy StakeKeyCertificate
_ = Proxy Text -> SqlType
forall a. PersistFieldSql a => Proxy a -> SqlType
sqlType (Proxy Text
forall k (t :: k). Proxy t
Proxy @Text)

----------------------------------------------------------------------------
-- Direction

instance PersistField Direction where
    toPersistValue :: Direction -> PersistValue
toPersistValue = Bool -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (Bool -> PersistValue)
-> (Direction -> Bool) -> Direction -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Direction -> Bool
directionToBool
    fromPersistValue :: PersistValue -> Either Text Direction
fromPersistValue PersistValue
pv = do
        let err :: Text
err = Text
"not a valid value: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (PersistValue -> String
forall a. Show a => a -> String
show PersistValue
pv)
        (Text -> Text)
-> (Bool -> Direction) -> Either Text Bool -> Either Text Direction
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (Text -> Text -> Text
forall a b. a -> b -> a
const Text
err) Bool -> Direction
directionFromBool (PersistValue -> Either Text Bool
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue PersistValue
pv)

instance PersistFieldSql Direction where
    sqlType :: Proxy Direction -> SqlType
sqlType Proxy Direction
_ = Proxy Bool -> SqlType
forall a. PersistFieldSql a => Proxy a -> SqlType
sqlType (Proxy Bool
forall k (t :: k). Proxy t
Proxy @Bool)

directionToBool :: Direction -> Bool
directionToBool :: Direction -> Bool
directionToBool Direction
Incoming = Bool
True
directionToBool Direction
Outgoing = Bool
False

directionFromBool :: Bool -> Direction
directionFromBool :: Bool -> Direction
directionFromBool Bool
True = Direction
Incoming
directionFromBool Bool
False = Direction
Outgoing

----------------------------------------------------------------------------
-- Fee Policy

instance PersistField FeePolicy where
    toPersistValue :: FeePolicy -> PersistValue
toPersistValue = Text -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (Text -> PersistValue)
-> (FeePolicy -> Text) -> FeePolicy -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FeePolicy -> Text
forall a. ToText a => a -> Text
toText
    fromPersistValue :: PersistValue -> Either Text FeePolicy
fromPersistValue PersistValue
pv = PersistValue -> Either Text Text
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue PersistValue
pv Either Text Text
-> (Text -> Either Text FeePolicy) -> Either Text FeePolicy
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (TextDecodingError -> Text)
-> Either TextDecodingError FeePolicy -> Either Text FeePolicy
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (Text -> TextDecodingError -> Text
forall a b. a -> b -> a
const Text
err) (Either TextDecodingError FeePolicy -> Either Text FeePolicy)
-> (Text -> Either TextDecodingError FeePolicy)
-> Text
-> Either Text FeePolicy
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either TextDecodingError FeePolicy
forall a. FromText a => Text -> Either TextDecodingError a
fromText
        where err :: Text
err = Text
"not a valid value: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (PersistValue -> String
forall a. Show a => a -> String
show PersistValue
pv)

instance PersistFieldSql FeePolicy where
    sqlType :: Proxy FeePolicy -> SqlType
sqlType Proxy FeePolicy
_ = Proxy Text -> SqlType
forall a. PersistFieldSql a => Proxy a -> SqlType
sqlType (Proxy Text
forall k (t :: k). Proxy t
Proxy @Text)

----------------------------------------------------------------------------
-- Percentage

instance PersistField Percentage where
    toPersistValue :: Percentage -> PersistValue
toPersistValue = Text -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (Text -> PersistValue)
-> (Percentage -> Text) -> Percentage -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Percentage -> Text
forall a. ToText a => a -> Text
toText
    fromPersistValue :: PersistValue -> Either Text Percentage
fromPersistValue PersistValue
pv = PersistValue -> Either Text Text
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue PersistValue
pv Either Text Text
-> (Text -> Either Text Percentage) -> Either Text Percentage
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (TextDecodingError -> Text)
-> Either TextDecodingError Percentage -> Either Text Percentage
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (Text -> TextDecodingError -> Text
forall a b. a -> b -> a
const Text
err) (Either TextDecodingError Percentage -> Either Text Percentage)
-> (Text -> Either TextDecodingError Percentage)
-> Text
-> Either Text Percentage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either TextDecodingError Percentage
forall a. FromText a => Text -> Either TextDecodingError a
fromText
        where err :: Text
err = Text
"not a valid percentage: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (PersistValue -> String
forall a. Show a => a -> String
show PersistValue
pv)

instance PersistFieldSql Percentage where
    sqlType :: Proxy Percentage -> SqlType
sqlType Proxy Percentage
_ = Proxy Rational -> SqlType
forall a. PersistFieldSql a => Proxy a -> SqlType
sqlType (Proxy Rational
forall k (t :: k). Proxy t
Proxy @Rational)

----------------------------------------------------------------------------
-- WalletId

instance PersistField WalletId where
    toPersistValue :: WalletId -> PersistValue
toPersistValue = Text -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (Text -> PersistValue)
-> (WalletId -> Text) -> WalletId -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WalletId -> Text
forall a. ToText a => a -> Text
toText
    fromPersistValue :: PersistValue -> Either Text WalletId
fromPersistValue = PersistValue -> Either Text WalletId
forall a. FromText a => PersistValue -> Either Text a
fromPersistValueFromText

instance PersistFieldSql WalletId where
    sqlType :: Proxy WalletId -> SqlType
sqlType Proxy WalletId
_ = Proxy Text -> SqlType
forall a. PersistFieldSql a => Proxy a -> SqlType
sqlType (Proxy Text
forall k (t :: k). Proxy t
Proxy @Text)

instance Read WalletId where
    readsPrec :: Int -> ReadS WalletId
readsPrec Int
_ = String -> ReadS WalletId
forall a. HasCallStack => String -> a
error String
"readsPrec stub needed for persistent"

instance ToHttpApiData WalletId where
    toUrlPiece :: WalletId -> Text
toUrlPiece = WalletId -> Text
forall a. ToText a => a -> Text
toText

instance FromHttpApiData WalletId where
    parseUrlPiece :: Text -> Either Text WalletId
parseUrlPiece = Text -> Either Text WalletId
forall a. FromText a => Text -> Either Text a
fromText'

instance ToJSON WalletId where
    toJSON :: WalletId -> Value
toJSON = Text -> Value
String (Text -> Value) -> (WalletId -> Text) -> WalletId -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WalletId -> Text
forall a. ToText a => a -> Text
toText

instance FromJSON WalletId where
    parseJSON :: Value -> Parser WalletId
parseJSON = String -> Value -> Parser WalletId
forall a. FromText a => String -> Value -> Parser a
aesonFromText String
"WalletId"

instance PathPiece WalletId where
    fromPathPiece :: Text -> Maybe WalletId
fromPathPiece = Text -> Maybe WalletId
forall a. FromText a => Text -> Maybe a
fromTextMaybe
    toPathPiece :: WalletId -> Text
toPathPiece = WalletId -> Text
forall a. ToText a => a -> Text
toText

----------------------------------------------------------------------------
-- TxId

-- | Wraps 'Hash "Tx"' because the persistent entity syntax doesn't seem to
-- support parameterized types.
newtype TxId = TxId { TxId -> Hash "Tx"
getTxId :: Hash "Tx" } deriving (Int -> TxId -> ShowS
[TxId] -> ShowS
TxId -> String
(Int -> TxId -> ShowS)
-> (TxId -> String) -> ([TxId] -> ShowS) -> Show TxId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxId] -> ShowS
$cshowList :: [TxId] -> ShowS
show :: TxId -> String
$cshow :: TxId -> String
showsPrec :: Int -> TxId -> ShowS
$cshowsPrec :: Int -> TxId -> ShowS
Show, TxId -> TxId -> Bool
(TxId -> TxId -> Bool) -> (TxId -> TxId -> Bool) -> Eq TxId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxId -> TxId -> Bool
$c/= :: TxId -> TxId -> Bool
== :: TxId -> TxId -> Bool
$c== :: TxId -> TxId -> Bool
Eq, Eq TxId
Eq TxId
-> (TxId -> TxId -> Ordering)
-> (TxId -> TxId -> Bool)
-> (TxId -> TxId -> Bool)
-> (TxId -> TxId -> Bool)
-> (TxId -> TxId -> Bool)
-> (TxId -> TxId -> TxId)
-> (TxId -> TxId -> TxId)
-> Ord TxId
TxId -> TxId -> Bool
TxId -> TxId -> Ordering
TxId -> TxId -> TxId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TxId -> TxId -> TxId
$cmin :: TxId -> TxId -> TxId
max :: TxId -> TxId -> TxId
$cmax :: TxId -> TxId -> TxId
>= :: TxId -> TxId -> Bool
$c>= :: TxId -> TxId -> Bool
> :: TxId -> TxId -> Bool
$c> :: TxId -> TxId -> Bool
<= :: TxId -> TxId -> Bool
$c<= :: TxId -> TxId -> Bool
< :: TxId -> TxId -> Bool
$c< :: TxId -> TxId -> Bool
compare :: TxId -> TxId -> Ordering
$ccompare :: TxId -> TxId -> Ordering
$cp1Ord :: Eq TxId
Ord, (forall x. TxId -> Rep TxId x)
-> (forall x. Rep TxId x -> TxId) -> Generic TxId
forall x. Rep TxId x -> TxId
forall x. TxId -> Rep TxId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TxId x -> TxId
$cfrom :: forall x. TxId -> Rep TxId x
Generic)

instance PersistField TxId where
    toPersistValue :: TxId -> PersistValue
toPersistValue = Text -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (Text -> PersistValue) -> (TxId -> Text) -> TxId -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash "Tx" -> Text
forall a. ToText a => a -> Text
toText (Hash "Tx" -> Text) -> (TxId -> Hash "Tx") -> TxId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxId -> Hash "Tx"
getTxId
    fromPersistValue :: PersistValue -> Either Text TxId
fromPersistValue = (Hash "Tx" -> TxId) -> Either Text (Hash "Tx") -> Either Text TxId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Hash "Tx" -> TxId
TxId (Either Text (Hash "Tx") -> Either Text TxId)
-> (PersistValue -> Either Text (Hash "Tx"))
-> PersistValue
-> Either Text TxId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PersistValue -> Either Text (Hash "Tx")
forall a. FromText a => PersistValue -> Either Text a
fromPersistValueFromText

instance PersistFieldSql TxId where
    sqlType :: Proxy TxId -> SqlType
sqlType Proxy TxId
_ = Proxy Text -> SqlType
forall a. PersistFieldSql a => Proxy a -> SqlType
sqlType (Proxy Text
forall k (t :: k). Proxy t
Proxy @Text)

instance Read TxId where
    readsPrec :: Int -> ReadS TxId
readsPrec Int
_ = String -> ReadS TxId
forall a. HasCallStack => String -> a
error String
"readsPrec stub needed for persistent"

instance ToJSON TxId where
    toJSON :: TxId -> Value
toJSON = Text -> Value
String (Text -> Value) -> (TxId -> Text) -> TxId -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash "Tx" -> Text
forall a. ToText a => a -> Text
toText (Hash "Tx" -> Text) -> (TxId -> Hash "Tx") -> TxId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxId -> Hash "Tx"
getTxId

instance FromJSON TxId where
    parseJSON :: Value -> Parser TxId
parseJSON = (Hash "Tx" -> TxId) -> Parser (Hash "Tx") -> Parser TxId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Hash "Tx" -> TxId
TxId (Parser (Hash "Tx") -> Parser TxId)
-> (Value -> Parser (Hash "Tx")) -> Value -> Parser TxId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Value -> Parser (Hash "Tx")
forall a. FromText a => String -> Value -> Parser a
aesonFromText String
"TxId"

instance ToHttpApiData TxId where
    toUrlPiece :: TxId -> Text
toUrlPiece = Hash "Tx" -> Text
forall a. ToText a => a -> Text
toText (Hash "Tx" -> Text) -> (TxId -> Hash "Tx") -> TxId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxId -> Hash "Tx"
getTxId

instance FromHttpApiData TxId where
    parseUrlPiece :: Text -> Either Text TxId
parseUrlPiece = (Hash "Tx" -> TxId) -> Either Text (Hash "Tx") -> Either Text TxId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Hash "Tx" -> TxId
TxId (Either Text (Hash "Tx") -> Either Text TxId)
-> (Text -> Either Text (Hash "Tx")) -> Text -> Either Text TxId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text (Hash "Tx")
forall a. FromText a => Text -> Either Text a
fromText'

instance PathPiece TxId where
    toPathPiece :: TxId -> Text
toPathPiece = Hash "Tx" -> Text
forall a. ToText a => a -> Text
toText (Hash "Tx" -> Text) -> (TxId -> Hash "Tx") -> TxId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxId -> Hash "Tx"
getTxId
    fromPathPiece :: Text -> Maybe TxId
fromPathPiece = (Hash "Tx" -> TxId) -> Maybe (Hash "Tx") -> Maybe TxId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Hash "Tx" -> TxId
TxId (Maybe (Hash "Tx") -> Maybe TxId)
-> (Text -> Maybe (Hash "Tx")) -> Text -> Maybe TxId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe (Hash "Tx")
forall a. FromText a => Text -> Maybe a
fromTextMaybe

--------------------------------------------------------------------------------
-- Tokens
--------------------------------------------------------------------------------

instance PersistField TokenName where
    toPersistValue :: TokenName -> PersistValue
toPersistValue = Text -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (Text -> PersistValue)
-> (TokenName -> Text) -> TokenName -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenName -> Text
forall a. ToText a => a -> Text
toText
    fromPersistValue :: PersistValue -> Either Text TokenName
fromPersistValue = PersistValue -> Either Text TokenName
forall a. FromText a => PersistValue -> Either Text a
fromPersistValueFromText

instance PersistFieldSql TokenName where
    sqlType :: Proxy TokenName -> SqlType
sqlType Proxy TokenName
_ = Proxy Text -> SqlType
forall a. PersistFieldSql a => Proxy a -> SqlType
sqlType (Proxy Text
forall k (t :: k). Proxy t
Proxy @Text)

instance PersistField TokenPolicyId where
    toPersistValue :: TokenPolicyId -> PersistValue
toPersistValue = Text -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (Text -> PersistValue)
-> (TokenPolicyId -> Text) -> TokenPolicyId -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenPolicyId -> Text
forall a. ToText a => a -> Text
toText
    fromPersistValue :: PersistValue -> Either Text TokenPolicyId
fromPersistValue = PersistValue -> Either Text TokenPolicyId
forall a. FromText a => PersistValue -> Either Text a
fromPersistValueFromText

instance PersistFieldSql TokenPolicyId where
    sqlType :: Proxy TokenPolicyId -> SqlType
sqlType Proxy TokenPolicyId
_ = Proxy Text -> SqlType
forall a. PersistFieldSql a => Proxy a -> SqlType
sqlType (Proxy Text
forall k (t :: k). Proxy t
Proxy @Text)

instance PersistField TokenQuantity where
    -- SQLite has no big integer type, so we use a textual representation
    -- instead.
    toPersistValue :: TokenQuantity -> PersistValue
toPersistValue = Text -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (Text -> PersistValue)
-> (TokenQuantity -> Text) -> TokenQuantity -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenQuantity -> Text
forall a. ToText a => a -> Text
toText
    fromPersistValue :: PersistValue -> Either Text TokenQuantity
fromPersistValue = PersistValue -> Either Text TokenQuantity
forall a. FromText a => PersistValue -> Either Text a
fromPersistValueFromText

instance PersistFieldSql TokenQuantity where
    -- SQLite has no big integer type, so we use a textual representation
    -- instead.
    sqlType :: Proxy TokenQuantity -> SqlType
sqlType Proxy TokenQuantity
_ = Proxy Text -> SqlType
forall a. PersistFieldSql a => Proxy a -> SqlType
sqlType (Proxy Text
forall k (t :: k). Proxy t
Proxy @Text)

----------------------------------------------------------------------------
-- BlockId

-- Wraps Hash "BlockHeader" because the persistent dsl doesn't like it raw.
newtype BlockId = BlockId { BlockId -> Hash "BlockHeader"
getBlockId :: Hash "BlockHeader" }
    deriving (Int -> BlockId -> ShowS
[BlockId] -> ShowS
BlockId -> String
(Int -> BlockId -> ShowS)
-> (BlockId -> String) -> ([BlockId] -> ShowS) -> Show BlockId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlockId] -> ShowS
$cshowList :: [BlockId] -> ShowS
show :: BlockId -> String
$cshow :: BlockId -> String
showsPrec :: Int -> BlockId -> ShowS
$cshowsPrec :: Int -> BlockId -> ShowS
Show, BlockId -> BlockId -> Bool
(BlockId -> BlockId -> Bool)
-> (BlockId -> BlockId -> Bool) -> Eq BlockId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlockId -> BlockId -> Bool
$c/= :: BlockId -> BlockId -> Bool
== :: BlockId -> BlockId -> Bool
$c== :: BlockId -> BlockId -> Bool
Eq, Eq BlockId
Eq BlockId
-> (BlockId -> BlockId -> Ordering)
-> (BlockId -> BlockId -> Bool)
-> (BlockId -> BlockId -> Bool)
-> (BlockId -> BlockId -> Bool)
-> (BlockId -> BlockId -> Bool)
-> (BlockId -> BlockId -> BlockId)
-> (BlockId -> BlockId -> BlockId)
-> Ord BlockId
BlockId -> BlockId -> Bool
BlockId -> BlockId -> Ordering
BlockId -> BlockId -> BlockId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BlockId -> BlockId -> BlockId
$cmin :: BlockId -> BlockId -> BlockId
max :: BlockId -> BlockId -> BlockId
$cmax :: BlockId -> BlockId -> BlockId
>= :: BlockId -> BlockId -> Bool
$c>= :: BlockId -> BlockId -> Bool
> :: BlockId -> BlockId -> Bool
$c> :: BlockId -> BlockId -> Bool
<= :: BlockId -> BlockId -> Bool
$c<= :: BlockId -> BlockId -> Bool
< :: BlockId -> BlockId -> Bool
$c< :: BlockId -> BlockId -> Bool
compare :: BlockId -> BlockId -> Ordering
$ccompare :: BlockId -> BlockId -> Ordering
$cp1Ord :: Eq BlockId
Ord, (forall x. BlockId -> Rep BlockId x)
-> (forall x. Rep BlockId x -> BlockId) -> Generic BlockId
forall x. Rep BlockId x -> BlockId
forall x. BlockId -> Rep BlockId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BlockId x -> BlockId
$cfrom :: forall x. BlockId -> Rep BlockId x
Generic)

-- | Magic value that denotes the hash of the parent of the genesis block
-- (which does not exist). This value is used for serializing
-- the Nothing case of the #parentHeaderHash field.
hashOfNoParent :: Hash "BlockHeader"
hashOfNoParent :: Hash "BlockHeader"
hashOfNoParent = ByteString -> Hash "BlockHeader"
forall (tag :: Symbol). ByteString -> Hash tag
Hash (ByteString -> Hash "BlockHeader")
-> ([Word8] -> ByteString) -> [Word8] -> Hash "BlockHeader"
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack ([Word8] -> Hash "BlockHeader") -> [Word8] -> Hash "BlockHeader"
forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> [Word8]
forall a. Int -> a -> [a]
replicate Int
32 Word8
0

fromMaybeHash :: Maybe (Hash "BlockHeader") -> BlockId
fromMaybeHash :: Maybe (Hash "BlockHeader") -> BlockId
fromMaybeHash = Hash "BlockHeader" -> BlockId
BlockId (Hash "BlockHeader" -> BlockId)
-> (Maybe (Hash "BlockHeader") -> Hash "BlockHeader")
-> Maybe (Hash "BlockHeader")
-> BlockId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash "BlockHeader"
-> Maybe (Hash "BlockHeader") -> Hash "BlockHeader"
forall a. a -> Maybe a -> a
fromMaybe Hash "BlockHeader"
hashOfNoParent

toMaybeHash :: BlockId -> Maybe (Hash "BlockHeader")
toMaybeHash :: BlockId -> Maybe (Hash "BlockHeader")
toMaybeHash (BlockId Hash "BlockHeader"
h) = if Hash "BlockHeader"
h Hash "BlockHeader" -> Hash "BlockHeader" -> Bool
forall a. Eq a => a -> a -> Bool
== Hash "BlockHeader"
hashOfNoParent then Maybe (Hash "BlockHeader")
forall a. Maybe a
Nothing else Hash "BlockHeader" -> Maybe (Hash "BlockHeader")
forall a. a -> Maybe a
Just Hash "BlockHeader"
h

instance PersistField BlockId where
    toPersistValue :: BlockId -> PersistValue
toPersistValue = Text -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (Text -> PersistValue)
-> (BlockId -> Text) -> BlockId -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash "BlockHeader" -> Text
forall a. ToText a => a -> Text
toText (Hash "BlockHeader" -> Text)
-> (BlockId -> Hash "BlockHeader") -> BlockId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockId -> Hash "BlockHeader"
getBlockId
    fromPersistValue :: PersistValue -> Either Text BlockId
fromPersistValue = (Hash "BlockHeader" -> BlockId)
-> Either Text (Hash "BlockHeader") -> Either Text BlockId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Hash "BlockHeader" -> BlockId
BlockId (Either Text (Hash "BlockHeader") -> Either Text BlockId)
-> (PersistValue -> Either Text (Hash "BlockHeader"))
-> PersistValue
-> Either Text BlockId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PersistValue -> Either Text (Hash "BlockHeader")
forall a. FromText a => PersistValue -> Either Text a
fromPersistValueFromText

instance PersistFieldSql BlockId where
    sqlType :: Proxy BlockId -> SqlType
sqlType Proxy BlockId
_ = Proxy Text -> SqlType
forall a. PersistFieldSql a => Proxy a -> SqlType
sqlType (Proxy Text
forall k (t :: k). Proxy t
Proxy @Text)

instance Read BlockId where
    readsPrec :: Int -> ReadS BlockId
readsPrec Int
_ = String -> ReadS BlockId
forall a. HasCallStack => String -> a
error String
"readsPrec stub needed for persistent"

instance ToJSON BlockId where
    toJSON :: BlockId -> Value
toJSON = Text -> Value
String (Text -> Value) -> (BlockId -> Text) -> BlockId -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash "BlockHeader" -> Text
forall a. ToText a => a -> Text
toText (Hash "BlockHeader" -> Text)
-> (BlockId -> Hash "BlockHeader") -> BlockId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockId -> Hash "BlockHeader"
getBlockId

instance FromJSON BlockId where
    parseJSON :: Value -> Parser BlockId
parseJSON = (Hash "BlockHeader" -> BlockId)
-> Parser (Hash "BlockHeader") -> Parser BlockId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Hash "BlockHeader" -> BlockId
BlockId (Parser (Hash "BlockHeader") -> Parser BlockId)
-> (Value -> Parser (Hash "BlockHeader"))
-> Value
-> Parser BlockId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Value -> Parser (Hash "BlockHeader")
forall a. FromText a => String -> Value -> Parser a
aesonFromText String
"BlockId"

instance ToHttpApiData BlockId where
    toUrlPiece :: BlockId -> Text
toUrlPiece = Hash "BlockHeader" -> Text
forall a. ToText a => a -> Text
toText (Hash "BlockHeader" -> Text)
-> (BlockId -> Hash "BlockHeader") -> BlockId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockId -> Hash "BlockHeader"
getBlockId

instance FromHttpApiData BlockId where
    parseUrlPiece :: Text -> Either Text BlockId
parseUrlPiece = (Hash "BlockHeader" -> BlockId)
-> Either Text (Hash "BlockHeader") -> Either Text BlockId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Hash "BlockHeader" -> BlockId
BlockId (Either Text (Hash "BlockHeader") -> Either Text BlockId)
-> (Text -> Either Text (Hash "BlockHeader"))
-> Text
-> Either Text BlockId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text (Hash "BlockHeader")
forall a. FromText a => Text -> Either Text a
fromText'

instance PathPiece BlockId where
    toPathPiece :: BlockId -> Text
toPathPiece = Hash "BlockHeader" -> Text
forall a. ToText a => a -> Text
toText (Hash "BlockHeader" -> Text)
-> (BlockId -> Hash "BlockHeader") -> BlockId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockId -> Hash "BlockHeader"
getBlockId
    fromPathPiece :: Text -> Maybe BlockId
fromPathPiece = (Hash "BlockHeader" -> BlockId)
-> Maybe (Hash "BlockHeader") -> Maybe BlockId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Hash "BlockHeader" -> BlockId
BlockId (Maybe (Hash "BlockHeader") -> Maybe BlockId)
-> (Text -> Maybe (Hash "BlockHeader")) -> Text -> Maybe BlockId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe (Hash "BlockHeader")
forall a. FromText a => Text -> Maybe a
fromTextMaybe

----------------------------------------------------------------------------
-- SlotId

instance PersistFieldSql SlotNo where
    sqlType :: Proxy SlotNo -> SqlType
sqlType Proxy SlotNo
_ = Proxy Word64 -> SqlType
forall a. PersistFieldSql a => Proxy a -> SqlType
sqlType (Proxy Word64
forall k (t :: k). Proxy t
Proxy @Word64)

instance Read SlotNo where
    readsPrec :: Int -> ReadS SlotNo
readsPrec Int
_ = String -> ReadS SlotNo
forall a. HasCallStack => String -> a
error String
"readsPrec stub needed for persistent"

persistSlotNo :: SlotNo -> PersistValue
persistSlotNo :: SlotNo -> PersistValue
persistSlotNo = Word64 -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (Word64 -> PersistValue)
-> (SlotNo -> Word64) -> SlotNo -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotNo -> Word64
unSlotNo

unPersistSlotNo :: PersistValue -> Either Text SlotNo
unPersistSlotNo :: PersistValue -> Either Text SlotNo
unPersistSlotNo = (Word64 -> SlotNo) -> Either Text Word64 -> Either Text SlotNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> SlotNo
SlotNo (Either Text Word64 -> Either Text SlotNo)
-> (PersistValue -> Either Text Word64)
-> PersistValue
-> Either Text SlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PersistValue -> Either Text Word64
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue

instance PersistField SlotNo where
    toPersistValue :: SlotNo -> PersistValue
toPersistValue = SlotNo -> PersistValue
persistSlotNo
    fromPersistValue :: PersistValue -> Either Text SlotNo
fromPersistValue = PersistValue -> Either Text SlotNo
unPersistSlotNo

instance ToHttpApiData SlotNo where
    toUrlPiece :: SlotNo -> Text
toUrlPiece = String -> SlotNo -> Text
forall a. HasCallStack => String -> a
error String
"toUrlPiece stub needed for persistent"
instance FromHttpApiData SlotNo where
    parseUrlPiece :: Text -> Either Text SlotNo
parseUrlPiece = String -> Text -> Either Text SlotNo
forall a. HasCallStack => String -> a
error String
"parseUrlPiece stub needed for persistent"
instance PathPiece SlotNo where
    toPathPiece :: SlotNo -> Text
toPathPiece = String -> SlotNo -> Text
forall a. HasCallStack => String -> a
error String
"toPathPiece stub needed for persistent"
    fromPathPiece :: Text -> Maybe SlotNo
fromPathPiece = String -> Text -> Maybe SlotNo
forall a. HasCallStack => String -> a
error String
"fromPathPiece stub needed for persistent"

----------------------------------------------------------------------------
-- EpochNo

instance PersistFieldSql EpochNo where
    sqlType :: Proxy EpochNo -> SqlType
sqlType Proxy EpochNo
_ = Proxy Word32 -> SqlType
forall a. PersistFieldSql a => Proxy a -> SqlType
sqlType (Proxy Word32
forall k (t :: k). Proxy t
Proxy @Word32)

mkEpochNo :: Word32 -> Either Text EpochNo
mkEpochNo :: Word32 -> Either Text EpochNo
mkEpochNo Word32
n
    | EpochNo -> Bool
isValidEpochNo EpochNo
c = EpochNo -> Either Text EpochNo
forall a b. b -> Either a b
Right EpochNo
c
    | Bool
otherwise = Text -> Either Text EpochNo
forall a b. a -> Either a b
Left (Text -> Either Text EpochNo)
-> (String -> Text) -> String -> Either Text EpochNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Either Text EpochNo) -> String -> Either Text EpochNo
forall a b. (a -> b) -> a -> b
$ String
"not a valid epoch number: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word32 -> String
forall a. Show a => a -> String
show Word32
n
    where c :: EpochNo
c = HasCallStack => Word32 -> EpochNo
Word32 -> EpochNo
unsafeEpochNo Word32
n

persistEpochNo :: EpochNo -> PersistValue
persistEpochNo :: EpochNo -> PersistValue
persistEpochNo = Word32 -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (Word32 -> PersistValue)
-> (EpochNo -> Word32) -> EpochNo -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integral Word31, Num Word32) => Word31 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word31 @Word32 (Word31 -> Word32) -> (EpochNo -> Word31) -> EpochNo -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochNo -> Word31
unEpochNo

instance PersistField EpochNo where
    toPersistValue :: EpochNo -> PersistValue
toPersistValue = EpochNo -> PersistValue
persistEpochNo
    fromPersistValue :: PersistValue -> Either Text EpochNo
fromPersistValue = PersistValue -> Either Text Word32
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue (PersistValue -> Either Text Word32)
-> (Word32 -> Either Text EpochNo)
-> PersistValue
-> Either Text EpochNo
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Word32 -> Either Text EpochNo
mkEpochNo

instance ToHttpApiData EpochNo where
    toUrlPiece :: EpochNo -> Text
toUrlPiece = String -> EpochNo -> Text
forall a. HasCallStack => String -> a
error String
"toUrlPiece stub needed for persistent"
instance FromHttpApiData EpochNo where
    parseUrlPiece :: Text -> Either Text EpochNo
parseUrlPiece = String -> Text -> Either Text EpochNo
forall a. HasCallStack => String -> a
error String
"parseUrlPiece stub needed for persistent"
instance PathPiece EpochNo where
    toPathPiece :: EpochNo -> Text
toPathPiece = String -> EpochNo -> Text
forall a. HasCallStack => String -> a
error String
"toPathPiece stub needed for persistent"
    fromPathPiece :: Text -> Maybe EpochNo
fromPathPiece = String -> Text -> Maybe EpochNo
forall a. HasCallStack => String -> a
error String
"fromPathPiece stub needed for persistent"

----------------------------------------------------------------------------
-- TxStatus

instance PersistField TxStatus where
    toPersistValue :: TxStatus -> PersistValue
toPersistValue = Text -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (Text -> PersistValue)
-> (TxStatus -> Text) -> TxStatus -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxStatus -> Text
forall a. ToText a => a -> Text
toText
    fromPersistValue :: PersistValue -> Either Text TxStatus
fromPersistValue = PersistValue -> Either Text TxStatus
forall a. FromText a => PersistValue -> Either Text a
fromPersistValueFromText

instance PersistFieldSql TxStatus where
    sqlType :: Proxy TxStatus -> SqlType
sqlType Proxy TxStatus
_ = Proxy Text -> SqlType
forall a. PersistFieldSql a => Proxy a -> SqlType
sqlType (Proxy Text
forall k (t :: k). Proxy t
Proxy @Text)

----------------------------------------------------------------------------
-- TxMetadata

instance PersistField TxMetadata where
    toPersistValue :: TxMetadata -> PersistValue
toPersistValue =
        Text -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (Text -> PersistValue)
-> (TxMetadata -> Text) -> TxMetadata -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        ByteString -> Text
decodeUtf8 (ByteString -> Text)
-> (TxMetadata -> ByteString) -> TxMetadata -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        ByteString -> ByteString
BL.toStrict (ByteString -> ByteString)
-> (TxMetadata -> ByteString) -> TxMetadata -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        Value -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode (Value -> ByteString)
-> (TxMetadata -> Value) -> TxMetadata -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        TxMetadataJsonSchema -> TxMetadata -> Value
metadataToJson TxMetadataJsonSchema
TxMetadataJsonDetailedSchema
    fromPersistValue :: PersistValue -> Either Text TxMetadata
fromPersistValue =
        ((TxMetadataJsonError -> Text)
-> Either TxMetadataJsonError TxMetadata -> Either Text TxMetadata
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (String -> Text
T.pack (String -> Text)
-> (TxMetadataJsonError -> String) -> TxMetadataJsonError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxMetadataJsonError -> String
forall e. Error e => e -> String
displayError) (Either TxMetadataJsonError TxMetadata -> Either Text TxMetadata)
-> (Value -> Either TxMetadataJsonError TxMetadata)
-> Value
-> Either Text TxMetadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Either TxMetadataJsonError TxMetadata
metadataFromJsonWithFallback) (Value -> Either Text TxMetadata)
-> (PersistValue -> Either Text Value)
-> PersistValue
-> Either Text TxMetadata
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=<
        ((String -> Text) -> Either String Value -> Either Text Value
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left String -> Text
T.pack (Either String Value -> Either Text Value)
-> (Text -> Either String Value) -> Text -> Either Text Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode (ByteString -> Either String Value)
-> (Text -> ByteString) -> Text -> Either String Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.fromStrict (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8) (Text -> Either Text Value)
-> (PersistValue -> Either Text Text)
-> PersistValue
-> Either Text Value
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=<
        PersistValue -> Either Text Text
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue
      where
        -- FIXME
        -- Because of time constraints, we have had two consecutives releases
        -- of cardano-wallet which ended up using different conversions method
        -- for metadata to/from JSON.
        -- As a result, some users' databases contain metadata using the direct
        -- JSON conversion while we now expect the detailed schema variant.
        --
        -- We do therefore fallback when deserializing data do the direct
        -- conversion (which will then be serialized back using the detailed
        -- schema). We can remove that fallback after some time has passed since
        -- release v2020-09-22.
        metadataFromJsonWithFallback :: Value -> Either TxMetadataJsonError TxMetadata
metadataFromJsonWithFallback Value
json =
            case TxMetadataJsonSchema
-> Value -> Either TxMetadataJsonError TxMetadata
metadataFromJson TxMetadataJsonSchema
TxMetadataJsonDetailedSchema Value
json of
                Right TxMetadata
meta -> TxMetadata -> Either TxMetadataJsonError TxMetadata
forall a b. b -> Either a b
Right TxMetadata
meta
                Left TxMetadataJsonError
e -> case TxMetadataJsonSchema
-> Value -> Either TxMetadataJsonError TxMetadata
metadataFromJson TxMetadataJsonSchema
TxMetadataJsonNoSchema Value
json of
                    Right TxMetadata
meta -> TxMetadata -> Either TxMetadataJsonError TxMetadata
forall a b. b -> Either a b
Right TxMetadata
meta
                    Left{} -> TxMetadataJsonError -> Either TxMetadataJsonError TxMetadata
forall a b. a -> Either a b
Left TxMetadataJsonError
e

instance PersistFieldSql TxMetadata where
    sqlType :: Proxy TxMetadata -> SqlType
sqlType Proxy TxMetadata
_ = Proxy Text -> SqlType
forall a. PersistFieldSql a => Proxy a -> SqlType
sqlType (Proxy Text
forall k (t :: k). Proxy t
Proxy @Text)

----------------------------------------------------------------------------
-- SealedTx - store the serialised tx as a binary blob

instance PersistField SealedTx where
    toPersistValue :: SealedTx -> PersistValue
toPersistValue = ByteString -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (ByteString -> PersistValue)
-> (SealedTx -> ByteString) -> SealedTx -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SealedTx -> ByteString
persistSealedTx
    fromPersistValue :: PersistValue -> Either Text SealedTx
fromPersistValue = PersistValue -> Either Text ByteString
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue (PersistValue -> Either Text ByteString)
-> (ByteString -> Either Text SealedTx)
-> PersistValue
-> Either Text SealedTx
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> ByteString -> Either Text SealedTx
unPersistSealedTx

instance PersistFieldSql SealedTx where
    sqlType :: Proxy SealedTx -> SqlType
sqlType Proxy SealedTx
_ = Proxy ByteString -> SqlType
forall a. PersistFieldSql a => Proxy a -> SqlType
sqlType (Proxy ByteString
forall k (t :: k). Proxy t
Proxy @ByteString)

----------------------------------------------------------------------------
-- Coin

instance PersistField Coin where
    toPersistValue :: Coin -> PersistValue
toPersistValue = Word64 -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (Word64 -> PersistValue)
-> (Coin -> Word64) -> Coin -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Coin -> Word64
Coin -> Word64
Coin.unsafeToWord64
    fromPersistValue :: PersistValue -> Either Text Coin
fromPersistValue = (Word64 -> Coin) -> Either Text Word64 -> Either Text Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> Coin
Coin.fromWord64 (Either Text Word64 -> Either Text Coin)
-> (PersistValue -> Either Text Word64)
-> PersistValue
-> Either Text Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PersistValue -> Either Text Word64
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue

instance PersistFieldSql Coin where
    sqlType :: Proxy Coin -> SqlType
sqlType Proxy Coin
_ = Proxy Word64 -> SqlType
forall a. PersistFieldSql a => Proxy a -> SqlType
sqlType (Proxy Word64
forall k (t :: k). Proxy t
Proxy @Word64)

----------------------------------------------------------------------------
-- Address

instance PersistField Address where
    toPersistValue :: Address -> PersistValue
toPersistValue = Text -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (Text -> PersistValue)
-> (Address -> Text) -> Address -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> Text
forall a. ToText a => a -> Text
toText
    fromPersistValue :: PersistValue -> Either Text Address
fromPersistValue = PersistValue -> Either Text Address
forall a. FromText a => PersistValue -> Either Text a
fromPersistValueFromText

instance PersistFieldSql Address where
    sqlType :: Proxy Address -> SqlType
sqlType Proxy Address
_ = Proxy Text -> SqlType
forall a. PersistFieldSql a => Proxy a -> SqlType
sqlType (Proxy Text
forall k (t :: k). Proxy t
Proxy @Text)

----------------------------------------------------------------------------
-- ScriptHash

instance ToText ScriptHash where
    toText :: ScriptHash -> Text
toText (ScriptHash ByteString
sh) =
        ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Base -> ByteString -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> bout
convertToBase Base
Base16 ByteString
sh

instance FromText ScriptHash where
    fromText :: Text -> Either TextDecodingError ScriptHash
fromText = (String -> TextDecodingError)
-> (ByteString -> ScriptHash)
-> Either String ByteString
-> Either TextDecodingError ScriptHash
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap String -> TextDecodingError
textDecodingError ByteString -> ScriptHash
ScriptHash
        (Either String ByteString -> Either TextDecodingError ScriptHash)
-> (Text -> Either String ByteString)
-> Text
-> Either TextDecodingError ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base -> ByteString -> Either String ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> Either String bout
convertFromBase Base
Base16
        (ByteString -> Either String ByteString)
-> (Text -> ByteString) -> Text -> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8
      where
        textDecodingError :: String -> TextDecodingError
textDecodingError = String -> TextDecodingError
TextDecodingError (String -> TextDecodingError)
-> ShowS -> String -> TextDecodingError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. Show a => a -> String
show

instance PersistField ScriptHash where
    toPersistValue :: ScriptHash -> PersistValue
toPersistValue = Text -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (Text -> PersistValue)
-> (ScriptHash -> Text) -> ScriptHash -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptHash -> Text
forall a. ToText a => a -> Text
toText
    fromPersistValue :: PersistValue -> Either Text ScriptHash
fromPersistValue = PersistValue -> Either Text ScriptHash
forall a. FromText a => PersistValue -> Either Text a
fromPersistValueFromText

instance PersistFieldSql ScriptHash where
    sqlType :: Proxy ScriptHash -> SqlType
sqlType Proxy ScriptHash
_ = Proxy Text -> SqlType
forall a. PersistFieldSql a => Proxy a -> SqlType
sqlType (Proxy Text
forall k (t :: k). Proxy t
Proxy @Text)

----------------------------------------------------------------------------
-- Script Cosigner

instance PersistField (Script Cosigner) where
    toPersistValue :: Script Cosigner -> PersistValue
toPersistValue =
        Text -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (Text -> PersistValue)
-> (Script Cosigner -> Text) -> Script Cosigner -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        ByteString -> Text
decodeUtf8 (ByteString -> Text)
-> (Script Cosigner -> ByteString) -> Script Cosigner -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        ByteString -> ByteString
BL.toStrict (ByteString -> ByteString)
-> (Script Cosigner -> ByteString) -> Script Cosigner -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        Value -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode (Value -> ByteString)
-> (Script Cosigner -> Value) -> Script Cosigner -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        Script Cosigner -> Value
forall a. ToJSON a => a -> Value
toJSON
    fromPersistValue :: PersistValue -> Either Text (Script Cosigner)
fromPersistValue =
        ((String -> Text)
-> Either String (Script Cosigner) -> Either Text (Script Cosigner)
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left String -> Text
T.pack (Either String (Script Cosigner) -> Either Text (Script Cosigner))
-> (Text -> Either String (Script Cosigner))
-> Text
-> Either Text (Script Cosigner)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String (Script Cosigner)
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode (ByteString -> Either String (Script Cosigner))
-> (Text -> ByteString) -> Text -> Either String (Script Cosigner)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.fromStrict (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8) (Text -> Either Text (Script Cosigner))
-> (PersistValue -> Either Text Text)
-> PersistValue
-> Either Text (Script Cosigner)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=<
        PersistValue -> Either Text Text
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue

instance PersistFieldSql (Script Cosigner) where
    sqlType :: Proxy (Script Cosigner) -> SqlType
sqlType Proxy (Script Cosigner)
_ = Proxy Text -> SqlType
forall a. PersistFieldSql a => Proxy a -> SqlType
sqlType (Proxy Text
forall k (t :: k). Proxy t
Proxy @Text)

----------------------------------------------------------------------------
-- CredentialType

instance PersistField CredentialType where
    toPersistValue :: CredentialType -> PersistValue
toPersistValue = Text -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (Text -> PersistValue)
-> (CredentialType -> Text) -> CredentialType -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CredentialType -> Text
forall a. ToText a => a -> Text
toText
    fromPersistValue :: PersistValue -> Either Text CredentialType
fromPersistValue = PersistValue -> Either Text CredentialType
forall a. FromText a => PersistValue -> Either Text a
fromPersistValueFromText

instance PersistFieldSql CredentialType where
    sqlType :: Proxy CredentialType -> SqlType
sqlType Proxy CredentialType
_ = Proxy Text -> SqlType
forall a. PersistFieldSql a => Proxy a -> SqlType
sqlType (Proxy Text
forall k (t :: k). Proxy t
Proxy @Text)

----------------------------------------------------------------------------

----------------------------------------------------------------------------
-- AddressPoolGap

instance PersistField AddressPoolGap where
    toPersistValue :: AddressPoolGap -> PersistValue
toPersistValue = Word32 -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (Word32 -> PersistValue)
-> (AddressPoolGap -> Word32) -> AddressPoolGap -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddressPoolGap -> Word32
getAddressPoolGap
    fromPersistValue :: PersistValue -> Either Text AddressPoolGap
fromPersistValue PersistValue
pv = PersistValue -> Either Text Word32
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue (PersistValue -> Either Text Word32)
-> (Word32 -> Either Text AddressPoolGap)
-> PersistValue
-> Either Text AddressPoolGap
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Word32 -> Either Text AddressPoolGap
mkAddressPoolGap' (PersistValue -> Either Text AddressPoolGap)
-> PersistValue -> Either Text AddressPoolGap
forall a b. (a -> b) -> a -> b
$ PersistValue
pv
      where
        mkAddressPoolGap' :: Word32 -> Either Text AddressPoolGap
        mkAddressPoolGap' :: Word32 -> Either Text AddressPoolGap
mkAddressPoolGap' = (MkAddressPoolGapError -> Text)
-> Either MkAddressPoolGapError AddressPoolGap
-> Either Text AddressPoolGap
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first MkAddressPoolGapError -> Text
forall a. Show a => a -> Text
msg (Either MkAddressPoolGapError AddressPoolGap
 -> Either Text AddressPoolGap)
-> (Word32 -> Either MkAddressPoolGapError AddressPoolGap)
-> Word32
-> Either Text AddressPoolGap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Either MkAddressPoolGapError AddressPoolGap
mkAddressPoolGap (Integer -> Either MkAddressPoolGapError AddressPoolGap)
-> (Word32 -> Integer)
-> Word32
-> Either MkAddressPoolGapError AddressPoolGap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
        msg :: a -> Text
msg a
e = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"not a valid value: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> PersistValue -> String
forall a. Show a => a -> String
show PersistValue
pv String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
e

instance PersistFieldSql AddressPoolGap where
    sqlType :: Proxy AddressPoolGap -> SqlType
sqlType Proxy AddressPoolGap
_ = Proxy Word32 -> SqlType
forall a. PersistFieldSql a => Proxy a -> SqlType
sqlType (Proxy Word32
forall k (t :: k). Proxy t
Proxy @Word32)

----------------------------------------------------------------------------
-- Role

instance PersistField Role where
    toPersistValue :: Role -> PersistValue
toPersistValue = Text -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (Text -> PersistValue) -> (Role -> Text) -> Role -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Role -> Text
forall a. ToText a => a -> Text
toText
    fromPersistValue :: PersistValue -> Either Text Role
fromPersistValue = PersistValue -> Either Text Role
forall a. FromText a => PersistValue -> Either Text a
fromPersistValueFromText

instance PersistFieldSql Role where
    sqlType :: Proxy Role -> SqlType
sqlType Proxy Role
_ = Proxy Text -> SqlType
forall a. PersistFieldSql a => Proxy a -> SqlType
sqlType (Proxy Text
forall k (t :: k). Proxy t
Proxy @Text)

----------------------------------------------------------------------------
-- StdGen

instance PersistFieldSql StdGen where
    sqlType :: Proxy StdGen -> SqlType
sqlType Proxy StdGen
_ = Proxy Text -> SqlType
forall a. PersistFieldSql a => Proxy a -> SqlType
sqlType (Proxy Text
forall k (t :: k). Proxy t
Proxy @Text)

instance PersistField StdGen where
    toPersistValue :: StdGen -> PersistValue
toPersistValue = String -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (String -> PersistValue)
-> (StdGen -> String) -> StdGen -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StdGen -> String
stdGenToString
    fromPersistValue :: PersistValue -> Either Text StdGen
fromPersistValue = PersistValue -> Either Text String
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue (PersistValue -> Either Text String)
-> (String -> Either Text StdGen)
-> PersistValue
-> Either Text StdGen
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> String -> Either Text StdGen
stdGenFromString

-- | In @random < 1.2@ there used to be an @instance Read StdGen@, but no
-- longer.
--
-- The format used to look like this:
-- @
-- 5889121503043413025 17512980752375952679
-- @
stdGenFromString :: String -> Either Text StdGen
stdGenFromString :: String -> Either Text StdGen
stdGenFromString String
s = case (String -> Maybe Word64) -> [String] -> [Word64]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe Word64
forall a. Read a => String -> Maybe a
readMaybe (String -> [String]
words String
s) of
    [Word64
i, Word64
j] -> StdGen -> Either Text StdGen
forall a b. b -> Either a b
Right (StdGen -> Either Text StdGen) -> StdGen -> Either Text StdGen
forall a b. (a -> b) -> a -> b
$ SMGen -> StdGen
StdGen (SMGen -> StdGen) -> SMGen -> StdGen
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> SMGen
seedSMGen Word64
i Word64
j
    [Word64]
_ -> Text -> Either Text StdGen
forall a b. a -> Either a b
Left Text
"StdGen should be formatted as two space-separated integers"

-- | Equivalent to the old @random < 1.2@ 'StdGen' 'Show' instance.
stdGenToString :: StdGen -> String
stdGenToString :: StdGen -> String
stdGenToString (StdGen (SMGen -> (Word64, Word64)
unseedSMGen -> (Word64
i, Word64
j))) = [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Word64 -> String) -> [Word64] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Word64 -> String
forall a. Show a => a -> String
show [Word64
i, Word64
j]

----------------------------------------------------------------------------
-- PoolId

instance PersistField PoolId where
    toPersistValue :: PoolId -> PersistValue
toPersistValue = Text -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (Text -> PersistValue)
-> (PoolId -> Text) -> PoolId -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoolId -> Text
forall a. ToText a => a -> Text
toText
    fromPersistValue :: PersistValue -> Either Text PoolId
fromPersistValue = PersistValue -> Either Text PoolId
forall a. FromText a => PersistValue -> Either Text a
fromPersistValueFromText

instance PersistFieldSql PoolId where
    sqlType :: Proxy PoolId -> SqlType
sqlType Proxy PoolId
_ = Proxy Text -> SqlType
forall a. PersistFieldSql a => Proxy a -> SqlType
sqlType (Proxy Text
forall k (t :: k). Proxy t
Proxy @Text)

instance Read PoolId where
    readsPrec :: Int -> ReadS PoolId
readsPrec Int
_ = String -> ReadS PoolId
forall a. HasCallStack => String -> a
error String
"readsPrec stub needed for persistent"

instance PathPiece PoolId where
    fromPathPiece :: Text -> Maybe PoolId
fromPathPiece = Text -> Maybe PoolId
forall a. FromText a => Text -> Maybe a
fromTextMaybe
    toPathPiece :: PoolId -> Text
toPathPiece = PoolId -> Text
forall a. ToText a => a -> Text
toText

instance ToJSON PoolId where
    toJSON :: PoolId -> Value
toJSON = Text -> Value
String (Text -> Value) -> (PoolId -> Text) -> PoolId -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoolId -> Text
forall a. ToText a => a -> Text
toText

instance FromJSON PoolId where
    parseJSON :: Value -> Parser PoolId
parseJSON = String -> Value -> Parser PoolId
forall a. FromText a => String -> Value -> Parser a
aesonFromText String
"PoolId"

instance ToHttpApiData PoolId where
    toUrlPiece :: PoolId -> Text
toUrlPiece = String -> PoolId -> Text
forall a. HasCallStack => String -> a
error String
"toUrlPiece stub needed for persistent"

instance FromHttpApiData PoolId where
    parseUrlPiece :: Text -> Either Text PoolId
parseUrlPiece = String -> Text -> Either Text PoolId
forall a. HasCallStack => String -> a
error String
"parseUrlPiece stub needed for persistent"

----------------------------------------------------------------------------
-- PoolOwner

instance PersistField PoolOwner where
    toPersistValue :: PoolOwner -> PersistValue
toPersistValue = Text -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (Text -> PersistValue)
-> (PoolOwner -> Text) -> PoolOwner -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoolOwner -> Text
forall a. ToText a => a -> Text
toText
    fromPersistValue :: PersistValue -> Either Text PoolOwner
fromPersistValue = PersistValue -> Either Text PoolOwner
forall a. FromText a => PersistValue -> Either Text a
fromPersistValueFromText

instance PersistFieldSql PoolOwner where
    sqlType :: Proxy PoolOwner -> SqlType
sqlType Proxy PoolOwner
_ = Proxy Text -> SqlType
forall a. PersistFieldSql a => Proxy a -> SqlType
sqlType (Proxy Text
forall k (t :: k). Proxy t
Proxy @Text)

instance Read PoolOwner where
    readsPrec :: Int -> ReadS PoolOwner
readsPrec Int
_ = String -> ReadS PoolOwner
forall a. HasCallStack => String -> a
error String
"readsPrec stub needed for persistent"

instance FromText [PoolOwner] where
    fromText :: Text -> Either TextDecodingError [PoolOwner]
fromText Text
t = (Text -> Either TextDecodingError PoolOwner)
-> [Text] -> Either TextDecodingError [PoolOwner]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> Either TextDecodingError PoolOwner
forall a. FromText a => Text -> Either TextDecodingError a
fromText ([Text] -> Either TextDecodingError [PoolOwner])
-> [Text] -> Either TextDecodingError [PoolOwner]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.words Text
t

instance PersistField [PoolOwner] where
    toPersistValue :: [PoolOwner] -> PersistValue
toPersistValue [PoolOwner]
v = Text -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (Text -> PersistValue) -> Text -> PersistValue
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ PoolOwner -> Text
forall a. ToText a => a -> Text
toText (PoolOwner -> Text) -> [PoolOwner] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PoolOwner]
v
    fromPersistValue :: PersistValue -> Either Text [PoolOwner]
fromPersistValue = PersistValue -> Either Text [PoolOwner]
forall a. FromText a => PersistValue -> Either Text a
fromPersistValueFromText

instance PersistFieldSql [PoolOwner] where
    sqlType :: Proxy [PoolOwner] -> SqlType
sqlType Proxy [PoolOwner]
_ = Proxy Text -> SqlType
forall a. PersistFieldSql a => Proxy a -> SqlType
sqlType (Proxy Text
forall k (t :: k). Proxy t
Proxy @Text)

----------------------------------------------------------------------------
-- HDPassphrase

newtype HDPassphrase = HDPassphrase (Passphrase "addr-derivation-payload")
    deriving ((forall x. HDPassphrase -> Rep HDPassphrase x)
-> (forall x. Rep HDPassphrase x -> HDPassphrase)
-> Generic HDPassphrase
forall x. Rep HDPassphrase x -> HDPassphrase
forall x. HDPassphrase -> Rep HDPassphrase x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HDPassphrase x -> HDPassphrase
$cfrom :: forall x. HDPassphrase -> Rep HDPassphrase x
Generic, Int -> HDPassphrase -> ShowS
[HDPassphrase] -> ShowS
HDPassphrase -> String
(Int -> HDPassphrase -> ShowS)
-> (HDPassphrase -> String)
-> ([HDPassphrase] -> ShowS)
-> Show HDPassphrase
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HDPassphrase] -> ShowS
$cshowList :: [HDPassphrase] -> ShowS
show :: HDPassphrase -> String
$cshow :: HDPassphrase -> String
showsPrec :: Int -> HDPassphrase -> ShowS
$cshowsPrec :: Int -> HDPassphrase -> ShowS
Show)

instance PersistField HDPassphrase where
    toPersistValue :: HDPassphrase -> PersistValue
toPersistValue (HDPassphrase (Passphrase ScrubbedBytes
pwd)) =
        ByteString -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (Base -> ScrubbedBytes -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> bout
convertToBase @_ @ByteString Base
Base16 ScrubbedBytes
pwd)
    fromPersistValue :: PersistValue -> Either Text HDPassphrase
fromPersistValue = PersistValue -> Either Text ByteString
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue (PersistValue -> Either Text ByteString)
-> (ByteString -> Either Text HDPassphrase)
-> PersistValue
-> Either Text HDPassphrase
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
        (ScrubbedBytes -> HDPassphrase)
-> Either Text ScrubbedBytes -> Either Text HDPassphrase
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Passphrase "addr-derivation-payload" -> HDPassphrase
HDPassphrase (Passphrase "addr-derivation-payload" -> HDPassphrase)
-> (ScrubbedBytes -> Passphrase "addr-derivation-payload")
-> ScrubbedBytes
-> HDPassphrase
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScrubbedBytes -> Passphrase "addr-derivation-payload"
forall (purpose :: Symbol). ScrubbedBytes -> Passphrase purpose
Passphrase)
        (Either Text ScrubbedBytes -> Either Text HDPassphrase)
-> (ByteString -> Either Text ScrubbedBytes)
-> ByteString
-> Either Text HDPassphrase
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Text)
-> Either String ScrubbedBytes -> Either Text ScrubbedBytes
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left String -> Text
T.pack
        (Either String ScrubbedBytes -> Either Text ScrubbedBytes)
-> (ByteString -> Either String ScrubbedBytes)
-> ByteString
-> Either Text ScrubbedBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base -> ByteString -> Either String ScrubbedBytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> Either String bout
convertFromBase @ByteString Base
Base16

instance PersistFieldSql HDPassphrase where
    sqlType :: Proxy HDPassphrase -> SqlType
sqlType Proxy HDPassphrase
_ = Proxy ByteString -> SqlType
forall a. PersistFieldSql a => Proxy a -> SqlType
sqlType (Proxy ByteString
forall k (t :: k). Proxy t
Proxy @ByteString)

instance Read HDPassphrase where
    readsPrec :: Int -> ReadS HDPassphrase
readsPrec Int
_ = String -> ReadS HDPassphrase
forall a. HasCallStack => String -> a
error String
"readsPrec stub needed for persistent"

----------------------------------------------------------------------------
-- PassphraseScheme
--

instance PersistField PassphraseScheme where
    toPersistValue :: PassphraseScheme -> PersistValue
toPersistValue = String -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (String -> PersistValue)
-> (PassphraseScheme -> String) -> PassphraseScheme -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PassphraseScheme -> String
forall a. Show a => a -> String
show
    fromPersistValue :: PersistValue -> Either Text PassphraseScheme
fromPersistValue = PersistValue -> Either Text String
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue (PersistValue -> Either Text String)
-> (String -> Either Text PassphraseScheme)
-> PersistValue
-> Either Text PassphraseScheme
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> PassphraseScheme -> Either Text PassphraseScheme
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PassphraseScheme -> Either Text PassphraseScheme)
-> (String -> PassphraseScheme)
-> String
-> Either Text PassphraseScheme
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PassphraseScheme
forall a. Read a => String -> a
read

instance PersistFieldSql PassphraseScheme where
    sqlType :: Proxy PassphraseScheme -> SqlType
sqlType Proxy PassphraseScheme
_ = Proxy String -> SqlType
forall a. PersistFieldSql a => Proxy a -> SqlType
sqlType (Proxy String
forall k (t :: k). Proxy t
Proxy @String)

----------------------------------------------------------------------------
-- StakePoolTicker

instance PersistField StakePoolTicker where
    toPersistValue :: StakePoolTicker -> PersistValue
toPersistValue = Text -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (Text -> PersistValue)
-> (StakePoolTicker -> Text) -> StakePoolTicker -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StakePoolTicker -> Text
forall a. ToText a => a -> Text
toText
    fromPersistValue :: PersistValue -> Either Text StakePoolTicker
fromPersistValue = PersistValue -> Either Text StakePoolTicker
forall a. FromText a => PersistValue -> Either Text a
fromPersistValueFromText

instance PersistFieldSql StakePoolTicker where
    sqlType :: Proxy StakePoolTicker -> SqlType
sqlType Proxy StakePoolTicker
_ = Proxy Text -> SqlType
forall a. PersistFieldSql a => Proxy a -> SqlType
sqlType (Proxy Text
forall k (t :: k). Proxy t
Proxy @Text)

----------------------------------------------------------------------------
-- StakePoolMetadataHash

instance PersistField StakePoolMetadataHash where
    toPersistValue :: StakePoolMetadataHash -> PersistValue
toPersistValue = Text -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (Text -> PersistValue)
-> (StakePoolMetadataHash -> Text)
-> StakePoolMetadataHash
-> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StakePoolMetadataHash -> Text
forall a. ToText a => a -> Text
toText
    fromPersistValue :: PersistValue -> Either Text StakePoolMetadataHash
fromPersistValue = PersistValue -> Either Text StakePoolMetadataHash
forall a. FromText a => PersistValue -> Either Text a
fromPersistValueFromText

instance PersistFieldSql StakePoolMetadataHash where
    sqlType :: Proxy StakePoolMetadataHash -> SqlType
sqlType Proxy StakePoolMetadataHash
_ = Proxy Text -> SqlType
forall a. PersistFieldSql a => Proxy a -> SqlType
sqlType (Proxy Text
forall k (t :: k). Proxy t
Proxy @Text)

instance Read StakePoolMetadataHash where
    readsPrec :: Int -> ReadS StakePoolMetadataHash
readsPrec Int
_ = String -> ReadS StakePoolMetadataHash
forall a. HasCallStack => String -> a
error String
"readsPrec stub needed for persistent"

instance ToHttpApiData StakePoolMetadataHash where
    toUrlPiece :: StakePoolMetadataHash -> Text
toUrlPiece = StakePoolMetadataHash -> Text
forall a. ToText a => a -> Text
toText

instance FromHttpApiData StakePoolMetadataHash where
    parseUrlPiece :: Text -> Either Text StakePoolMetadataHash
parseUrlPiece = Text -> Either Text StakePoolMetadataHash
forall a. FromText a => Text -> Either Text a
fromText'

instance ToJSON StakePoolMetadataHash where
    toJSON :: StakePoolMetadataHash -> Value
toJSON = Text -> Value
String (Text -> Value)
-> (StakePoolMetadataHash -> Text)
-> StakePoolMetadataHash
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StakePoolMetadataHash -> Text
forall a. ToText a => a -> Text
toText

instance FromJSON StakePoolMetadataHash where
    parseJSON :: Value -> Parser StakePoolMetadataHash
parseJSON = String -> Value -> Parser StakePoolMetadataHash
forall a. FromText a => String -> Value -> Parser a
aesonFromText String
"StakePoolMetadataHash"

instance PathPiece StakePoolMetadataHash where
    fromPathPiece :: Text -> Maybe StakePoolMetadataHash
fromPathPiece = Text -> Maybe StakePoolMetadataHash
forall a. FromText a => Text -> Maybe a
fromTextMaybe
    toPathPiece :: StakePoolMetadataHash -> Text
toPathPiece = StakePoolMetadataHash -> Text
forall a. ToText a => a -> Text
toText


----------------------------------------------------------------------------
-- StakePoolMetadataUrl


instance PersistField StakePoolMetadataUrl where
    toPersistValue :: StakePoolMetadataUrl -> PersistValue
toPersistValue = Text -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (Text -> PersistValue)
-> (StakePoolMetadataUrl -> Text)
-> StakePoolMetadataUrl
-> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StakePoolMetadataUrl -> Text
forall a. ToText a => a -> Text
toText
    fromPersistValue :: PersistValue -> Either Text StakePoolMetadataUrl
fromPersistValue = PersistValue -> Either Text StakePoolMetadataUrl
forall a. FromText a => PersistValue -> Either Text a
fromPersistValueFromText

instance PersistFieldSql StakePoolMetadataUrl where
    sqlType :: Proxy StakePoolMetadataUrl -> SqlType
sqlType Proxy StakePoolMetadataUrl
_ = Proxy Text -> SqlType
forall a. PersistFieldSql a => Proxy a -> SqlType
sqlType (Proxy Text
forall k (t :: k). Proxy t
Proxy @Text)

instance Read StakePoolMetadataUrl where
    readsPrec :: Int -> ReadS StakePoolMetadataUrl
readsPrec Int
_ = String -> ReadS StakePoolMetadataUrl
forall a. HasCallStack => String -> a
error String
"readsPrec stub needed for persistent"

instance ToHttpApiData StakePoolMetadataUrl where
    toUrlPiece :: StakePoolMetadataUrl -> Text
toUrlPiece = StakePoolMetadataUrl -> Text
forall a. ToText a => a -> Text
toText

instance FromHttpApiData StakePoolMetadataUrl where
    parseUrlPiece :: Text -> Either Text StakePoolMetadataUrl
parseUrlPiece = Text -> Either Text StakePoolMetadataUrl
forall a. FromText a => Text -> Either Text a
fromText'

instance ToJSON StakePoolMetadataUrl where
    toJSON :: StakePoolMetadataUrl -> Value
toJSON = Text -> Value
String (Text -> Value)
-> (StakePoolMetadataUrl -> Text) -> StakePoolMetadataUrl -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StakePoolMetadataUrl -> Text
forall a. ToText a => a -> Text
toText

instance FromJSON StakePoolMetadataUrl where
    parseJSON :: Value -> Parser StakePoolMetadataUrl
parseJSON = String -> Value -> Parser StakePoolMetadataUrl
forall a. FromText a => String -> Value -> Parser a
aesonFromText String
"StakePoolMetadataUrl"

instance PathPiece StakePoolMetadataUrl where
    fromPathPiece :: Text -> Maybe StakePoolMetadataUrl
fromPathPiece = Text -> Maybe StakePoolMetadataUrl
forall a. FromText a => Text -> Maybe a
fromTextMaybe
    toPathPiece :: StakePoolMetadataUrl -> Text
toPathPiece = StakePoolMetadataUrl -> Text
forall a. ToText a => a -> Text
toText

----------------------------------------------------------------------------
-- RewardAccount

instance PersistField RewardAccount where
    toPersistValue :: RewardAccount -> PersistValue
toPersistValue = Text -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (Text -> PersistValue)
-> (RewardAccount -> Text) -> RewardAccount -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RewardAccount -> Text
forall a. ToText a => a -> Text
toText
    fromPersistValue :: PersistValue -> Either Text RewardAccount
fromPersistValue = PersistValue -> Either Text RewardAccount
forall a. FromText a => PersistValue -> Either Text a
fromPersistValueFromText

instance PersistFieldSql RewardAccount where
    sqlType :: Proxy RewardAccount -> SqlType
sqlType Proxy RewardAccount
_ = Proxy Text -> SqlType
forall a. PersistFieldSql a => Proxy a -> SqlType
sqlType (Proxy Text
forall k (t :: k). Proxy t
Proxy @Text)

instance ToHttpApiData RewardAccount where
    toUrlPiece :: RewardAccount -> Text
toUrlPiece = RewardAccount -> Text
forall a. ToText a => a -> Text
toText

instance FromHttpApiData RewardAccount where
    parseUrlPiece :: Text -> Either Text RewardAccount
parseUrlPiece = Text -> Either Text RewardAccount
forall a. FromText a => Text -> Either Text a
fromText'

instance ToJSON RewardAccount where
    toJSON :: RewardAccount -> Value
toJSON = Text -> Value
String (Text -> Value)
-> (RewardAccount -> Text) -> RewardAccount -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RewardAccount -> Text
forall a. ToText a => a -> Text
toText

instance FromJSON RewardAccount where
    parseJSON :: Value -> Parser RewardAccount
parseJSON = String -> Value -> Parser RewardAccount
forall a. FromText a => String -> Value -> Parser a
aesonFromText String
"RewardAccount"

instance PathPiece RewardAccount where
    fromPathPiece :: Text -> Maybe RewardAccount
fromPathPiece = Text -> Maybe RewardAccount
forall a. FromText a => Text -> Maybe a
fromTextMaybe
    toPathPiece :: RewardAccount -> Text
toPathPiece = RewardAccount -> Text
forall a. ToText a => a -> Text
toText

----------------------------------------------------------------------------
-- AddressState

instance PersistField AddressState where
    toPersistValue :: AddressState -> PersistValue
toPersistValue = Text -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (Text -> PersistValue)
-> (AddressState -> Text) -> AddressState -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddressState -> Text
forall a. ToText a => a -> Text
toText
    fromPersistValue :: PersistValue -> Either Text AddressState
fromPersistValue = PersistValue -> Either Text AddressState
forall a. FromText a => PersistValue -> Either Text a
fromPersistValueFromText

instance PersistFieldSql AddressState where
    sqlType :: Proxy AddressState -> SqlType
sqlType Proxy AddressState
_ = Proxy Text -> SqlType
forall a. PersistFieldSql a => Proxy a -> SqlType
sqlType (Proxy Text
forall k (t :: k). Proxy t
Proxy @Text)

----------------------------------------------------------------------------
-- PoolMetadataSource


instance PersistField PoolMetadataSource where
    toPersistValue :: PoolMetadataSource -> PersistValue
toPersistValue = Text -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (Text -> PersistValue)
-> (PoolMetadataSource -> Text)
-> PoolMetadataSource
-> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoolMetadataSource -> Text
forall a. ToText a => a -> Text
toText
    -- be more permissive than fromText here
    fromPersistValue :: PersistValue -> Either Text PoolMetadataSource
fromPersistValue = PersistValue -> Either Text String
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue
        (PersistValue -> Either Text String)
-> (String -> Either Text PoolMetadataSource)
-> PersistValue
-> Either Text PoolMetadataSource
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \case
            String
"none" -> PoolMetadataSource -> Either Text PoolMetadataSource
forall a b. b -> Either a b
Right PoolMetadataSource
FetchNone
            String
"direct" -> PoolMetadataSource -> Either Text PoolMetadataSource
forall a b. b -> Either a b
Right PoolMetadataSource
FetchDirect
            String
uri -> (URI -> PoolMetadataSource)
-> Either Text URI -> Either Text PoolMetadataSource
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap URI -> PoolMetadataSource
unsafeToPMS
                (Either Text URI -> Either Text PoolMetadataSource)
-> (String -> Either Text URI)
-> String
-> Either Text PoolMetadataSource
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either Text URI
-> (URI -> Either Text URI) -> Maybe URI -> Either Text URI
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Either Text URI
forall a b. a -> Either a b
Left Text
"Not an absolute URI") URI -> Either Text URI
forall a b. b -> Either a b
Right
                (Maybe URI -> Either Text URI)
-> (String -> Maybe URI) -> String -> Either Text URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe URI
parseAbsoluteURI
                (String -> Either Text PoolMetadataSource)
-> String -> Either Text PoolMetadataSource
forall a b. (a -> b) -> a -> b
$ String
uri

instance PersistFieldSql PoolMetadataSource where
    sqlType :: Proxy PoolMetadataSource -> SqlType
sqlType Proxy PoolMetadataSource
_ = Proxy Text -> SqlType
forall a. PersistFieldSql a => Proxy a -> SqlType
sqlType (Proxy Text
forall k (t :: k). Proxy t
Proxy @Text)

----------------------------------------------------------------------------
-- DerivationPrefix

instance PersistField DerivationPrefix where
    toPersistValue :: DerivationPrefix -> PersistValue
toPersistValue = Text -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (Text -> PersistValue)
-> (DerivationPrefix -> Text) -> DerivationPrefix -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DerivationPrefix -> Text
forall a. ToText a => a -> Text
toText
    fromPersistValue :: PersistValue -> Either Text DerivationPrefix
fromPersistValue = PersistValue -> Either Text DerivationPrefix
forall a. FromText a => PersistValue -> Either Text a
fromPersistValueFromText

instance PersistFieldSql DerivationPrefix where
    sqlType :: Proxy DerivationPrefix -> SqlType
sqlType Proxy DerivationPrefix
_ = Proxy Text -> SqlType
forall a. PersistFieldSql a => Proxy a -> SqlType
sqlType (Proxy Text
forall k (t :: k). Proxy t
Proxy @Text)

----------------------------------------------------------------------------
-- ScriptValidation

instance PersistField TxScriptValidity where
    toPersistValue :: TxScriptValidity -> PersistValue
toPersistValue = \case
        TxScriptValidity
TxScriptValid -> Bool -> PersistValue
PersistBool Bool
True
        TxScriptValidity
TxScriptInvalid -> Bool -> PersistValue
PersistBool Bool
False

    fromPersistValue :: PersistValue -> Either Text TxScriptValidity
fromPersistValue = \case
        PersistBool Bool
True -> TxScriptValidity -> Either Text TxScriptValidity
forall a b. b -> Either a b
Right TxScriptValidity
TxScriptValid
        PersistBool Bool
False -> TxScriptValidity -> Either Text TxScriptValidity
forall a b. b -> Either a b
Right TxScriptValidity
TxScriptInvalid
        PersistValue
x -> Text -> Either Text TxScriptValidity
forall a b. a -> Either a b
Left (Text -> Either Text TxScriptValidity)
-> Text -> Either Text TxScriptValidity
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords
            [ Text
"Failed to parse Haskell type `TxScriptValidity`;"
            , Text
"expected null or boolean"
            , Text
"from database, but received:"
            , String -> Text
T.pack (PersistValue -> String
forall a. Show a => a -> String
show PersistValue
x)
            ]

instance PersistFieldSql TxScriptValidity where
    sqlType :: Proxy TxScriptValidity -> SqlType
sqlType Proxy TxScriptValidity
_ = Proxy (Maybe Bool) -> SqlType
forall a. PersistFieldSql a => Proxy a -> SqlType
sqlType (Proxy (Maybe Bool)
forall k (t :: k). Proxy t
Proxy @(Maybe Bool))

----------------------------------------------------------------------------
-- Other

instance PersistField POSIXTime where
    toPersistValue :: POSIXTime -> PersistValue
toPersistValue = Text -> PersistValue
PersistText
        (Text -> PersistValue)
-> (POSIXTime -> Text) -> POSIXTime -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
        (String -> Text) -> (POSIXTime -> String) -> POSIXTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale (Maybe String -> String
iso8601DateFormat (String -> Maybe String
forall a. a -> Maybe a
Just String
"%H:%M:%S"))
        (UTCTime -> String)
-> (POSIXTime -> UTCTime) -> POSIXTime -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> UTCTime
posixSecondsToUTCTime
    fromPersistValue :: PersistValue -> Either Text POSIXTime
fromPersistValue (PersistText Text
time) =
        UTCTime -> POSIXTime
utcTimeToPOSIXSeconds (UTCTime -> POSIXTime)
-> Either Text UTCTime -> Either Text POSIXTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            EitherText UTCTime -> Either Text UTCTime
forall a. EitherText a -> Either Text a
getEitherText (Bool -> TimeLocale -> String -> String -> EitherText UTCTime
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale
                (Maybe String -> String
iso8601DateFormat (String -> Maybe String
forall a. a -> Maybe a
Just String
"%H:%M:%S")) (Text -> String
T.unpack Text
time))
    fromPersistValue PersistValue
_ = Text -> Either Text POSIXTime
forall a b. a -> Either a b
Left
        Text
"Could not parse POSIX time value"

instance PersistFieldSql POSIXTime where
    sqlType :: Proxy POSIXTime -> SqlType
sqlType Proxy POSIXTime
_ = Proxy Text -> SqlType
forall a. PersistFieldSql a => Proxy a -> SqlType
sqlType (Proxy Text
forall k (t :: k). Proxy t
Proxy @Text)

-- | Newtype to get a MonadFail instance for @Either Text@.
--
-- We need it to use @parseTimeM@.
newtype EitherText a = EitherText { EitherText a -> Either Text a
getEitherText :: Either Text a }
    deriving (a -> EitherText b -> EitherText a
(a -> b) -> EitherText a -> EitherText b
(forall a b. (a -> b) -> EitherText a -> EitherText b)
-> (forall a b. a -> EitherText b -> EitherText a)
-> Functor EitherText
forall a b. a -> EitherText b -> EitherText a
forall a b. (a -> b) -> EitherText a -> EitherText b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> EitherText b -> EitherText a
$c<$ :: forall a b. a -> EitherText b -> EitherText a
fmap :: (a -> b) -> EitherText a -> EitherText b
$cfmap :: forall a b. (a -> b) -> EitherText a -> EitherText b
Functor, Functor EitherText
a -> EitherText a
Functor EitherText
-> (forall a. a -> EitherText a)
-> (forall a b.
    EitherText (a -> b) -> EitherText a -> EitherText b)
-> (forall a b c.
    (a -> b -> c) -> EitherText a -> EitherText b -> EitherText c)
-> (forall a b. EitherText a -> EitherText b -> EitherText b)
-> (forall a b. EitherText a -> EitherText b -> EitherText a)
-> Applicative EitherText
EitherText a -> EitherText b -> EitherText b
EitherText a -> EitherText b -> EitherText a
EitherText (a -> b) -> EitherText a -> EitherText b
(a -> b -> c) -> EitherText a -> EitherText b -> EitherText c
forall a. a -> EitherText a
forall a b. EitherText a -> EitherText b -> EitherText a
forall a b. EitherText a -> EitherText b -> EitherText b
forall a b. EitherText (a -> b) -> EitherText a -> EitherText b
forall a b c.
(a -> b -> c) -> EitherText a -> EitherText b -> EitherText c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: EitherText a -> EitherText b -> EitherText a
$c<* :: forall a b. EitherText a -> EitherText b -> EitherText a
*> :: EitherText a -> EitherText b -> EitherText b
$c*> :: forall a b. EitherText a -> EitherText b -> EitherText b
liftA2 :: (a -> b -> c) -> EitherText a -> EitherText b -> EitherText c
$cliftA2 :: forall a b c.
(a -> b -> c) -> EitherText a -> EitherText b -> EitherText c
<*> :: EitherText (a -> b) -> EitherText a -> EitherText b
$c<*> :: forall a b. EitherText (a -> b) -> EitherText a -> EitherText b
pure :: a -> EitherText a
$cpure :: forall a. a -> EitherText a
$cp1Applicative :: Functor EitherText
Applicative, Applicative EitherText
a -> EitherText a
Applicative EitherText
-> (forall a b.
    EitherText a -> (a -> EitherText b) -> EitherText b)
-> (forall a b. EitherText a -> EitherText b -> EitherText b)
-> (forall a. a -> EitherText a)
-> Monad EitherText
EitherText a -> (a -> EitherText b) -> EitherText b
EitherText a -> EitherText b -> EitherText b
forall a. a -> EitherText a
forall a b. EitherText a -> EitherText b -> EitherText b
forall a b. EitherText a -> (a -> EitherText b) -> EitherText b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> EitherText a
$creturn :: forall a. a -> EitherText a
>> :: EitherText a -> EitherText b -> EitherText b
$c>> :: forall a b. EitherText a -> EitherText b -> EitherText b
>>= :: EitherText a -> (a -> EitherText b) -> EitherText b
$c>>= :: forall a b. EitherText a -> (a -> EitherText b) -> EitherText b
$cp1Monad :: Applicative EitherText
Monad) via (Either Text)

instance MonadFail EitherText where
    fail :: String -> EitherText a
fail = Either Text a -> EitherText a
forall a. Either Text a -> EitherText a
EitherText (Either Text a -> EitherText a)
-> (String -> Either Text a) -> String -> EitherText a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text a
forall a b. a -> Either a b
Left (Text -> Either Text a)
-> (String -> Text) -> String -> Either Text a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack