{-# 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
(Fingerprint -> Fingerprint -> Bool)
-> (Fingerprint -> Fingerprint -> Bool) -> Eq Fingerprint
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
Eq Fingerprint
-> (Fingerprint -> Fingerprint -> Ordering)
-> (Fingerprint -> Fingerprint -> Bool)
-> (Fingerprint -> Fingerprint -> Bool)
-> (Fingerprint -> Fingerprint -> Bool)
-> (Fingerprint -> Fingerprint -> Bool)
-> (Fingerprint -> Fingerprint -> Fingerprint)
-> (Fingerprint -> Fingerprint -> Fingerprint)
-> Ord 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
$cp1Ord :: Eq Fingerprint
Ord, Int -> Fingerprint -> Int
Fingerprint -> Int
(Int -> Fingerprint -> Int)
-> (Fingerprint -> Int) -> Hashable Fingerprint
forall 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. Fingerprint -> Rep Fingerprint x)
-> (forall x. Rep Fingerprint x -> Fingerprint)
-> Generic Fingerprint
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 -> ()
(Fingerprint -> ()) -> NFData Fingerprint
forall a. (a -> ()) -> NFData a
rnf :: Fingerprint -> ()
$crnf :: Fingerprint -> ()
NFData)

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

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

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

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

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

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

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

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

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

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