module Botan.Types.Class
( Encodable(..)
, unsafeDecode
, encodeDefault
, decodeDefault
, LazyEncodable(..)
, unsafeDecodeLazy
-- , EncodableF(..)
-- , unsafeDecodeF
-- , Encoded(..)
-- , IsEncoding(..)
, SizeSpecifier(..)
, sizeSpec
, coerceSizeSpec
, monoMapSizes
, minSize
, maxSize
, allSizes
, defaultSize
, sizeIsValid
, newSized
, newSizedMaybe
, SecretKey(..)
, HasSecretKey(..)
, SecretKeyGen(..)
, GSecretKey(..)
, IsNonce(..)
, Nonce(..)
, HasNonce(..)
, NonceGen(..)
, GNonce(..)
, Salt(..)
, HasSalt(..)
, SaltGen(..)
, GSalt(..)
, Password(..)
, GPassword(..)
, Digest(..)
, HasDigest(..)
, GDigest(..)
, Ciphertext(..)
, HasCiphertext(..)
, GCiphertext(..)
, LazyCiphertext(..)
, HasLazyCiphertext(..)
, GLazyCiphertext(..)
) where

import Botan.Prelude hiding (Ciphertext,LazyCiphertext)

import Data.Coerce
import Data.Either
import Data.Maybe
import Data.Proxy

import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Lazy as Lazy

import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text

import Botan.RNG

import Botan.Utility

-- FOR BlockSize
import GHC.TypeLits

-- TODO: gnewSecretKey, gnewNonce, etc

--
-- Helpers
--

showByteStringHex :: ByteString -> String
showByteStringHex ByteString
bs =  Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> HexCase -> Text
hexEncode ByteString
bs HexCase
Lower

--
-- Encoding
--

-- Analogous to saltine:Crypto.Saltine.Class.IsEncoding
class Encodable a where
    encode :: a -> ByteString
    decode :: ByteString -> Maybe a

unsafeDecode :: (Encodable a) => ByteString -> a
unsafeDecode :: forall a. Encodable a => ByteString -> a
unsafeDecode = Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe a -> a) -> (ByteString -> Maybe a) -> ByteString -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe a
forall a. Encodable a => ByteString -> Maybe a
decode

encodeDefault :: (LazyEncodable a) => a -> ByteString
encodeDefault :: forall a. LazyEncodable a => a -> ByteString
encodeDefault = ByteString -> ByteString
ByteString.toStrict (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. LazyEncodable a => a -> ByteString
encodeLazy

decodeDefault :: (LazyEncodable a) => ByteString -> Maybe a
decodeDefault :: forall a. LazyEncodable a => ByteString -> Maybe a
decodeDefault = ByteString -> Maybe a
forall a. LazyEncodable a => ByteString -> Maybe a
decodeLazy (ByteString -> Maybe a)
-> (ByteString -> ByteString) -> ByteString -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
ByteString.fromStrict

instance Encodable ByteString where
    encode :: ByteString -> ByteString
encode = ByteString -> ByteString
forall a. a -> a
id
    decode :: ByteString -> Maybe ByteString
decode = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just

instance Encodable Lazy.ByteString where
    encode :: ByteString -> ByteString
encode = ByteString -> ByteString
ByteString.toStrict
    decode :: ByteString -> Maybe ByteString
decode = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> (ByteString -> ByteString) -> ByteString -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
ByteString.fromStrict

instance Encodable Text where
    encode :: Text -> ByteString
encode = Text -> ByteString
Text.encodeUtf8
    decode :: ByteString -> Maybe Text
decode = (UnicodeException -> Maybe Text)
-> (Text -> Maybe Text)
-> Either UnicodeException Text
-> Maybe Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Text -> UnicodeException -> Maybe Text
forall a b. a -> b -> a
const Maybe Text
forall a. Maybe a
Nothing) Text -> Maybe Text
forall a. a -> Maybe a
Just (Either UnicodeException Text -> Maybe Text)
-> (ByteString -> Either UnicodeException Text)
-> ByteString
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
Text.decodeUtf8'

class (Encodable a) => LazyEncodable a where

    encodeLazy :: a -> Lazy.ByteString
    encodeLazy = ByteString -> ByteString
ByteString.fromStrict (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. Encodable a => a -> ByteString
encode

    decodeLazy :: Lazy.ByteString -> Maybe a
    decodeLazy = ByteString -> Maybe a
forall a. Encodable a => ByteString -> Maybe a
decode (ByteString -> Maybe a)
-> (ByteString -> ByteString) -> ByteString -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
ByteString.toStrict

unsafeDecodeLazy :: (LazyEncodable a) => Lazy.ByteString -> a
unsafeDecodeLazy :: forall a. LazyEncodable a => ByteString -> a
unsafeDecodeLazy = Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe a -> a) -> (ByteString -> Maybe a) -> ByteString -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe a
forall a. LazyEncodable a => ByteString -> Maybe a
decodeLazy

instance LazyEncodable Lazy.ByteString where
    encodeLazy :: ByteString -> ByteString
encodeLazy = ByteString -> ByteString
forall a. a -> a
id
    decodeLazy :: ByteString -> Maybe ByteString
decodeLazy = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just

{- TODO: Encodable base functors
class EncodableF f where
    encodeF :: f ByteString -> ByteString
    decodeF :: ByteString -> Maybe (f ByteString)

unsafeDecodeF :: (EncodableF f) => ByteString -> f ByteString
unsafeDecodeF = fromJust . decodeF
-}

