{-# LANGUAGE PatternSynonyms #-}
module Cardano.Crypto.Wallet.Types
    ( ChainCode(..)
    , DerivationScheme(..)
    , DerivationIndex
    , pattern LatestScheme
    ) where

import           Control.DeepSeq (NFData)
import           Data.ByteArray  (ByteArrayAccess)
import           Data.ByteString (ByteString)
import           Data.Hashable   (Hashable)

import Foundation
import Foundation.Collection (nonEmpty_)
import Foundation.Check (Arbitrary(..), frequency)

type DerivationIndex = Word32

data DerivationScheme = DerivationScheme1 | DerivationScheme2
    deriving (Int -> DerivationScheme -> ShowS
[DerivationScheme] -> ShowS
DerivationScheme -> String
(Int -> DerivationScheme -> ShowS)
-> (DerivationScheme -> String)
-> ([DerivationScheme] -> ShowS)
-> Show DerivationScheme
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DerivationScheme] -> ShowS
$cshowList :: [DerivationScheme] -> ShowS
show :: DerivationScheme -> String
$cshow :: DerivationScheme -> String
showsPrec :: Int -> DerivationScheme -> ShowS
$cshowsPrec :: Int -> DerivationScheme -> ShowS
Show, DerivationScheme -> DerivationScheme -> Bool
(DerivationScheme -> DerivationScheme -> Bool)
-> (DerivationScheme -> DerivationScheme -> Bool)
-> Eq DerivationScheme
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DerivationScheme -> DerivationScheme -> Bool
$c/= :: DerivationScheme -> DerivationScheme -> Bool
== :: DerivationScheme -> DerivationScheme -> Bool
$c== :: DerivationScheme -> DerivationScheme -> Bool
Eq, Eq DerivationScheme
Eq DerivationScheme
-> (DerivationScheme -> DerivationScheme -> Ordering)
-> (DerivationScheme -> DerivationScheme -> Bool)
-> (DerivationScheme -> DerivationScheme -> Bool)
-> (DerivationScheme -> DerivationScheme -> Bool)
-> (DerivationScheme -> DerivationScheme -> Bool)
-> (DerivationScheme -> DerivationScheme -> DerivationScheme)
-> (DerivationScheme -> DerivationScheme -> DerivationScheme)
-> Ord DerivationScheme
DerivationScheme -> DerivationScheme -> Bool
DerivationScheme -> DerivationScheme -> Ordering
DerivationScheme -> DerivationScheme -> DerivationScheme
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 :: DerivationScheme -> DerivationScheme -> DerivationScheme
$cmin :: DerivationScheme -> DerivationScheme -> DerivationScheme
max :: DerivationScheme -> DerivationScheme -> DerivationScheme
$cmax :: DerivationScheme -> DerivationScheme -> DerivationScheme
>= :: DerivationScheme -> DerivationScheme -> Bool
$c>= :: DerivationScheme -> DerivationScheme -> Bool
> :: DerivationScheme -> DerivationScheme -> Bool
$c> :: DerivationScheme -> DerivationScheme -> Bool
<= :: DerivationScheme -> DerivationScheme -> Bool
$c<= :: DerivationScheme -> DerivationScheme -> Bool
< :: DerivationScheme -> DerivationScheme -> Bool
$c< :: DerivationScheme -> DerivationScheme -> Bool
compare :: DerivationScheme -> DerivationScheme -> Ordering
$ccompare :: DerivationScheme -> DerivationScheme -> Ordering
$cp1Ord :: Eq DerivationScheme
Ord, Int -> DerivationScheme
DerivationScheme -> Int
DerivationScheme -> [DerivationScheme]
DerivationScheme -> DerivationScheme
DerivationScheme -> DerivationScheme -> [DerivationScheme]
DerivationScheme
-> DerivationScheme -> DerivationScheme -> [DerivationScheme]
(DerivationScheme -> DerivationScheme)
-> (DerivationScheme -> DerivationScheme)
-> (Int -> DerivationScheme)
-> (DerivationScheme -> Int)
-> (DerivationScheme -> [DerivationScheme])
-> (DerivationScheme -> DerivationScheme -> [DerivationScheme])
-> (DerivationScheme -> DerivationScheme -> [DerivationScheme])
-> (DerivationScheme
    -> DerivationScheme -> DerivationScheme -> [DerivationScheme])
-> Enum DerivationScheme
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: DerivationScheme
-> DerivationScheme -> DerivationScheme -> [DerivationScheme]
$cenumFromThenTo :: DerivationScheme
-> DerivationScheme -> DerivationScheme -> [DerivationScheme]
enumFromTo :: DerivationScheme -> DerivationScheme -> [DerivationScheme]
$cenumFromTo :: DerivationScheme -> DerivationScheme -> [DerivationScheme]
enumFromThen :: DerivationScheme -> DerivationScheme -> [DerivationScheme]
$cenumFromThen :: DerivationScheme -> DerivationScheme -> [DerivationScheme]
enumFrom :: DerivationScheme -> [DerivationScheme]
$cenumFrom :: DerivationScheme -> [DerivationScheme]
fromEnum :: DerivationScheme -> Int
$cfromEnum :: DerivationScheme -> Int
toEnum :: Int -> DerivationScheme
$ctoEnum :: Int -> DerivationScheme
pred :: DerivationScheme -> DerivationScheme
$cpred :: DerivationScheme -> DerivationScheme
succ :: DerivationScheme -> DerivationScheme
$csucc :: DerivationScheme -> DerivationScheme
Enum, DerivationScheme
DerivationScheme -> DerivationScheme -> Bounded DerivationScheme
forall a. a -> a -> Bounded a
maxBound :: DerivationScheme
$cmaxBound :: DerivationScheme
minBound :: DerivationScheme
$cminBound :: DerivationScheme
Bounded, Typeable)
instance Arbitrary DerivationScheme where
    arbitrary :: Gen DerivationScheme
