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

module Cardano.Crypto.Signing.Safe.PassPhrase (
  PassPhrase (..),
  emptyPassphrase,
  passphraseLength,
) where

import Cardano.Ledger.Binary (
  DecCBOR (..),
  EncCBOR (..),
  FromCBOR (..),
  ToCBOR (..),
  fromByronCBOR,
  toByronCBOR,
  toCborError,
 )
import Cardano.Prelude hiding (toCborError)
import Data.ByteArray (ByteArray, ByteArrayAccess, ScrubbedBytes)
import qualified Data.ByteArray as ByteArray
import qualified Data.ByteString as BS
import Data.Default (Default (..))
import Formatting (int, sformat)
import Formatting.Buildable (Buildable (..))
import qualified Prelude

type PassPhrase :: Type
newtype PassPhrase
  = PassPhrase ScrubbedBytes
  deriving (PassPhrase -> PassPhrase -> Bool
(PassPhrase -> PassPhrase -> Bool)
-> (PassPhrase -> PassPhrase -> Bool) -> Eq PassPhrase
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PassPhrase -> PassPhrase -> Bool
== :: PassPhrase -> PassPhrase -> Bool
$c/= :: PassPhrase -> PassPhrase -> Bool
/= :: PassPhrase -> PassPhrase -> Bool
Eq, Eq PassPhrase
Eq PassPhrase =>
(PassPhrase -> PassPhrase -> Ordering)
-> (PassPhrase -> PassPhrase -> Bool)
-> (PassPhrase -> PassPhrase -> Bool)
-> (PassPhrase -> PassPhrase -> Bool)
-> (PassPhrase -> PassPhrase -> Bool)
-> (PassPhrase -> PassPhrase -> PassPhrase)
-> (PassPhrase -> PassPhrase -> PassPhrase)
-> Ord PassPhrase
PassPhrase -> PassPhrase -> Bool
PassPhrase -> PassPhrase -> Ordering
PassPhrase -> PassPhrase -> PassPhrase
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PassPhrase -> PassPhrase -> Ordering
compare :: PassPhrase -> PassPhrase -> Ordering
$c< :: PassPhrase -> PassPhrase -> Bool
< :: PassPhrase -> PassPhrase -> Bool
$c<= :: PassPhrase -> PassPhrase -> Bool
<= :: PassPhrase -> PassPhrase -> Bool
$c> :: PassPhrase -> PassPhrase -> Bool
> :: PassPhrase -> PassPhrase -> Bool
$c>= :: PassPhrase -> PassPhrase -> Bool
>= :: PassPhrase -> PassPhrase -> Bool
$cmax :: PassPhrase -> PassPhrase -> PassPhrase
max :: PassPhrase -> PassPhrase -> PassPhrase
$cmin :: PassPhrase -> PassPhrase -> PassPhrase
min :: PassPhrase -> PassPhrase -> PassPhrase
Ord, NonEmpty PassPhrase -> PassPhrase
PassPhrase -> PassPhrase -> PassPhrase
(PassPhrase -> PassPhrase -> PassPhrase)
-> (NonEmpty PassPhrase -> PassPhrase)
-> (forall b. Integral b => b -> PassPhrase -> PassPhrase)
-> Semigroup PassPhrase
forall b. Integral b => b -> PassPhrase -> PassPhrase
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: PassPhrase -> PassPhrase -> PassPhrase
<> :: PassPhrase -> PassPhrase -> PassPhrase
$csconcat :: NonEmpty PassPhrase -> PassPhrase
sconcat :: NonEmpty PassPhrase -> PassPhrase
$cstimes :: forall b. Integral b => b -> PassPhrase -> PassPhrase
stimes :: forall b. Integral b => b -> PassPhrase -> PassPhrase
Semigroup, Semigroup PassPhrase
PassPhrase
Semigroup PassPhrase =>
PassPhrase
-> (PassPhrase -> PassPhrase -> PassPhrase)
-> ([PassPhrase] -> PassPhrase)
-> Monoid PassPhrase
[PassPhrase] -> PassPhrase
PassPhrase -> PassPhrase -> PassPhrase
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: PassPhrase
mempty :: PassPhrase
$cmappend :: PassPhrase -> PassPhrase -> PassPhrase
mappend :: PassPhrase -> PassPhrase -> PassPhrase
$cmconcat :: [PassPhrase] -> PassPhrase
mconcat :: [PassPhrase] -> PassPhrase
Monoid, PassPhrase -> ()
(PassPhrase -> ()) -> NFData PassPhrase
forall a. (a -> ()) -> NFData a
$crnf :: PassPhrase -> ()
rnf :: PassPhrase -> ()
NFData, Eq PassPhrase
Ord PassPhrase
Monoid PassPhrase
ByteArrayAccess PassPhrase
(Eq PassPhrase, Ord PassPhrase, Monoid PassPhrase,
 ByteArrayAccess PassPhrase) =>
(forall p a. Int -> (Ptr p -> IO a) -> IO (a, PassPhrase))
-> ByteArray PassPhrase
forall ba.
(Eq ba, Ord ba, Monoid ba, ByteArrayAccess ba) =>
(forall p a. Int -> (Ptr p -> IO a) -> IO (a, ba)) -> ByteArray ba
forall p a. Int -> (Ptr p -> IO a) -> IO (a, PassPhrase)
$callocRet :: forall p a. Int -> (Ptr p -> IO a) -> IO (a, PassPhrase)
allocRet :: forall p a. Int -> (Ptr p -> IO a) -> IO (a, PassPhrase)
ByteArray, PassPhrase -> Int
(PassPhrase -> Int)
-> (forall p a. PassPhrase -> (Ptr p -> IO a) -> IO a)
-> (forall p. PassPhrase -> Ptr p -> IO ())
-> ByteArrayAccess PassPhrase
forall p. PassPhrase -> Ptr p -> IO ()
forall ba.
(ba -> Int)
-> (forall p a. ba -> (Ptr p -> IO a) -> IO a)
-> (forall p. ba -> Ptr p -> IO ())
-> ByteArrayAccess ba
forall p a. PassPhrase -> (Ptr p -> IO a) -> IO a
$clength :: PassPhrase -> Int
length :: PassPhrase -> Int
$cwithByteArray :: forall p a. PassPhrase -> (Ptr p -> IO a) -> IO a
withByteArray :: forall p a. PassPhrase -> (Ptr p -> IO a) -> IO a
$ccopyByteArrayToPtr :: forall p. PassPhrase -> Ptr p -> IO ()
copyByteArrayToPtr :: forall p. PassPhrase -> Ptr p -> IO ()
ByteArrayAccess)