{- TODO: Data family for encoding formats (PEM, BER, DER, ASN1) - something like:
data family Encoded e :: * -> *
class (Encodable (Encoded e a)) => IsEncoding e a where
    encoding :: a -> Encoded e a
    decoding :: Encoded e a -> Maybe a
data PEM
type PEMEncodedByteString = Encoded PEM ByteString
-}

--
-- Size specifiers
--

-- Invariant: If `SizeRange mn mx md` then `mod mn md == 0` and `mod mx md == 0`
--  (or mn and mx congruent modulo md?)
--  Could relax 'min max mod' to 'from to step'
-- Invariant: If `SizeEnum sizes` then `not . null $ sizes`

-- NOTE: We either need this phantom type parameter, or we remove it,
-- rename the type to GSizeSpecifier, and add a SizeSpecifier data family.
-- One or the other is required to provide a type witness for HasFoo.fooSpec:
--      class HasFoo alg where
--          fooSpec :: SizeSpecifier (Foo alg)
data SizeSpecifier a
    = SizeRange Int Int Int -- ^ min max mod
    -- | SizeRange Int Int  -- ^ min max 1
    | SizeEnum [ Int ]      -- ^ one of several sizes
    | SizeExact Int         -- ^ Fixed: exact size
    deriving (SizeSpecifier a -> SizeSpecifier a -> Bool
(SizeSpecifier a -> SizeSpecifier a -> Bool)
-> (SizeSpecifier a -> SizeSpecifier a -> Bool)
-> Eq (SizeSpecifier a)
forall a. SizeSpecifier a -> SizeSpecifier a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. SizeSpecifier a -> SizeSpecifier a -> Bool
== :: SizeSpecifier a -> SizeSpecifier a -> Bool
$c/= :: forall a. SizeSpecifier a -> SizeSpecifier a -> Bool
/= :: SizeSpecifier a -> SizeSpecifier a -> Bool
Eq, Eq (SizeSpecifier a)
Eq (SizeSpecifier a) =>
(SizeSpecifier a -> SizeSpecifier a -> Ordering)
-> (SizeSpecifier a -> SizeSpecifier a -> Bool)
-> (SizeSpecifier a -> SizeSpecifier a -> Bool)
-> (SizeSpecifier a -> SizeSpecifier a -> Bool)
-> (SizeSpecifier a -> SizeSpecifier a -> Bool)
-> (SizeSpecifier a -> SizeSpecifier a -> SizeSpecifier a)
-> (SizeSpecifier a -> SizeSpecifier a -> SizeSpecifier a)
-> Ord (SizeSpecifier a)
SizeSpecifier a -> SizeSpecifier a -> Bool
SizeSpecifier a -> SizeSpecifier a -> Ordering
SizeSpecifier a -> SizeSpecifier a -> SizeSpecifier a
forall a. Eq (SizeSpecifier a)
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
forall a. SizeSpecifier a -> SizeSpecifier a -> Bool
forall a. SizeSpecifier a -> SizeSpecifier a -> Ordering
forall a. SizeSpecifier a -> SizeSpecifier a -> SizeSpecifier a
$ccompare :: forall a. SizeSpecifier a -> SizeSpecifier a -> Ordering
compare :: SizeSpecifier a -> SizeSpecifier a -> Ordering
$c< :: forall a. SizeSpecifier a -> SizeSpecifier a -> Bool
< :: SizeSpecifier a -> SizeSpecifier a -> Bool
$c<= :: forall a. SizeSpecifier a -> SizeSpecifier a -> Bool
<= :: SizeSpecifier a -> SizeSpecifier a -> Bool
$c> :: forall a. SizeSpecifier a -> SizeSpecifier a -> Bool
> :: SizeSpecifier a -> SizeSpecifier a -> Bool
$c>= :: forall a. SizeSpecifier a -> SizeSpecifier a -> Bool
>= :: SizeSpecifier a -> SizeSpecifier a -> Bool
$cmax :: forall a. SizeSpecifier a -> SizeSpecifier a -> SizeSpecifier a
max :: SizeSpecifier a -> SizeSpecifier a -> SizeSpecifier a
$cmin :: forall a. SizeSpecifier a -> SizeSpecifier a -> SizeSpecifier a
min :: SizeSpecifier a -> SizeSpecifier a -> SizeSpecifier a
Ord, Int -> SizeSpecifier a -> ShowS
[SizeSpecifier a] -> ShowS
SizeSpecifier a -> String
(Int -> SizeSpecifier a -> ShowS)
-> (SizeSpecifier a -> String)
-> ([SizeSpecifier a] -> ShowS)
-> Show (SizeSpecifier a)
forall a. Int -> SizeSpecifier a -> ShowS
forall a. [SizeSpecifier a] -> ShowS
forall a. SizeSpecifier a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> SizeSpecifier a -> ShowS
showsPrec :: Int -> SizeSpecifier a -> ShowS
$cshow :: forall a. SizeSpecifier a -> String
show :: SizeSpecifier a -> String
$cshowList :: forall a. [SizeSpecifier a] -> ShowS
showList :: [SizeSpecifier a] -> ShowS
Show)

sizeSpec :: Int -> Int -> Int -> SizeSpecifier a
sizeSpec :: forall a. Int -> Int -> Int -> SizeSpecifier a
sizeSpec Int
mn Int
mx Int
_a | Int
mn Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
mx = Int -> SizeSpecifier a
forall a. Int -> SizeSpecifier a
SizeExact Int
mn
sizeSpec Int
mn Int
mx Int
md           = Int -> Int -> Int -> SizeSpecifier a
forall a. Int -> Int -> Int -> SizeSpecifier a
SizeRange Int
mn Int
mx Int
md

