{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Crypto.Orphans () where

import Cardano.Ledger.Binary (
  DecCBOR (..),
  EncCBOR (..),
  FromCBOR (..),
  Size,
  ToCBOR (..),
  encodeBytes,
  fromByronCBOR,
  toByronCBOR,
  toCborError,
  withWordSize,
 )
import Cardano.Prelude hiding (toCborError)
import Crypto.Error (CryptoFailable (..))
import qualified Crypto.PubKey.Ed25519 as Ed25519
import Data.Aeson (FromJSON (..), ToJSON (..))
import qualified Data.ByteArray as BA
import qualified Data.ByteString as BS
import Data.ByteString.Base64.Type (getByteString64, makeByteString64)
import qualified Data.Text as T

fromByteStringToBytes :: ByteString -> BA.Bytes
fromByteStringToBytes :: ByteString -> Bytes
fromByteStringToBytes = ByteString -> Bytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert

fromByteStringToScrubbedBytes :: ByteString -> BA.ScrubbedBytes
fromByteStringToScrubbedBytes :: ByteString -> ScrubbedBytes
fromByteStringToScrubbedBytes = ByteString -> ScrubbedBytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert

toByteString :: BA.ByteArrayAccess bin => bin -> ByteString
toByteString :: forall bin. ByteArrayAccess bin => bin -> ByteString
toByteString = bin -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert

fromCryptoFailable :: T.Text -> CryptoFailable a -> Either T.Text a
fromCryptoFailable :: forall a. Text -> CryptoFailable a -> Either Text a
fromCryptoFailable Text
item (CryptoFailed CryptoError
e) =
  Text -> Either Text a
forall a b. a -> Either a b
Left (Text -> Either Text a) -> Text -> Either Text a
forall a b. (a -> b) -> a -> b
$ Text
"Cardano.Crypto.Orphan." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
item Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" failed because " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CryptoError -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show CryptoError
e
fromCryptoFailable Text
_ (CryptoPassed a
r) = a -> Either Text a
forall a. a -> Either Text a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r

instance FromJSON Ed25519.PublicKey where
  parseJSON :: Value -> Parser PublicKey
parseJSON Value
v = do
    res <-
      Bytes -> CryptoFailable PublicKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable PublicKey
Ed25519.publicKey
        (Bytes -> CryptoFailable PublicKey)
-> (ByteString64 -> Bytes)
-> ByteString64
-> CryptoFailable PublicKey
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 -> Bytes
fromByteStringToBytes
        (ByteString -> Bytes)
-> (ByteString64 -> ByteString) -> ByteString64 -> Bytes
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
. ByteString64 -> ByteString
getByteString64
        (ByteString64 -> CryptoFailable PublicKey)
-> Parser ByteString64 -> Parser (CryptoFailable PublicKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ByteString64
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    toAesonError $ fromCryptoFailable "parseJSON Ed25519.PublicKey" res

instance ToJSON Ed25519.PublicKey where
  toJSON :: PublicKey -> Value
toJSON = ByteString64 -> Value
forall a. ToJSON a => a -> Value
toJSON (ByteString64 -> Value)
-> (PublicKey -> ByteString64) -> PublicKey -> Value
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 -> ByteString64
makeByteString64 (ByteString -> ByteString64)
-> (PublicKey -> ByteString) -> PublicKey -> ByteString64
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
. PublicKey -> ByteString
forall bin. ByteArrayAccess bin => bin -> ByteString
toByteString

instance FromJSON Ed25519.Signature where
  parseJSON :: Value -> Parser Signature
parseJSON Value
v = do
    res <-
      Bytes -> CryptoFailable Signature
forall ba. ByteArrayAccess ba => ba -> CryptoFailable Signature
Ed25519.signature
        (Bytes -> CryptoFailable Signature)
-> (ByteString64 -> Bytes)
-> ByteString64
-> CryptoFailable Signature
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 -> Bytes
fromByteStringToBytes
        (ByteString -> Bytes)
-> (ByteString64 -> ByteString) -> ByteString64 -> Bytes
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
. ByteString64 -> ByteString
getByteString64
        (ByteString64 -> CryptoFailable Signature)
-> Parser ByteString64 -> Parser (CryptoFailable Signature)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ByteString64
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    toAesonError $ fromCryptoFailable "parseJSON Ed25519.Signature" res

instance ToJSON Ed25519.Signature where
  toJSON :: Signature -> Value
toJSON = ByteString64 -> Value
forall a. ToJSON a => a -> Value
toJSON (ByteString64 -> Value)
-> (Signature -> ByteString64) -> Signature -> Value
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 -> ByteString64
makeByteString64 (ByteString -> ByteString64)
-> (Signature -> ByteString) -> Signature -> ByteString64
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
. Signature -> ByteString
forall bin. ByteArrayAccess bin => bin -> ByteString
toByteString

instance ToCBOR Ed25519.PublicKey where
  toCBOR :: PublicKey -> Encoding
toCBOR = PublicKey -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy PublicKey -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_ Proxy PublicKey
_ = Int -> Size
bsSize Int
32

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

instance ToCBOR Ed25519.SecretKey where
  toCBOR :: SecretKey -> Encoding
toCBOR = SecretKey -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy SecretKey -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_ Proxy SecretKey
_ = Int -> Size
bsSize Int
64

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

instance ToCBOR Ed25519.Signature where
  toCBOR :: Signature -> Encoding
toCBOR = Signature -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Signature -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_ Proxy Signature
_ = Int -> Size
bsSize Int
64

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

instance EncCBOR Ed25519.PublicKey where
  encCBOR :: PublicKey -> Encoding
encCBOR = ByteString -> Encoding
encodeBytes (ByteString -> Encoding)
-> (PublicKey -> ByteString) -> PublicKey -> Encoding
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
. PublicKey -> ByteString
forall bin. ByteArrayAccess bin => bin -> ByteString
toByteString

instance DecCBOR Ed25519.PublicKey where
  decCBOR :: forall s. Decoder s PublicKey
decCBOR = do
    res <- Bytes -> CryptoFailable PublicKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable PublicKey
Ed25519.publicKey (Bytes -> CryptoFailable PublicKey)
-> (ByteString -> Bytes) -> ByteString -> CryptoFailable PublicKey
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 -> Bytes
fromByteStringToBytes (ByteString -> CryptoFailable PublicKey)
-> Decoder s ByteString -> Decoder s (CryptoFailable PublicKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s ByteString
forall s. Decoder s ByteString
forall a s. DecCBOR a => Decoder s a
decCBOR
    toCborError $ fromCryptoFailable "decCBOR Ed25519.PublicKey" res

instance EncCBOR Ed25519.SecretKey where
  encCBOR :: SecretKey -> Encoding
encCBOR SecretKey
sk =
    ByteString -> Encoding
encodeBytes
      (ByteString -> Encoding) -> ByteString -> Encoding
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ByteString
BS.append (SecretKey -> ByteString
forall bin. ByteArrayAccess bin => bin -> ByteString
toByteString SecretKey
sk) (PublicKey -> ByteString
forall bin. ByteArrayAccess bin => bin -> ByteString
toByteString (PublicKey -> ByteString) -> PublicKey -> ByteString
forall a b. (a -> b) -> a -> b
$ SecretKey -> PublicKey
Ed25519.toPublic SecretKey
sk)

instance DecCBOR Ed25519.SecretKey where
  decCBOR :: forall s. Decoder s SecretKey
decCBOR = do
    res <-
      ScrubbedBytes -> CryptoFailable SecretKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable SecretKey
Ed25519.secretKey
        (ScrubbedBytes -> CryptoFailable SecretKey)
-> (ByteString -> ScrubbedBytes)
-> ByteString
-> CryptoFailable SecretKey
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 -> ScrubbedBytes
fromByteStringToScrubbedBytes
        (ByteString -> ScrubbedBytes)
-> (ByteString -> ByteString) -> ByteString -> ScrubbedBytes
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
. Int -> ByteString -> ByteString
BS.take Int
Ed25519.secretKeySize
        (ByteString -> CryptoFailable SecretKey)
-> Decoder s ByteString -> Decoder s (CryptoFailable SecretKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s ByteString
forall s. Decoder s ByteString
forall a s. DecCBOR a => Decoder s a
decCBOR
    toCborError $ fromCryptoFailable "decCBOR Ed25519.SecretKey" res

instance EncCBOR Ed25519.Signature where
  encCBOR :: Signature -> Encoding
encCBOR = ByteString -> Encoding
encodeBytes (ByteString -> Encoding)
-> (Signature -> ByteString) -> Signature -> Encoding
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
. Signature -> ByteString
forall bin. ByteArrayAccess bin => bin -> ByteString
toByteString

instance DecCBOR Ed25519.Signature where
  decCBOR :: forall s. Decoder s Signature
decCBOR = do
    res <- Bytes -> CryptoFailable Signature
forall ba. ByteArrayAccess ba => ba -> CryptoFailable Signature
Ed25519.signature (Bytes -> CryptoFailable Signature)
-> (ByteString -> Bytes) -> ByteString -> CryptoFailable Signature
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 -> Bytes
fromByteStringToBytes (ByteString -> CryptoFailable Signature)
-> Decoder s ByteString -> Decoder s (CryptoFailable Signature)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s ByteString
forall s. Decoder s ByteString
forall a s. DecCBOR a => Decoder s a
decCBOR
    toCborError $ fromCryptoFailable "decCBOR Ed25519.Signature" res

-- Helper for encodedSizeExpr in EncCBOR instances
bsSize :: Int -> Size
bsSize :: Int -> Size
bsSize Int
x = Int -> Size
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
forall s a. (Integral s, Integral a) => s -> a
withWordSize Int
x)