passphraseLength :: Int
passphraseLength :: Int
passphraseLength = Int
32

-- | Empty passphrase used in development
emptyPassphrase :: PassPhrase
emptyPassphrase :: PassPhrase
emptyPassphrase = ScrubbedBytes -> PassPhrase
PassPhrase ScrubbedBytes
forall a. Monoid a => a
mempty

instance Show PassPhrase where
  show :: PassPhrase -> String
show PassPhrase
_ = String
"<passphrase>"

instance Buildable PassPhrase where
  build :: PassPhrase -> Builder
build PassPhrase
_ = Builder
"<passphrase>"

instance Default PassPhrase where
  def :: PassPhrase
def = PassPhrase
emptyPassphrase

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

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

instance EncCBOR PassPhrase where
  encCBOR :: PassPhrase -> Encoding
encCBOR PassPhrase
pp = ByteString -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (PassPhrase -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert PassPhrase
pp :: ByteString)

instance DecCBOR PassPhrase where
  decCBOR :: forall s. Decoder s PassPhrase
decCBOR = do
    ByteString
bs <- forall a s. DecCBOR a => Decoder s a
decCBOR @ByteString
    let bl :: Int
bl = ByteString -> Int
BS.length ByteString
bs
    -- Currently passphrase may be either 32-byte long or empty (for
    -- unencrypted keys).
    Either Text PassPhrase -> Decoder s PassPhrase
forall (m :: * -> *) e a.
(MonadFail m, Buildable e) =>
Either e a -> m a
toCborError
      (Either Text PassPhrase -> Decoder s PassPhrase)
-> Either Text PassPhrase -> Decoder s PassPhrase
forall a b. (a -> b) -> a -> b
$ if Int
bl Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int
bl Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
passphraseLength
        then PassPhrase -> Either Text PassPhrase
forall a b. b -> Either a b
Right (PassPhrase -> Either Text PassPhrase)
-> PassPhrase -> Either Text PassPhrase
forall a b. (a -> b) -> a -> b
$ ByteString -> PassPhrase
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert ByteString
bs
        else
          Text -> Either Text PassPhrase
forall a b. a -> Either a b
Left
            (Text -> Either Text PassPhrase) -> Text -> Either Text PassPhrase
forall a b. (a -> b) -> a -> b
$ Format Text (Int -> Int -> Text) -> Int -> Int -> Text
forall a. Format Text a -> a
sformat
              (Format (Int -> Int -> Text) (Int -> Int -> Text)
"put@PassPhrase: expected length 0 or " Format (Int -> Int -> Text) (Int -> Int -> Text)
-> Format Text (Int -> Int -> Text)
-> Format Text (Int -> Int -> Text)
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 (Int -> Text) (Int -> Int -> Text)
forall a r. Integral a => Format r (a -> r)
int Format (Int -> Text) (Int -> Int -> Text)
-> Format Text (Int -> Text) -> Format Text (Int -> Int -> Text)
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 (Int -> Text) (Int -> Text)
", not " Format (Int -> Text) (Int -> Text)
-> Format Text (Int -> Text) -> Format Text (Int -> Text)
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 Text (Int -> Text)
forall a r. Integral a => Format r (a -> r)
int)
              Int
passphraseLength
              Int
bl

{-instance Monoid PassPhrase where
    mempty = PassPhrase mempty
    mappend (PassPhrase p1) (PassPhrase p2) = PassPhrase (p1 `mappend` p2)-}