{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Haskoin.Keys.Extended.Internal (
    Fingerprint (..),
    fingerprintToText,
    textToFingerprint,
) where

import Control.DeepSeq (NFData)
import Control.Monad ((>=>))
import Data.Aeson (
    FromJSON,
    ToJSON,
    parseJSON,
    toJSON,
    withText,
 )
import Data.Binary (Binary (..))
import Data.Bytes.Get (getWord32be)
import Data.Bytes.Put (putWord32be)
import Data.Bytes.Serial (Serial (..))
import Data.Either (fromRight)
import Data.Hashable (Hashable)
import Data.Maybe (fromMaybe)
import Data.Serialize (Serialize (..))
import qualified Data.Serialize as S
import Data.String (IsString (..))
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Typeable (Typeable)
import Data.Word (Word32)
import GHC.Generics (Generic)
import Haskoin.Util (decodeHex, encodeHex)
import Text.Read (readEither, readPrec)

-- | Fingerprint of parent
newtype Fingerprint = Fingerprint {Fingerprint -> Word32
unFingerprint :: Word32}
    deriving (Fingerprint -> Fingerprint -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Fingerprint -> Fingerprint -> Bool
$c/= :: Fingerprint -> Fingerprint -> Bool
== :: Fingerprint -> Fingerprint -> Bool
$c== :: Fingerprint -> Fingerprint -> Bool
Eq, Eq Fingerprint
Fingerprint -> Fingerprint -> Bool
Fingerprint -> Fingerprint -> Ordering
Fingerprint -> Fingerprint -> Fingerprint
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 :: Fingerprint -> Fingerprint -> Fingerprint
$cmin :: Fingerprint -> Fingerprint -> Fingerprint
max :: Fingerprint -> Fingerprint -> Fingerprint
$cmax :: Fingerprint -> Fingerprint -> Fingerprint
>= :: Fingerprint -> Fingerprint -> Bool
$c>= :: Fingerprint -> Fingerprint -> Bool
> :: Fingerprint -> Fingerprint -> Bool
$c> :: Fingerprint -> Fingerprint -> Bool
<= :: Fingerprint -> Fingerprint -> Bool
$c<= :: Fingerprint -> Fingerprint -> Bool
< :: Fingerprint -> Fingerprint -> Bool
$c< :: Fingerprint -> Fingerprint -> Bool
compare :: Fingerprint -> Fingerprint -> Ordering
$ccompare :: Fingerprint -> Fingerprint -> Ordering
Ord, Eq Fingerprint
Int -> Fingerprint -> Int
Fingerprint -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Fingerprint -> Int
$chash :: Fingerprint -> Int
hashWithSalt :: Int -> Fingerprint -> Int
$chashWithSalt :: Int -> Fingerprint -> Int
Hashable, Typeable, forall x. Rep Fingerprint x -> Fingerprint
forall x. Fingerprint -> Rep Fingerprint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Fingerprint x -> Fingerprint
$cfrom :: forall x. Fingerprint -> Rep Fingerprint x
Generic, Fingerprint -> ()
forall a. (a -> ()) -> NFData a
rnf :: Fingerprint -> ()
$crnf :: Fingerprint -> ()
NFData)

fingerprintToText :: Fingerprint -> Text
fingerprintToText :: Fingerprint -> Text
fingerprintToText = ByteString -> Text
encodeHex forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Serialize a => a -> ByteString
S.encode

textToFingerprint :: Text -> Either String Fingerprint
textToFingerprint :: Text -> Either String Fingerprint
textToFingerprint = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left String
"Fingerprint: invalid hex") forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe ByteString
decodeHex forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a. Serialize a => ByteString -> Either String a
S.decode

instance Show Fingerprint where
    show :: Fingerprint -> String
show = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
encodeHex forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Serialize a => a -> ByteString
S.encode

instance Read Fingerprint where
    readPrec :: ReadPrec Fingerprint
readPrec =
        forall a. Read a => ReadPrec a
readPrec
            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Fingerprint: invalid hex") forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe ByteString
decodeHex
            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"Fingerprint: " forall a. Semigroup a => a -> a -> a
<>)) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Serialize a => ByteString -> Either String a
S.decode

instance IsString Fingerprint where
    fromString :: String -> Fingerprint
fromString =
        forall b a. b -> Either a b -> b
fromRight forall {a}. a
decodeError
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Serialize a => ByteString -> Either String a
S.decode
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
hexError
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe ByteString
decodeHex
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack
      where
        decodeError :: a
decodeError = forall a. HasCallStack => String -> a
error String
"Fingerprint literal: Unable to decode"
        hexError :: a
hexError = forall a. HasCallStack => String -> a
error String
"Fingerprint literal: Invalid hex"

instance Serial Fingerprint where
    serialize :: forall (m :: * -> *). MonadPut m => Fingerprint -> m ()
serialize = forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32be forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fingerprint -> Word32
unFingerprint
    deserialize :: forall (m :: * -> *). MonadGet m => m Fingerprint
deserialize = Word32 -> Fingerprint
Fingerprint forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadGet m => m Word32
getWord32be

instance Binary Fingerprint where
    put :: Fingerprint -> Put
put = forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
    get :: Get Fingerprint
get = forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance Serialize Fingerprint where
    put :: Putter Fingerprint
put = forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
    get :: Get Fingerprint
get = forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance FromJSON Fingerprint where
    parseJSON :: Value -> Parser Fingerprint
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Fingerprint" forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String Fingerprint
textToFingerprint

instance ToJSON Fingerprint where
    toJSON :: Fingerprint -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fingerprint -> Text
fingerprintToText