{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Cardano.CLI.Byron.Legacy (
      LegacyDelegateKey(..)
    , encodeLegacyDelegateKey
    , decodeLegacyDelegateKey
    ) where

import           Cardano.Prelude (cborError)

import           Control.Monad (when)
import           Formatting (build, formatToString)

import qualified Codec.CBOR.Decoding as D
import qualified Codec.CBOR.Encoding as E

import           Cardano.Api (textShow)
import           Cardano.Crypto.Signing (SigningKey (..))
import qualified Cardano.Crypto.Wallet as Wallet
import           Data.Text (Text)


-- | LegacyDelegateKey is a subset of the UserSecret's from the legacy codebase:
-- 1. the VSS keypair must be present
-- 2. the signing key must be present
-- 3. the rest must be absent (Nothing)
--
-- Legacy reference: https://github.com/input-output-hk/cardano-sl/blob/release/3.0.1/lib/src/Pos/Util/UserSecret.hs#L189
newtype LegacyDelegateKey =  LegacyDelegateKey { LegacyDelegateKey -> SigningKey
lrkSigningKey :: SigningKey}

encodeXPrv :: Wallet.XPrv -> E.Encoding
encodeXPrv :: XPrv -> Encoding
encodeXPrv XPrv
a = ByteString -> Encoding
E.encodeBytes forall a b. (a -> b) -> a -> b
$ XPrv -> ByteString
Wallet.unXPrv XPrv
a

decodeXPrv :: D.Decoder s Wallet.XPrv
decodeXPrv :: forall s. Decoder s XPrv
decodeXPrv =
  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Format String a -> a
formatToString forall a r. Buildable a => Format r (a -> r)
build) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall bin. ByteArrayAccess bin => bin -> Either String XPrv
Wallet.xprv forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s. Decoder s ByteString
D.decodeBytesCanonical

-- Stolen from: cardano-sl/binary/src/Pos/Binary/Class/Core.hs
-- | Enforces that the input size is the same as the decoded one, failing in
-- case it's not.
enforceSize :: Text -> Int -> D.Decoder s ()
enforceSize :: forall s. Text -> Int -> Decoder s ()
enforceSize Text
lbl Int
requestedSize = forall s. Decoder s Int
D.decodeListLenCanonical forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s. Int -> Text -> Int -> Decoder s ()
matchSize Int
requestedSize Text
lbl

-- Stolen from: cardano-sl/binary/src/Pos/Binary/Class/Core.hs
-- | Compare two sizes, failing if they are not equal.
matchSize :: Int -> Text -> Int -> D.Decoder s ()
matchSize :: forall s. Int -> Text -> Int -> Decoder s ()
matchSize Int
requestedSize Text
lbl Int
actualSize =
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
actualSize forall a. Eq a => a -> a -> Bool
/= Int
requestedSize) forall a b. (a -> b) -> a -> b
$
    forall e s a. Buildable e => e -> Decoder s a
cborError (Text
lbl forall a. Semigroup a => a -> a -> a
<> Text
" failed the size check. Expected " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
textShow Int
requestedSize forall a. Semigroup a => a -> a -> a
<> Text
", found " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
textShow Int
actualSize)

-- | Encoder for a Byron/Classic signing key.
--   Lifted from cardano-sl legacy codebase.
encodeLegacyDelegateKey :: LegacyDelegateKey -> E.Encoding
encodeLegacyDelegateKey :: LegacyDelegateKey -> Encoding
encodeLegacyDelegateKey (LegacyDelegateKey (SigningKey XPrv
sk))
  =  Word -> Encoding
E.encodeListLen Word
4
  forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
E.encodeListLen Word
1 forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
E.encodeBytes ByteString
"vss deprecated"
  forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
E.encodeListLen Word
1 forall a. Semigroup a => a -> a -> a
<> XPrv -> Encoding
encodeXPrv XPrv
sk
  forall a. Semigroup a => a -> a -> a
<> Encoding
E.encodeListLenIndef forall a. Semigroup a => a -> a -> a
<> Encoding
E.encodeBreak
  forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
E.encodeListLen Word
0

-- | Decoder for a Byron/Classic signing key.
--   Lifted from cardano-sl legacy codebase.
decodeLegacyDelegateKey :: D.Decoder s LegacyDelegateKey
decodeLegacyDelegateKey :: forall s. Decoder s LegacyDelegateKey
decodeLegacyDelegateKey = do
    forall s. Text -> Int -> Decoder s ()
enforceSize Text
"UserSecret" Int
4
    ByteString
_    <- do
      forall s. Text -> Int -> Decoder s ()
enforceSize Text
"vss" Int
1
      forall s. Decoder s ByteString
D.decodeBytes
    SigningKey
pkey <- do
      forall s. Text -> Int -> Decoder s ()
enforceSize Text
"pkey" Int
1
      XPrv -> SigningKey
SigningKey forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Decoder s XPrv
decodeXPrv
    [()]
_    <- do
      forall s. Decoder s ()
D.decodeListLenIndef
      forall r a r' s.
(r -> a -> r) -> r -> (r -> r') -> Decoder s a -> Decoder s r'
D.decodeSequenceLenIndef (forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) [] forall a. [a] -> [a]
reverse forall s. Decoder s ()
D.decodeNull
    ()
_    <- do
      forall s. Text -> Int -> Decoder s ()
enforceSize Text
"wallet" Int
0
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ SigningKey -> LegacyDelegateKey
LegacyDelegateKey SigningKey
pkey