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

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

-- | Empty passphrase used in development
emptyPassphrase :: PassPhrase
emptyPassphrase :: PassPhrase
emptyPassphrase = ScrubbedBytes -> PassPhrase
PassPhrase 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 = forall a. EncCBOR a => a -> Encoding
toByronCBOR

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

instance EncCBOR PassPhrase where
  encCBOR :: PassPhrase -> Encoding
encCBOR PassPhrase
pp = forall a. EncCBOR a => a -> Encoding
encCBOR (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).
    forall (m :: * -> *) e a.
(MonadFail m, Buildable e) =>
Either e a -> m a
toCborError
      forall a b. (a -> b) -> a -> b
$ if Int
bl forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int
bl forall a. Eq a => a -> a -> Bool
== Int
passphraseLength
        then forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert ByteString
bs
        else
          forall a b. a -> Either a b
Left
            forall a b. (a -> b) -> a -> b
$ forall a. Format Text a -> a
sformat
              (Format (Int -> Int -> Text) (Int -> Int -> Text)
"put@PassPhrase: expected length 0 or " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Integral a => Format r (a -> r)
int 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 " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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)-}