{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}

module Cardano.Crypto.Signing.SigningKey
  ( SigningKey (..),
    toVerification,
    toCBORXPrv,
    fromCBORXPrv,
  )
where

import Cardano.Binary (Decoder, Encoding, FromCBOR (..), ToCBOR (..))
import Cardano.Crypto.Signing.VerificationKey (VerificationKey (..), shortVerificationKeyHexF)
import qualified Cardano.Crypto.Wallet as CC
import Cardano.Prelude
import Formatting (bprint)
import Formatting.Buildable
import qualified GHC.Show
import NoThunks.Class (InspectHeap (..), NoThunks (..))

-- | Wrapper around 'CC.XPrv'.
newtype SigningKey = SigningKey
  { SigningKey -> XPrv
unSigningKey :: CC.XPrv
  }
  deriving newtype (SigningKey -> ()
(SigningKey -> ()) -> NFData SigningKey
forall a. (a -> ()) -> NFData a
rnf :: SigningKey -> ()
$crnf :: SigningKey -> ()
NFData)
  deriving (Context -> SigningKey -> IO (Maybe ThunkInfo)
Proxy SigningKey -> String
(Context -> SigningKey -> IO (Maybe ThunkInfo))
-> (Context -> SigningKey -> IO (Maybe ThunkInfo))
-> (Proxy SigningKey -> String)
-> NoThunks SigningKey
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy SigningKey -> String
$cshowTypeOf :: Proxy SigningKey -> String
wNoThunks :: Context -> SigningKey -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> SigningKey -> IO (Maybe ThunkInfo)
noThunks :: Context -> SigningKey -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> SigningKey -> IO (Maybe ThunkInfo)
NoThunks) via InspectHeap CC.XPrv

-- Note that there is deliberately no Eq instance. The cardano-crypto library
-- does not define one for XPrv.

-- Note that there is deliberately no Ord instance. The crypto libraries
-- encourage using key /hashes/ not keys for things like sets, map etc.

-- | Generate a verification key from a signing key. Fast (it just drops some bytes
-- off the signing key).
toVerification :: SigningKey -> VerificationKey
toVerification :: SigningKey -> VerificationKey
toVerification (SigningKey XPrv
k) = XPub -> VerificationKey
VerificationKey (HasCallStack => XPrv -> XPub
XPrv -> XPub
CC.toXPub XPrv
k)

instance Show SigningKey where
  show :: SigningKey -> String
show SigningKey
sk = String
"<signing of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ VerificationKey -> String
forall a b. (Show a, ConvertText String b) => a -> b
show (SigningKey -> VerificationKey
toVerification SigningKey
sk) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">"

instance Buildable SigningKey where
  build :: SigningKey -> Builder
build = Format Builder (VerificationKey -> Builder)
-> VerificationKey -> Builder
forall a. Format Builder a -> a
bprint (Format (VerificationKey -> Builder) (VerificationKey -> Builder)
"sec:" Format (VerificationKey -> Builder) (VerificationKey -> Builder)
-> Format Builder (VerificationKey -> Builder)
-> Format Builder (VerificationKey -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (VerificationKey -> Builder)
forall r. Format r (VerificationKey -> r)
shortVerificationKeyHexF) (VerificationKey -> Builder)
-> (SigningKey -> VerificationKey) -> SigningKey -> Builder
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. SigningKey -> VerificationKey
toVerification

toCBORXPrv :: CC.XPrv -> Encoding
toCBORXPrv :: XPrv -> Encoding
toCBORXPrv XPrv
a = ByteString -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (ByteString -> Encoding) -> ByteString -> Encoding
forall a b. (a -> b) -> a -> b
$ XPrv -> ByteString
CC.unXPrv XPrv
a

fromCBORXPrv :: Decoder s CC.XPrv
fromCBORXPrv :: Decoder s XPrv
fromCBORXPrv = Either String XPrv -> Decoder s XPrv
forall e a s. Buildable e => Either e a -> Decoder s a
toCborError (Either String XPrv -> Decoder s XPrv)
-> (ByteString -> Either String XPrv)
-> ByteString
-> Decoder s XPrv
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> Either String XPrv
forall bin. ByteArrayAccess bin => bin -> Either String XPrv
CC.xprv (ByteString -> Decoder s XPrv)
-> Decoder s ByteString -> Decoder s XPrv
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s. FromCBOR ByteString => Decoder s ByteString
forall a s. FromCBOR a => Decoder s a
fromCBOR @ByteString

instance ToCBOR SigningKey where
  toCBOR :: SigningKey -> Encoding
toCBOR (SigningKey XPrv
a) = XPrv -> Encoding
toCBORXPrv XPrv
a

instance FromCBOR SigningKey where
  fromCBOR :: Decoder s SigningKey
fromCBOR = (XPrv -> SigningKey) -> Decoder s XPrv -> Decoder s SigningKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap XPrv -> SigningKey
SigningKey Decoder s XPrv
forall s. Decoder s XPrv
fromCBORXPrv