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

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

import Cardano.Crypto.Signing.VerificationKey (VerificationKey (..), shortVerificationKeyHexF)
import qualified Cardano.Crypto.Wallet as CC
import Cardano.Ledger.Binary (
  DecCBOR (..),
  Decoder,
  EncCBOR (..),
  Encoding,
  FromCBOR (..),
  ToCBOR (..),
  fromByronCBOR,
  toByronCBOR,
  toCborError,
 )
import qualified Cardano.Ledger.Binary.Plain as Plain
import Cardano.Prelude hiding (toCborError)
import Formatting (bprint)
import Formatting.Buildable
import qualified GHC.Show
import NoThunks.Class (InspectHeap (..), NoThunks (..))

-- | Wrapper around 'CC.XPrv'.
type SigningKey :: Type
newtype SigningKey = SigningKey
  { SigningKey -> XPrv
unSigningKey :: CC.XPrv
  }
  deriving newtype (SigningKey -> ()
forall a. (a -> ()) -> NFData a
rnf :: SigningKey -> ()
$crnf :: SigningKey -> ()
NFData)
  deriving (Context -> SigningKey -> IO (Maybe ThunkInfo)
Proxy SigningKey -> String
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
CC.toXPub XPrv
k)

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

instance Buildable SigningKey where
  build :: SigningKey -> Builder
build = forall a. Format Builder a -> a
bprint (Format (VerificationKey -> Builder) (VerificationKey -> Builder)
"sec:" forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall r. Format r (VerificationKey -> r)
shortVerificationKeyHexF) 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

encCBORXPrv :: CC.XPrv -> Encoding
encCBORXPrv :: XPrv -> Encoding
encCBORXPrv XPrv
a = forall a. EncCBOR a => a -> Encoding
encCBOR forall a b. (a -> b) -> a -> b
$ XPrv -> ByteString
CC.unXPrv XPrv
a

decCBORXPrv :: Decoder s CC.XPrv
decCBORXPrv :: forall s. Decoder s XPrv
decCBORXPrv = forall (m :: * -> *) e a.
(MonadFail m, Buildable e) =>
Either e a -> m a
toCborError forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall bin. ByteArrayAccess bin => bin -> Either String XPrv
CC.xprv forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a s. DecCBOR a => Decoder s a
decCBOR @ByteString

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

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

instance ToCBOR SigningKey where
  toCBOR :: SigningKey -> Encoding
toCBOR = forall a. EncCBOR a => a -> Encoding
toByronCBOR

instance FromCBOR SigningKey where
  fromCBOR :: forall s. Decoder s SigningKey
fromCBOR = forall a s. DecCBOR a => Decoder s a
fromByronCBOR

instance EncCBOR SigningKey where
  encCBOR :: SigningKey -> Encoding
encCBOR (SigningKey XPrv
a) = XPrv -> Encoding
encCBORXPrv XPrv
a

instance DecCBOR SigningKey where
  decCBOR :: forall s. Decoder s SigningKey
decCBOR = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap XPrv -> SigningKey
SigningKey forall s. Decoder s XPrv
decCBORXPrv