{-# 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 -> ()
(SigningKey -> ()) -> NFData SigningKey
forall a. (a -> ()) -> NFData a
$crnf :: SigningKey -> ()
rnf :: 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
$cnoThunks :: Context -> SigningKey -> IO (Maybe ThunkInfo)
noThunks :: Context -> SigningKey -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> SigningKey -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> SigningKey -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy SigningKey -> String
showTypeOf :: Proxy SigningKey -> String
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 b c a. Format b c -> Format a b -> Format a c
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 b c a. (b -> c) -> (a -> b) -> a -> c
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 = ByteString -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (ByteString -> Encoding) -> ByteString -> Encoding
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 = Either String XPrv -> Decoder s XPrv
forall (m :: * -> *) e a.
(MonadFail m, Buildable e) =>
Either e a -> m a
toCborError (Either String XPrv -> Decoder s XPrv)
-> (ByteString -> Either String XPrv)
-> ByteString
-> Decoder s XPrv
forall b c a. (b -> c) -> (a -> b) -> a -> c
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 a s. DecCBOR a => Decoder s a
decCBOR @ByteString

toCBORXPrv :: CC.XPrv -> Plain.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 :: Plain.Decoder s CC.XPrv
fromCBORXPrv :: forall s. Decoder s XPrv
fromCBORXPrv = Either String XPrv -> Decoder s XPrv
forall (m :: * -> *) e a.
(MonadFail m, Buildable e) =>
Either e a -> m a
toCborError (Either String XPrv -> Decoder s XPrv)
-> (ByteString -> Either String XPrv)
-> ByteString
-> Decoder s XPrv
forall b c a. (b -> c) -> (a -> b) -> a -> c
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 a s. FromCBOR a => Decoder s a
fromCBOR @ByteString

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

instance FromCBOR SigningKey where
  fromCBOR :: forall s. Decoder s SigningKey
fromCBOR = Decoder s SigningKey
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 = (XPrv -> SigningKey) -> Decoder s XPrv -> Decoder s SigningKey
forall a b. (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap XPrv -> SigningKey
SigningKey Decoder s XPrv
forall s. Decoder s XPrv
decCBORXPrv