-- TODO: Get rid of this (maybe), after moving the spec values from the
-- ADT tree to individual algorithms (definitely do this though)
coerceSizeSpec :: SizeSpecifier a -> SizeSpecifier b
coerceSizeSpec :: forall a b. SizeSpecifier a -> SizeSpecifier b
coerceSizeSpec = SizeSpecifier a -> SizeSpecifier b
forall a b. Coercible a b => a -> b
coerce

monoMapSizes :: (Int -> Int) -> SizeSpecifier a -> SizeSpecifier a
monoMapSizes :: forall a. (Int -> Int) -> SizeSpecifier a -> SizeSpecifier a
monoMapSizes Int -> Int
f (SizeRange Int
mn Int
mx Int
md) = Int -> Int -> Int -> SizeSpecifier a
forall a. Int -> Int -> Int -> SizeSpecifier a
SizeRange (Int -> Int
f Int
mn) (Int -> Int
f Int
mx) (Int -> Int
f Int
md)
monoMapSizes Int -> Int
f (SizeEnum [Int]
sizes)     = [Int] -> SizeSpecifier a
forall a. [Int] -> SizeSpecifier a
SizeEnum ((Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Int
f [Int]
sizes)
monoMapSizes Int -> Int
f (SizeExact Int
size)     = Int -> SizeSpecifier a
forall a. Int -> SizeSpecifier a
SizeExact (Int -> Int
f Int
size)

minSize :: SizeSpecifier a -> Int
minSize :: forall a. SizeSpecifier a -> Int
minSize (SizeRange Int
mn Int
_ Int
_) = Int
mn
minSize (SizeEnum [Int]
sizes)   = (Int -> Int -> Int) -> Int -> [Int] -> Int
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
forall a. Bounded a => a
maxBound [Int]
sizes
minSize (SizeExact Int
size)   = Int
size

maxSize :: SizeSpecifier a  -> Int
maxSize :: forall a. SizeSpecifier a -> Int
maxSize (SizeRange Int
_ Int
mx Int
_) = Int
mx
maxSize (SizeEnum [Int]
sizes)   = (Int -> Int -> Int) -> Int -> [Int] -> Int
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 [Int]
sizes
maxSize (SizeExact Int
size)   = Int
size

allSizes :: SizeSpecifier a -> [Int]
allSizes :: forall a. SizeSpecifier a -> [Int]
allSizes (SizeRange Int
min Int
max Int
mod) = [ Int
min, Int
minInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
mod .. Int
max ]
allSizes (SizeEnum [Int]
sizes)        = [Int]
sizes
allSizes (SizeExact Int
size)        = [ Int
size ]

defaultSize :: SizeSpecifier a -> Int
defaultSize :: forall a. SizeSpecifier a -> Int
defaultSize = SizeSpecifier a -> Int
forall a. SizeSpecifier a -> Int
maxSize

-- closestSize :: SizeSpecifier -> Int -> Int
-- closestSize = undefined

-- atLeastSize :: SizeSpecifier -> Int -> Int
-- atLeastSize = undefined

-- atMostSize :: SizeSpecifier -> Int -> Int
-- atMostSize = undefined

-- NOTE: Maybe flip this back?
sizeIsValid :: SizeSpecifier a -> Int -> Bool 
sizeIsValid :: forall a. SizeSpecifier a -> Int -> Bool
sizeIsValid (SizeRange Int
mn Int
mx Int
md) Int
sz = Int
mn Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
sz Bool -> Bool -> Bool
&& Int
sz Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
mx Bool -> Bool -> Bool
&& Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod Int
sz Int
md Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
sizeIsValid (SizeEnum [Int]
sizes)     Int
sz = Int
sz Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
sizes
sizeIsValid (SizeExact Int
size)     Int
sz = Int
sz Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
size

newSized :: (MonadRandomIO m) => SizeSpecifier a -> m ByteString
newSized :: forall (m :: * -> *) a.
MonadRandomIO m =>
SizeSpecifier a -> m ByteString
newSized SizeSpecifier a
spec = Int -> m ByteString
forall (m :: * -> *). MonadRandomIO m => Int -> m ByteString
getRandomBytes (SizeSpecifier a -> Int
forall a. SizeSpecifier a -> Int
defaultSize SizeSpecifier a
spec)

-- NOTE: Maybe flip this back?
newSizedMaybe :: (MonadRandomIO m) => SizeSpecifier a -> Int -> m (Maybe ByteString)
newSizedMaybe :: forall (m :: * -> *) a.
MonadRandomIO m =>
SizeSpecifier a -> Int -> m (Maybe ByteString)
newSizedMaybe SizeSpecifier a
spec Int
sz = if SizeSpecifier a -> Int -> Bool
forall a. SizeSpecifier a -> Int -> Bool
sizeIsValid SizeSpecifier a
spec Int
sz
    then ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> m ByteString -> m (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m ByteString
forall (m :: * -> *). MonadRandomIO m => Int -> m ByteString
getRandomBytes Int
sz
    else Maybe ByteString -> m (Maybe ByteString)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing

--
-- Generators
--

-- TODO: Something that conforms with `random` StatefulGen and `statistics` Distribution

-- NOTE: I'm not sure that the `HasFoo.fooSpec` and `FooGen.newFoo` / `FooGen.newFooMaybe` abstraction
-- will hold up over time. Needs more thought on spec vs gen vs maybe-gen / validator
-- Diving one layer deeper to composing attribute generators to get a
--  schema / specifier generator is best left to something like a parser-generator
--  but for distributions. For now, we'll settle at the schematic-level.
{-
-- data family Spec a
data family Gen a
class HasGen (component :: * -> *) alg where
    -- spec :: Spec (component alg)
    defaultGen :: Gen (component alg)
class (HasGen component alg, Monad m) => ComponentGen component alg m where
    newComponent :: m (component alg)
    newComponent = genComponent defaultGen
    -- newComponentMaybe :: spec -> m (Maybe (component alg))
    genComponent :: Gen (component alg) -> m (component alg)
    genComponentMaybe :: (spec -> Maybe (Gen (component alg))) -> spec -> m (Maybe (component alg))
    genComponentMaybe f a = case f a of
        Just gen -> Just <$> genComponent gen
        Nothing  -> return Nothing
-}
-- This requires adding constraints `HasGen foo alg` to `HasFoo` and `ComponentGen foo alg m` to `FooGen`
-- and isn't worth doing at the moment. For now, SizeSpecifier suffices (eg, Spec = SizeSpec, Gen = Size / Int)
-- Eventually I want to use the same interface for keys and nonces as any other random generator / distribution.

--
-- SecretKey
--

-- class (Eq sk, Ord sk, Encodable sk) => IsSecretKey sk where

data family SecretKey alg

class (Encodable (SecretKey alg)) => HasSecretKey alg where
    secretKeySpec :: SizeSpecifier (SecretKey alg)

class (HasSecretKey alg, Monad m) => SecretKeyGen alg m where
    newSecretKey :: m (SecretKey alg)
    newSecretKeyMaybe :: Int -> m (Maybe (SecretKey alg))

newtype GSecretKey = MkGSecretKey { GSecretKey -> ByteString
unGSecretKey :: ByteString }
    deriving newtype (GSecretKey -> GSecretKey -> Bool
(GSecretKey -> GSecretKey -> Bool)
-> (GSecretKey -> GSecretKey -> Bool) -> Eq GSecretKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GSecretKey -> GSecretKey -> Bool
== :: GSecretKey -> GSecretKey -> Bool
$c/= :: GSecretKey -> GSecretKey -> Bool
/= :: GSecretKey -> GSecretKey -> Bool
Eq, Eq GSecretKey
Eq GSecretKey =>
(GSecretKey -> GSecretKey -> Ordering)
-> (GSecretKey -> GSecretKey -> Bool)
-> (GSecretKey -> GSecretKey -> Bool)
-> (GSecretKey -> GSecretKey -> Bool)
-> (GSecretKey -> GSecretKey -> Bool)
-> (GSecretKey -> GSecretKey -> GSecretKey)
-> (GSecretKey -> GSecretKey -> GSecretKey)
-> Ord GSecretKey
GSecretKey -> GSecretKey -> Bool
GSecretKey -> GSecretKey -> Ordering
GSecretKey -> GSecretKey -> GSecretKey
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 :: GSecretKey -> GSecretKey -> Ordering
compare :: GSecretKey -> GSecretKey -> Ordering
$c< :: GSecretKey -> GSecretKey -> Bool
< :: GSecretKey -> GSecretKey -> Bool
$c<= :: GSecretKey -> GSecretKey -> Bool
<= :: GSecretKey -> GSecretKey -> Bool
$c> :: GSecretKey -> GSecretKey -> Bool
> :: GSecretKey -> GSecretKey -> Bool
$c>= :: GSecretKey -> GSecretKey -> Bool
>= :: GSecretKey -> GSecretKey -> Bool
$cmax :: GSecretKey -> GSecretKey -> GSecretKey
max :: GSecretKey -> GSecretKey -> GSecretKey
$cmin :: GSecretKey -> GSecretKey -> GSecretKey
min :: GSecretKey -> GSecretKey -> GSecretKey
Ord, ByteString -> Maybe GSecretKey
GSecretKey -> ByteString
(GSecretKey -> ByteString)
-> (ByteString -> Maybe GSecretKey) -> Encodable GSecretKey
forall a.
(a -> ByteString) -> (ByteString -> Maybe a) -> Encodable a
$cencode :: GSecretKey -> ByteString
encode :: GSecretKey -> ByteString
$cdecode :: ByteString -> Maybe GSecretKey
decode :: ByteString -> Maybe GSecretKey
Encodable)

instance Show GSecretKey where
    show :: GSecretKey -> String
show = ByteString -> String
showByteStringHex (ByteString -> String)
-> (GSecretKey -> ByteString) -> GSecretKey -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GSecretKey -> ByteString
unGSecretKey

-- NOTE: Cannot do g- / default implementation of new keys since we do not yet
-- have the secret key constructor.
-- We also need the algorithm-specific key spec for gnewSecretKey and gnewSecretKeyMaybe.
-- Being unable to do this isn't necessarily bad, just requires more boilerplate - 
-- the benefit being that the implementation of SecretKey is entirely opaque
-- and thus free to be whatever it wants. For example, what if an backing implementation
-- requires that SecretKey alg ~ Integer? (Actually some PK stuff may do just that)
{-
gnewSecretKey :: MonadRandomIO m => m GSecretKey
gnewSecretKey = newSized (secretKeySpec @_)

gnewSecretKeyMaybe :: MonadRandomIO m => Int -> m (Maybe (GSecretKey)
gnewSecretKeyMaybe i = newSizedMaybe (secretKeySpec @_) i
-}

--
-- Nonce
--

class (Eq n, Ord n, Encodable n) => IsNonce n where
    -- zilch :: n
    nudge :: n -> n

data family Nonce alg

class (IsNonce (Nonce alg)) => HasNonce alg where
    nonceSpec :: SizeSpecifier (Nonce alg)

class (HasNonce alg, Monad m) => NonceGen alg m where
    newNonce :: m (Nonce alg)
    newNonceMaybe :: Int -> m (Maybe (Nonce alg))

newtype GNonce = MkGNonce { GNonce -> ByteString
unGNonce :: ByteString }
    deriving newtype (GNonce -> GNonce -> Bool
(GNonce -> GNonce -> Bool)
-> (GNonce -> GNonce -> Bool) -> Eq GNonce
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GNonce -> GNonce -> Bool
== :: GNonce -> GNonce -> Bool
$c/= :: GNonce -> GNonce -> Bool
/= :: GNonce -> GNonce -> Bool
Eq, Eq GNonce
Eq GNonce =>
(GNonce -> GNonce -> Ordering)
-> (GNonce -> GNonce -> Bool)
-> (GNonce -> GNonce -> Bool)
-> (GNonce -> GNonce -> Bool)
-> (GNonce -> GNonce -> Bool)
-> (GNonce -> GNonce -> GNonce)
-> (GNonce -> GNonce -> GNonce)
-> Ord GNonce
GNonce -> GNonce -> Bool
GNonce -> GNonce -> Ordering
GNonce -> GNonce -> GNonce
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 :: GNonce -> GNonce -> Ordering
compare :: GNonce -> GNonce -> Ordering
$c< :: GNonce -> GNonce -> Bool
< :: GNonce -> GNonce -> Bool
$c<= :: GNonce -> GNonce -> Bool
<= :: GNonce -> GNonce -> Bool
$c> :: GNonce -> GNonce -> Bool
> :: GNonce -> GNonce -> Bool
$c>= :: GNonce -> GNonce -> Bool
>= :: GNonce -> GNonce -> Bool
$cmax :: GNonce -> GNonce -> GNonce
max :: GNonce -> GNonce -> GNonce
$cmin :: GNonce -> GNonce -> GNonce
min :: GNonce -> GNonce -> GNonce
Ord, ByteString -> Maybe GNonce
GNonce -> ByteString
(GNonce -> ByteString)
-> (ByteString -> Maybe GNonce) -> Encodable GNonce
forall a.
(a -> ByteString) -> (ByteString -> Maybe a) -> Encodable a
$cencode :: GNonce -> ByteString
encode :: GNonce -> ByteString
$cdecode :: ByteString -> Maybe GNonce
decode :: ByteString -> Maybe GNonce
Encodable)

instance Show GNonce where
    show :: GNonce -> String
show = ByteString -> String
showByteStringHex (ByteString -> String)
-> (GNonce -> ByteString) -> GNonce -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GNonce -> ByteString
unGNonce

-- HACK: Grodiest bytestring incrementer ever
instance IsNonce GNonce where
    nudge :: GNonce -> GNonce
nudge (MkGNonce ByteString
bs) = ByteString -> GNonce
MkGNonce (ByteString -> GNonce) -> ByteString -> GNonce
forall a b. (a -> b) -> a -> b
$ (Bool, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((Bool, ByteString) -> ByteString)
-> (Bool, ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ (Bool -> Word8 -> (Bool, Word8))
-> Bool -> ByteString -> (Bool, ByteString)
forall acc.
(acc -> Word8 -> (acc, Word8))
-> acc -> ByteString -> (acc, ByteString)
ByteString.mapAccumR
        (\ Bool
carry Word8
w -> if Bool
carry then (Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
255, Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
1) else (Bool
False,Word8
w)) Bool
True ByteString
bs

--
-- Salt
--

-- class (Eq s, Ord s, Encodable s) => IsSalt s where

data family Salt alg

class (Encodable (Salt alg)) => HasSalt alg where
    saltSpec :: SizeSpecifier (Salt alg)

class (HasSalt alg, Monad m) => SaltGen alg m where
    newSalt :: m (Salt alg)
    newSaltMaybe :: Int -> m (Maybe (Salt alg))

newtype GSalt = MkGSalt { GSalt -> ByteString
unGSalt :: ByteString }
    deriving newtype (GSalt -> GSalt -> Bool
(GSalt -> GSalt -> Bool) -> (GSalt -> GSalt -> Bool) -> Eq GSalt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GSalt -> GSalt -> Bool
== :: GSalt -> GSalt -> Bool
$c/= :: GSalt -> GSalt -> Bool
/= :: GSalt -> GSalt -> Bool
Eq, Eq GSalt
Eq GSalt =>
(GSalt -> GSalt -> Ordering)
-> (GSalt -> GSalt -> Bool)
-> (GSalt -> GSalt -> Bool)
-> (GSalt -> GSalt -> Bool)
-> (GSalt -> GSalt -> Bool)
-> (GSalt -> GSalt -> GSalt)
-> (GSalt -> GSalt -> GSalt)
-> Ord GSalt
GSalt -> GSalt -> Bool
GSalt -> GSalt -> Ordering
GSalt -> GSalt -> GSalt
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 :: GSalt -> GSalt -> Ordering
compare :: GSalt -> GSalt -> Ordering
$c< :: GSalt -> GSalt -> Bool
< :: GSalt -> GSalt -> Bool
$c<= :: GSalt -> GSalt -> Bool
<= :: GSalt -> GSalt -> Bool
$c> :: GSalt -> GSalt -> Bool
> :: GSalt -> GSalt -> Bool
$c>= :: GSalt -> GSalt -> Bool
>= :: GSalt -> GSalt -> Bool
$cmax :: GSalt -> GSalt -> GSalt
max :: GSalt -> GSalt -> GSalt
$cmin :: GSalt -> GSalt -> GSalt
min :: GSalt -> GSalt -> GSalt
Ord, ByteString -> Maybe GSalt
GSalt -> ByteString
(GSalt -> ByteString)
-> (ByteString -> Maybe GSalt) -> Encodable GSalt
forall a.
(a -> ByteString) -> (ByteString -> Maybe a) -> Encodable a
$cencode :: GSalt -> ByteString
encode :: GSalt -> ByteString
$cdecode :: ByteString -> Maybe GSalt
decode :: ByteString -> Maybe GSalt
Encodable)

instance Show GSalt where
    show :: GSalt -> String
show = ByteString -> String
showByteStringHex (ByteString -> String) -> (GSalt -> ByteString) -> GSalt -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GSalt -> ByteString
unGSalt

--
-- Password
--

-- NOTE: It is strongly suggested that passwords be ASCII
-- This may be enforced in the future

data family Password alg

newtype GPassword = MkGPassword { GPassword -> Text
unGPassword :: Text }
    deriving newtype (GPassword -> GPassword -> Bool
(GPassword -> GPassword -> Bool)
-> (GPassword -> GPassword -> Bool) -> Eq GPassword
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GPassword -> GPassword -> Bool
== :: GPassword -> GPassword -> Bool
$c/= :: GPassword -> GPassword -> Bool
/= :: GPassword -> GPassword -> Bool
Eq, Eq GPassword
Eq GPassword =>
(GPassword -> GPassword -> Ordering)
-> (GPassword -> GPassword -> Bool)
-> (GPassword -> GPassword -> Bool)
-> (GPassword -> GPassword -> Bool)
-> (GPassword -> GPassword -> Bool)
-> (GPassword -> GPassword -> GPassword)
-> (GPassword -> GPassword -> GPassword)
-> Ord GPassword
GPassword -> GPassword -> Bool
GPassword -> GPassword -> Ordering
GPassword -> GPassword -> GPassword
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 :: GPassword -> GPassword -> Ordering
compare :: GPassword -> GPassword -> Ordering
$c< :: GPassword -> GPassword -> Bool
< :: GPassword -> GPassword -> Bool
$c<= :: GPassword -> GPassword -> Bool
<= :: GPassword -> GPassword -> Bool
$c> :: GPassword -> GPassword -> Bool
> :: GPassword -> GPassword -> Bool
$c>= :: GPassword -> GPassword -> Bool
>= :: GPassword -> GPassword -> Bool
$cmax :: GPassword -> GPassword -> GPassword
max :: GPassword -> GPassword -> GPassword
$cmin :: GPassword -> GPassword -> GPassword
min :: GPassword -> GPassword -> GPassword
Ord, ByteString -> Maybe GPassword
GPassword -> ByteString
(GPassword -> ByteString)
-> (ByteString -> Maybe GPassword) -> Encodable GPassword
forall a.
(a -> ByteString) -> (ByteString -> Maybe a) -> Encodable a
$cencode :: GPassword -> ByteString
encode :: GPassword -> ByteString
$cdecode :: ByteString -> Maybe GPassword
decode :: ByteString -> Maybe GPassword
Encodable)

instance Show GPassword where
    show :: GPassword -> String
show = Text -> String
Text.unpack (Text -> String) -> (GPassword -> Text) -> GPassword -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GPassword -> Text
unGPassword

--
-- Digest
--

data family Digest alg

class (Eq (Digest alg), Ord (Digest alg), Encodable (Digest alg)) => HasDigest alg where

newtype GDigest = MkGDigest { GDigest -> ByteString
unGDigest :: ByteString }
    deriving newtype (GDigest -> GDigest -> Bool
(GDigest -> GDigest -> Bool)
-> (GDigest -> GDigest -> Bool) -> Eq GDigest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GDigest -> GDigest -> Bool
== :: GDigest -> GDigest -> Bool
$c/= :: GDigest -> GDigest -> Bool
/= :: GDigest -> GDigest -> Bool
Eq, Eq GDigest
Eq GDigest =>
(GDigest -> GDigest -> Ordering)
-> (GDigest -> GDigest -> Bool)
-> (GDigest -> GDigest -> Bool)
-> (GDigest -> GDigest -> Bool)
-> (GDigest -> GDigest -> Bool)
-> (GDigest -> GDigest -> GDigest)
-> (GDigest -> GDigest -> GDigest)
-> Ord GDigest
GDigest -> GDigest -> Bool
GDigest -> GDigest -> Ordering
GDigest -> GDigest -> GDigest
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 :: GDigest -> GDigest -> Ordering
compare :: GDigest -> GDigest -> Ordering
$c< :: GDigest -> GDigest -> Bool
< :: GDigest -> GDigest -> Bool
$c<= :: GDigest -> GDigest -> Bool
<= :: GDigest -> GDigest -> Bool
$c> :: GDigest -> GDigest -> Bool
> :: GDigest -> GDigest -> Bool
$c>= :: GDigest -> GDigest -> Bool
>= :: GDigest -> GDigest -> Bool
$cmax :: GDigest -> GDigest -> GDigest
max :: GDigest -> GDigest -> GDigest
$cmin :: GDigest -> GDigest -> GDigest
min :: GDigest -> GDigest -> GDigest
Ord, ByteString -> Maybe GDigest
GDigest -> ByteString
(GDigest -> ByteString)
-> (ByteString -> Maybe GDigest) -> Encodable GDigest
forall a.
(a -> ByteString) -> (ByteString -> Maybe a) -> Encodable a
$cencode :: GDigest -> ByteString
encode :: GDigest -> ByteString
$cdecode :: ByteString -> Maybe GDigest
decode :: ByteString -> Maybe GDigest
Encodable)

instance Show GDigest where
    show :: GDigest -> String
show = ByteString -> String
showByteStringHex (ByteString -> String)
-> (GDigest -> ByteString) -> GDigest -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GDigest -> ByteString
unGDigest

--
-- Ciphertext
--

data family Ciphertext alg

class (Eq (Ciphertext alg), Ord (Ciphertext alg), Encodable (Ciphertext alg)) => HasCiphertext alg where

newtype GCiphertext = MkGCiphertext { GCiphertext -> ByteString
unGCiphertext :: ByteString }
    deriving newtype (GCiphertext -> GCiphertext -> Bool
(GCiphertext -> GCiphertext -> Bool)
-> (GCiphertext -> GCiphertext -> Bool) -> Eq GCiphertext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GCiphertext -> GCiphertext -> Bool
== :: GCiphertext -> GCiphertext -> Bool
$c/= :: GCiphertext -> GCiphertext -> Bool
/= :: GCiphertext -> GCiphertext -> Bool
Eq, Eq GCiphertext
Eq GCiphertext =>
(GCiphertext -> GCiphertext -> Ordering)
-> (GCiphertext -> GCiphertext -> Bool)
-> (GCiphertext -> GCiphertext -> Bool)
-> (GCiphertext -> GCiphertext -> Bool)
-> (GCiphertext -> GCiphertext -> Bool)
-> (GCiphertext -> GCiphertext -> GCiphertext)
-> (GCiphertext -> GCiphertext -> GCiphertext)
-> Ord GCiphertext
GCiphertext -> GCiphertext -> Bool
GCiphertext -> GCiphertext -> Ordering
GCiphertext -> GCiphertext -> GCiphertext
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 :: GCiphertext -> GCiphertext -> Ordering
compare :: GCiphertext -> GCiphertext -> Ordering
$c< :: GCiphertext -> GCiphertext -> Bool
< :: GCiphertext -> GCiphertext -> Bool
$c<= :: GCiphertext -> GCiphertext -> Bool
<= :: GCiphertext -> GCiphertext -> Bool
$c> :: GCiphertext -> GCiphertext -> Bool
> :: GCiphertext -> GCiphertext -> Bool
$c>= :: GCiphertext -> GCiphertext -> Bool
>= :: GCiphertext -> GCiphertext -> Bool
$cmax :: GCiphertext -> GCiphertext -> GCiphertext
max :: GCiphertext -> GCiphertext -> GCiphertext
$cmin :: GCiphertext -> GCiphertext -> GCiphertext
min :: GCiphertext -> GCiphertext -> GCiphertext
Ord, ByteString -> Maybe GCiphertext
GCiphertext -> ByteString
(GCiphertext -> ByteString)
-> (ByteString -> Maybe GCiphertext) -> Encodable GCiphertext
forall a.
(a -> ByteString) -> (ByteString -> Maybe a) -> Encodable a
$cencode :: GCiphertext -> ByteString
encode :: GCiphertext -> ByteString
$cdecode :: ByteString -> Maybe GCiphertext
decode :: ByteString -> Maybe GCiphertext
Encodable)

instance Show GCiphertext where
    show :: GCiphertext -> String
show = ByteString -> String
showByteStringHex (ByteString -> String)
-> (GCiphertext -> ByteString) -> GCiphertext -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GCiphertext -> ByteString
unGCiphertext

--
-- Incremental Ciphertext
--

data family LazyCiphertext alg

class (HasCiphertext alg, Eq (LazyCiphertext alg), Ord (LazyCiphertext alg), LazyEncodable (LazyCiphertext alg)) => HasLazyCiphertext alg where
    toStrictCiphertext :: LazyCiphertext alg -> Ciphertext alg
    toStrictCiphertext = ByteString -> Ciphertext alg
forall a. Encodable a => ByteString -> a
unsafeDecode (ByteString -> Ciphertext alg)
-> (LazyCiphertext alg -> ByteString)
-> LazyCiphertext alg
-> Ciphertext alg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LazyCiphertext alg -> ByteString
forall a. Encodable a => a -> ByteString
encode
    fromStrictCiphertext :: Ciphertext alg -> LazyCiphertext alg
    fromStrictCiphertext = ByteString -> LazyCiphertext alg
forall a. LazyEncodable a => ByteString -> a
unsafeDecodeLazy (ByteString -> LazyCiphertext alg)
-> (Ciphertext alg -> ByteString)
-> Ciphertext alg
-> LazyCiphertext alg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
ByteString.fromStrict (ByteString -> ByteString)
-> (Ciphertext alg -> ByteString) -> Ciphertext alg -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ciphertext alg -> ByteString
forall a. Encodable a => a -> ByteString
encode

newtype GLazyCiphertext = MkGLazyCiphertext { GLazyCiphertext -> ByteString
unGLazyCiphertext :: Lazy.ByteString }
    deriving newtype (GLazyCiphertext -> GLazyCiphertext -> Bool
(GLazyCiphertext -> GLazyCiphertext -> Bool)
-> (GLazyCiphertext -> GLazyCiphertext -> Bool)
-> Eq GLazyCiphertext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GLazyCiphertext -> GLazyCiphertext -> Bool
== :: GLazyCiphertext -> GLazyCiphertext -> Bool
$c/= :: GLazyCiphertext -> GLazyCiphertext -> Bool
/= :: GLazyCiphertext -> GLazyCiphertext -> Bool
Eq, Eq GLazyCiphertext
Eq GLazyCiphertext =>
(GLazyCiphertext -> GLazyCiphertext -> Ordering)
-> (GLazyCiphertext -> GLazyCiphertext -> Bool)
-> (GLazyCiphertext -> GLazyCiphertext -> Bool)
-> (GLazyCiphertext -> GLazyCiphertext -> Bool)
-> (GLazyCiphertext -> GLazyCiphertext -> Bool)
-> (GLazyCiphertext -> GLazyCiphertext -> GLazyCiphertext)
-> (GLazyCiphertext -> GLazyCiphertext -> GLazyCiphertext)
-> Ord GLazyCiphertext
GLazyCiphertext -> GLazyCiphertext -> Bool
GLazyCiphertext -> GLazyCiphertext -> Ordering
GLazyCiphertext -> GLazyCiphertext -> GLazyCiphertext
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 :: GLazyCiphertext -> GLazyCiphertext -> Ordering
compare :: GLazyCiphertext -> GLazyCiphertext -> Ordering
$c< :: GLazyCiphertext -> GLazyCiphertext -> Bool
< :: GLazyCiphertext -> GLazyCiphertext -> Bool
$c<= :: GLazyCiphertext -> GLazyCiphertext -> Bool
<= :: GLazyCiphertext -> GLazyCiphertext -> Bool
$c> :: GLazyCiphertext -> GLazyCiphertext -> Bool
> :: GLazyCiphertext -> GLazyCiphertext -> Bool
$c>= :: GLazyCiphertext -> GLazyCiphertext -> Bool
>= :: GLazyCiphertext -> GLazyCiphertext -> Bool
$cmax :: GLazyCiphertext -> GLazyCiphertext -> GLazyCiphertext
max :: GLazyCiphertext -> GLazyCiphertext -> GLazyCiphertext
$cmin :: GLazyCiphertext -> GLazyCiphertext -> GLazyCiphertext
min :: GLazyCiphertext -> GLazyCiphertext -> GLazyCiphertext
Ord, ByteString -> Maybe GLazyCiphertext
GLazyCiphertext -> ByteString
(GLazyCiphertext -> ByteString)
-> (ByteString -> Maybe GLazyCiphertext)
-> Encodable GLazyCiphertext
forall a.
(a -> ByteString) -> (ByteString -> Maybe a) -> Encodable a
$cencode :: GLazyCiphertext -> ByteString
encode :: GLazyCiphertext -> ByteString
$cdecode :: ByteString -> Maybe GLazyCiphertext
decode :: ByteString -> Maybe GLazyCiphertext
Encodable, Encodable GLazyCiphertext
ByteString -> Maybe GLazyCiphertext
GLazyCiphertext -> ByteString
Encodable GLazyCiphertext =>
(GLazyCiphertext -> ByteString)
-> (ByteString -> Maybe GLazyCiphertext)
-> LazyEncodable GLazyCiphertext
forall a.
Encodable a =>
(a -> ByteString) -> (ByteString -> Maybe a) -> LazyEncodable a
$cencodeLazy :: GLazyCiphertext -> ByteString
encodeLazy :: GLazyCiphertext -> ByteString
$cdecodeLazy :: ByteString -> Maybe GLazyCiphertext
decodeLazy :: ByteString -> Maybe GLazyCiphertext
LazyEncodable)

instance Show GLazyCiphertext where
    show :: GLazyCiphertext -> String
show = ByteString -> String
showByteStringHex (ByteString -> String)
-> (GLazyCiphertext -> ByteString) -> GLazyCiphertext -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
ByteString.toStrict (ByteString -> ByteString)
-> (GLazyCiphertext -> ByteString) -> GLazyCiphertext -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GLazyCiphertext -> ByteString
unGLazyCiphertext

--
-- TODO: classes / data families for:
--  BlockSize / HasBlockSize
--  KeySize / HasKeySize
--  NonceSize / NonceKeySize
--  DigestSize / HasDigestSize
-- This could mesh with the SizeSpecifier
--

-- data family BlockSize (n :: Nat)

-- class (KnownNat n) => HasBlockSize (n :: Nat) alg where
--     blockSize :: BlockSize n alg
--     -- blockSize = fromInteger $ natVal $ Proxy @n
--     fromBlockSize :: (Integral sz) => BlockSize n alg -> sz
--     fromBlockSize _ = fromInteger $ natVal $ Proxy @n



-- newtype Block (n :: Nat) = MkBlock ByteString
    
-- class IsBlockSize n where

-- data family BlockSize alg

-- class (IsBlockSize (BlockSize alg)) => HasBlockSize alg where
--     blockSize :: BlockSize alg

-- newtype GBlockSize = MkGBlockSize { unGBlockSize :: Int }
--     deriving newtype (Eq, Ord, Show)