{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE NoFieldSelectors #-}
module Haskoin.Crypto.Keys.Extended.Internal
( Fingerprint (..),
fingerprintToText,
textToFingerprint,
)
where
import Control.DeepSeq (NFData)
import Control.Monad ((>=>))
import Data.Aeson
( FromJSON (parseJSON),
ToJSON (toEncoding, toJSON),
withText,
)
import Data.Aeson.Encoding (text)
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 Data.Serialize qualified as S
import Data.String (IsString (..))
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Typeable (Typeable)
import Data.Word (Word32)
import GHC.Generics (Generic)
import Haskoin.Util.Helpers (decodeHex, encodeHex)
import Text.Read (readEither, readPrec)
newtype Fingerprint = Fingerprint {Fingerprint -> Word32
get :: Word32}
deriving (Fingerprint -> Fingerprint -> Bool
(Fingerprint -> Fingerprint -> Bool)
-> (Fingerprint -> Fingerprint -> Bool) -> Eq Fingerprint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Fingerprint -> Fingerprint -> Bool
== :: Fingerprint -> Fingerprint -> Bool
$c/= :: Fingerprint -> Fingerprint -> Bool
/= :: 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
$ccompare :: Fingerprint -> Fingerprint -> Ordering
compare :: Fingerprint -> Fingerprint -> Ordering
$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
>= :: Fingerprint -> Fingerprint -> Bool
$cmax :: Fingerprint -> Fingerprint -> Fingerprint
max :: Fingerprint -> Fingerprint -> Fingerprint
$cmin :: Fingerprint -> Fingerprint -> Fingerprint
min :: Fingerprint -> Fingerprint -> Fingerprint
Ord, Eq Fingerprint
Eq Fingerprint
-> (Int -> Fingerprint -> Int)
-> (Fingerprint -> Int)
-> Hashable Fingerprint
Int -> Fingerprint -> Int
Fingerprint -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Fingerprint -> Int
hashWithSalt :: Int -> Fingerprint -> Int
$chash :: Fingerprint -> Int
hash :: 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
$cfrom :: forall x. Fingerprint -> Rep Fingerprint x
from :: forall x. Fingerprint -> Rep Fingerprint x
$cto :: forall x. Rep Fingerprint x -> Fingerprint
to :: forall x. Rep Fingerprint x -> Fingerprint
Generic, Fingerprint -> ()
(Fingerprint -> ()) -> NFData Fingerprint
forall a. (a -> ()) -> NFData a
$crnf :: Fingerprint -> ()
rnf :: 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 a b. ReadPrec a -> (a -> ReadPrec b) -> ReadPrec b
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 a. String -> ReadPrec a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Fingerprint: invalid hex") ByteString -> ReadPrec ByteString
forall a. a -> ReadPrec a
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 a b. ReadPrec a -> (a -> ReadPrec b) -> ReadPrec b
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 a. String -> ReadPrec a
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 a. a -> ReadPrec a
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 :: forall (m :: * -> *). MonadPut m => 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
. (.get)
deserialize :: forall (m :: * -> *). MonadGet m => 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 ()
forall (m :: * -> *). MonadPut m => Fingerprint -> m ()
serialize
get :: Get Fingerprint
get = Get Fingerprint
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Fingerprint
deserialize
instance Serialize Fingerprint where
put :: Putter Fingerprint
put = Putter Fingerprint
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Fingerprint -> m ()
serialize
get :: Get Fingerprint
get = Get Fingerprint
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Fingerprint
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 a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail Fingerprint -> Parser Fingerprint
forall a. a -> Parser a
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
toEncoding :: Fingerprint -> Encoding
toEncoding = Text -> Encoding
forall a. Text -> Encoding' a
text (Text -> Encoding)
-> (Fingerprint -> Text) -> Fingerprint -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fingerprint -> Text
fingerprintToText