arbitrary = NonEmpty [(Word, Gen DerivationScheme)] -> Gen DerivationScheme
forall a. NonEmpty [(Word, Gen a)] -> Gen a
frequency (NonEmpty [(Word, Gen DerivationScheme)] -> Gen DerivationScheme)
-> NonEmpty [(Word, Gen DerivationScheme)] -> Gen DerivationScheme
forall a b. (a -> b) -> a -> b
$ [(Word, Gen DerivationScheme)]
-> NonEmpty [(Word, Gen DerivationScheme)]
forall c. Collection c => c -> NonEmpty c
nonEmpty_ [ (Word
1, DerivationScheme -> Gen DerivationScheme
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure DerivationScheme
DerivationScheme1), (Word
1, DerivationScheme -> Gen DerivationScheme
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure DerivationScheme
DerivationScheme2) ]

pattern LatestScheme :: DerivationScheme
pattern $bLatestScheme :: DerivationScheme
$mLatestScheme :: forall r. DerivationScheme -> (Void# -> r) -> (Void# -> r) -> r
LatestScheme = DerivationScheme2

newtype ChainCode = ChainCode ByteString
    deriving (Int -> ChainCode -> ShowS
[ChainCode] -> ShowS
ChainCode -> String
(Int -> ChainCode -> ShowS)
-> (ChainCode -> String)
-> ([ChainCode] -> ShowS)
-> Show ChainCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChainCode] -> ShowS
$cshowList :: [ChainCode] -> ShowS
show :: ChainCode -> String
$cshow :: ChainCode -> String
showsPrec :: Int -> ChainCode -> ShowS
$cshowsPrec :: Int -> ChainCode -> ShowS
Show, ChainCode -> ChainCode -> Bool
(ChainCode -> ChainCode -> Bool)
-> (ChainCode -> ChainCode -> Bool) -> Eq ChainCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChainCode -> ChainCode -> Bool
$c/= :: ChainCode -> ChainCode -> Bool
== :: ChainCode -> ChainCode -> Bool
$c== :: ChainCode -> ChainCode -> Bool
Eq, Eq ChainCode
Eq ChainCode
-> (ChainCode -> ChainCode -> Ordering)
-> (ChainCode -> ChainCode -> Bool)
-> (ChainCode -> ChainCode -> Bool)
-> (ChainCode -> ChainCode -> Bool)
-> (ChainCode -> ChainCode -> Bool)
-> (ChainCode -> ChainCode -> ChainCode)
-> (ChainCode -> ChainCode -> ChainCode)
-> Ord ChainCode
ChainCode -> ChainCode -> Bool
ChainCode -> ChainCode -> Ordering
ChainCode -> ChainCode -> ChainCode
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 :: ChainCode -> ChainCode -> ChainCode
$cmin :: ChainCode -> ChainCode -> ChainCode
max :: ChainCode -> ChainCode -> ChainCode
$cmax :: ChainCode -> ChainCode -> ChainCode
>= :: ChainCode -> ChainCode -> Bool
$c>= :: ChainCode -> ChainCode -> Bool
> :: ChainCode -> ChainCode -> Bool
$c> :: ChainCode -> ChainCode -> Bool
<= :: ChainCode -> ChainCode -> Bool
$c<= :: ChainCode -> ChainCode -> Bool
< :: ChainCode -> ChainCode -> Bool
$c< :: ChainCode -> ChainCode -> Bool
compare :: ChainCode -> ChainCode -> Ordering
$ccompare :: ChainCode -> ChainCode -> Ordering
$cp1Ord :: Eq ChainCode
Ord, ChainCode -> Int
ChainCode -> Ptr p -> IO ()
ChainCode -> (Ptr p -> IO a) -> IO a
(ChainCode -> Int)
-> (forall p a. ChainCode -> (Ptr p -> IO a) -> IO a)
-> (forall p. ChainCode -> Ptr p -> IO ())
-> ByteArrayAccess ChainCode
forall p. ChainCode -> Ptr p -> IO ()
forall ba.
(ba -> Int)
-> (forall p a. ba -> (Ptr p -> IO a) -> IO a)
-> (forall p. ba -> Ptr p -> IO ())
-> ByteArrayAccess ba
forall p a. ChainCode -> (Ptr p -> IO a) -> IO a
copyByteArrayToPtr :: ChainCode -> Ptr p -> IO ()
$ccopyByteArrayToPtr :: forall p. ChainCode -> Ptr p -> IO ()
withByteArray :: ChainCode -> (Ptr p -> IO a) -> IO a
$cwithByteArray :: forall p a. ChainCode -> (Ptr p -> IO a) -> IO a
length :: ChainCode -> Int
$clength :: ChainCode -> Int
ByteArrayAccess, ChainCode -> ()
(ChainCode -> ()) -> NFData ChainCode
forall a. (a -> ()) -> NFData a
rnf :: ChainCode -> ()
$crnf :: ChainCode -> ()
NFData, Int -> ChainCode -> Int
ChainCode -> Int
(Int -> ChainCode -> Int)
-> (ChainCode -> Int) -> Hashable ChainCode
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: ChainCode -> Int
$chash :: ChainCode -> Int
hashWithSalt :: Int -> ChainCode -> Int
$chashWithSalt :: Int -> ChainCode -> Int
Hashable)