module Botan.BlockCipher.GOST
( GOST_28147_89(..)
, GOST_28147_89SecretKey(..)
, pattern GOST_28147_89SecretKey
, getGOST_28147_89SecretKey
, GOST_28147_89Ciphertext(..)
, gost_28147_89Encrypt
, gost_28147_89Decrypt
, gost_28147_89EncryptLazy
, gost_28147_89DecryptLazy
) where

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

import qualified Botan.BlockCipher as Botan
import qualified Botan.Utility as Botan

import Botan.Prelude hiding (Ciphertext, LazyCiphertext)

import Botan.BlockCipher.Class
import Botan.Types.Class
import Botan.RNG

-- GOST_28147_89 type

data GOST_28147_89

newtype instance SecretKey GOST_28147_89 = MkGOST_28147_89SecretKey GSecretKey
    deriving newtype (SecretKey GOST_28147_89 -> SecretKey GOST_28147_89 -> Bool
(SecretKey GOST_28147_89 -> SecretKey GOST_28147_89 -> Bool)
-> (SecretKey GOST_28147_89 -> SecretKey GOST_28147_89 -> Bool)
-> Eq (SecretKey GOST_28147_89)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SecretKey GOST_28147_89 -> SecretKey GOST_28147_89 -> Bool
== :: SecretKey GOST_28147_89 -> SecretKey GOST_28147_89 -> Bool
$c/= :: SecretKey GOST_28147_89 -> SecretKey GOST_28147_89 -> Bool
/= :: SecretKey GOST_28147_89 -> SecretKey GOST_28147_89 -> Bool
Eq, Eq (SecretKey GOST_28147_89)
Eq (SecretKey GOST_28147_89) =>
(SecretKey GOST_28147_89 -> SecretKey GOST_28147_89 -> Ordering)
-> (SecretKey GOST_28147_89 -> SecretKey GOST_28147_89 -> Bool)
-> (SecretKey GOST_28147_89 -> SecretKey GOST_28147_89 -> Bool)
-> (SecretKey GOST_28147_89 -> SecretKey GOST_28147_89 -> Bool)
-> (SecretKey GOST_28147_89 -> SecretKey GOST_28147_89 -> Bool)
-> (SecretKey GOST_28147_89
    -> SecretKey GOST_28147_89 -> SecretKey GOST_28147_89)
-> (SecretKey GOST_28147_89
    -> SecretKey GOST_28147_89 -> SecretKey GOST_28147_89)
-> Ord (SecretKey GOST_28147_89)
SecretKey GOST_28147_89 -> SecretKey GOST_28147_89 -> Bool
SecretKey GOST_28147_89 -> SecretKey GOST_28147_89 -> Ordering
SecretKey GOST_28147_89
-> SecretKey GOST_28147_89 -> SecretKey GOST_28147_89
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 :: SecretKey GOST_28147_89 -> SecretKey GOST_28147_89 -> Ordering
compare :: SecretKey GOST_28147_89 -> SecretKey GOST_28147_89 -> Ordering
$c< :: SecretKey GOST_28147_89 -> SecretKey GOST_28147_89 -> Bool
< :: SecretKey GOST_28147_89 -> SecretKey GOST_28147_89 -> Bool
$c<= :: SecretKey GOST_28147_89 -> SecretKey GOST_28147_89 -> Bool
<= :: SecretKey GOST_28147_89 -> SecretKey GOST_28147_89 -> Bool
$c> :: SecretKey GOST_28147_89 -> SecretKey GOST_28147_89 -> Bool
> :: SecretKey GOST_28147_89 -> SecretKey GOST_28147_89 -> Bool
$c>= :: SecretKey GOST_28147_89 -> SecretKey GOST_28147_89 -> Bool
>= :: SecretKey GOST_28147_89 -> SecretKey GOST_28147_89 -> Bool
$cmax :: SecretKey GOST_28147_89
-> SecretKey GOST_28147_89 -> SecretKey GOST_28147_89
max :: SecretKey GOST_28147_89
-> SecretKey GOST_28147_89 -> SecretKey GOST_28147_89
$cmin :: SecretKey GOST_28147_89
-> SecretKey GOST_28147_89 -> SecretKey GOST_28147_89
min :: SecretKey GOST_28147_89
-> SecretKey GOST_28147_89 -> SecretKey GOST_28147_89
Ord, Int -> SecretKey GOST_28147_89 -> ShowS
[SecretKey GOST_28147_89] -> ShowS
SecretKey GOST_28147_89 -> String
(Int -> SecretKey GOST_28147_89 -> ShowS)
-> (SecretKey GOST_28147_89 -> String)
-> ([SecretKey GOST_28147_89] -> ShowS)
-> Show (SecretKey GOST_28147_89)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SecretKey GOST_28147_89 -> ShowS
showsPrec :: Int -> SecretKey GOST_28147_89 -> ShowS
$cshow :: SecretKey GOST_28147_89 -> String
show :: SecretKey GOST_28147_89 -> String
$cshowList :: [SecretKey GOST_28147_89] -> ShowS
showList :: [SecretKey GOST_28147_89] -> ShowS
Show, ByteString -> Maybe (SecretKey GOST_28147_89)
SecretKey GOST_28147_89 -> ByteString
(SecretKey GOST_28147_89 -> ByteString)
-> (ByteString -> Maybe (SecretKey GOST_28147_89))
-> Encodable (SecretKey GOST_28147_89)
forall a.
(a -> ByteString) -> (ByteString -> Maybe a) -> Encodable a
$cencode :: SecretKey GOST_28147_89 -> ByteString
encode :: SecretKey GOST_28147_89 -> ByteString
$cdecode :: ByteString -> Maybe (SecretKey GOST_28147_89)
decode :: ByteString -> Maybe (SecretKey GOST_28147_89)
Encodable)

pattern GOST_28147_89SecretKey :: ByteString -> SecretKey GOST_28147_89
pattern $mGOST_28147_89SecretKey :: forall {r}.
SecretKey GOST_28147_89 -> (ByteString -> r) -> ((# #) -> r) -> r
$bGOST_28147_89SecretKey :: ByteString -> SecretKey GOST_28147_89
GOST_28147_89SecretKey bytes = MkGOST_28147_89SecretKey (MkGSecretKey bytes)

getGOST_28147_89SecretKey :: SecretKey GOST_28147_89 -> ByteString
getGOST_28147_89SecretKey :: SecretKey GOST_28147_89 -> ByteString
getGOST_28147_89SecretKey (GOST_28147_89SecretKey ByteString
bs) = ByteString
bs

type GOST_28147_89SecretKey = SecretKey GOST_28147_89

newtype instance Ciphertext GOST_28147_89 = MkGOST_28147_89Ciphertext GCiphertext
    deriving newtype (Ciphertext GOST_28147_89 -> Ciphertext GOST_28147_89 -> Bool
(Ciphertext GOST_28147_89 -> Ciphertext GOST_28147_89 -> Bool)
-> (Ciphertext GOST_28147_89 -> Ciphertext GOST_28147_89 -> Bool)
-> Eq (Ciphertext GOST_28147_89)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Ciphertext GOST_28147_89 -> Ciphertext GOST_28147_89 -> Bool
== :: Ciphertext GOST_28147_89 -> Ciphertext GOST_28147_89 -> Bool
$c/= :: Ciphertext GOST_28147_89 -> Ciphertext GOST_28147_89 -> Bool
/= :: Ciphertext GOST_28147_89 -> Ciphertext GOST_28147_89 -> Bool
Eq, Eq (Ciphertext GOST_28147_89)
Eq (Ciphertext GOST_28147_89) =>
(Ciphertext GOST_28147_89 -> Ciphertext GOST_28147_89 -> Ordering)
-> (Ciphertext GOST_28147_89 -> Ciphertext GOST_28147_89 -> Bool)
-> (Ciphertext GOST_28147_89 -> Ciphertext GOST_28147_89 -> Bool)
-> (Ciphertext GOST_28147_89 -> Ciphertext GOST_28147_89 -> Bool)
-> (Ciphertext GOST_28147_89 -> Ciphertext GOST_28147_89 -> Bool)
-> (Ciphertext GOST_28147_89
    -> Ciphertext GOST_28147_89 -> Ciphertext GOST_28147_89)
-> (Ciphertext GOST_28147_89
    -> Ciphertext GOST_28147_89 -> Ciphertext GOST_28147_89)
-> Ord (Ciphertext GOST_28147_89)
Ciphertext GOST_28147_89 -> Ciphertext GOST_28147_89 -> Bool
Ciphertext GOST_28147_89 -> Ciphertext GOST_28147_89 -> Ordering
Ciphertext GOST_28147_89
-> Ciphertext GOST_28147_89 -> Ciphertext GOST_28147_89
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 :: Ciphertext GOST_28147_89 -> Ciphertext GOST_28147_89 -> Ordering
compare :: Ciphertext GOST_28147_89 -> Ciphertext GOST_28147_89 -> Ordering
$c< :: Ciphertext GOST_28147_89 -> Ciphertext GOST_28147_89 -> Bool
< :: Ciphertext GOST_28147_89 -> Ciphertext GOST_28147_89 -> Bool
$c<= :: Ciphertext GOST_28147_89 -> Ciphertext GOST_28147_89 -> Bool
<= :: Ciphertext GOST_28147_89 -> Ciphertext GOST_28147_89 -> Bool
$c> :: Ciphertext GOST_28147_89 -> Ciphertext GOST_28147_89 -> Bool
> :: Ciphertext GOST_28147_89 -> Ciphertext GOST_28147_89 -> Bool
$c>= :: Ciphertext GOST_28147_89 -> Ciphertext GOST_28147_89 -> Bool
>= :: Ciphertext GOST_28147_89 -> Ciphertext GOST_28147_89 -> Bool
$cmax :: Ciphertext GOST_28147_89
-> Ciphertext GOST_28147_89 -> Ciphertext GOST_28147_89
max :: Ciphertext GOST_28147_89
-> Ciphertext GOST_28147_89 -> Ciphertext GOST_28147_89
$cmin :: Ciphertext GOST_28147_89
-> Ciphertext GOST_28147_89 -> Ciphertext GOST_28147_89
min :: Ciphertext GOST_28147_89
-> Ciphertext GOST_28147_89 -> Ciphertext GOST_28147_89
Ord, Int -> Ciphertext GOST_28147_89 -> ShowS
[Ciphertext GOST_28147_89] -> ShowS
Ciphertext GOST_28147_89 -> String
(Int -> Ciphertext GOST_28147_89 -> ShowS)
-> (Ciphertext GOST_28147_89 -> String)
-> ([Ciphertext GOST_28147_89] -> ShowS)
-> Show (Ciphertext GOST_28147_89)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Ciphertext GOST_28147_89 -> ShowS
showsPrec :: Int -> Ciphertext GOST_28147_89 -> ShowS
$cshow :: Ciphertext GOST_28147_89 -> String
show :: Ciphertext GOST_28147_89 -> String
$cshowList :: [Ciphertext GOST_28147_89] -> ShowS
showList :: [Ciphertext GOST_28147_89] -> ShowS
Show, ByteString -> Maybe (Ciphertext GOST_28147_89)
Ciphertext GOST_28147_89 -> ByteString
(Ciphertext GOST_28147_89 -> ByteString)
-> (ByteString -> Maybe (Ciphertext GOST_28147_89))
-> Encodable (Ciphertext GOST_28147_89)
forall a.
(a -> ByteString) -> (ByteString -> Maybe a) -> Encodable a
$cencode :: Ciphertext GOST_28147_89 -> ByteString
encode :: Ciphertext GOST_28147_89 -> ByteString
$cdecode :: ByteString -> Maybe (Ciphertext GOST_28147_89)
decode :: ByteString -> Maybe (Ciphertext GOST_28147_89)
Encodable)

pattern GOST_28147_89Ciphertext :: ByteString -> Ciphertext GOST_28147_89
pattern $mGOST_28147_89Ciphertext :: forall {r}.
Ciphertext GOST_28147_89 -> (ByteString -> r) -> ((# #) -> r) -> r
$bGOST_28147_89Ciphertext :: ByteString -> Ciphertext GOST_28147_89
GOST_28147_89Ciphertext bs = MkGOST_28147_89Ciphertext (MkGCiphertext bs)

getGOST_28147_89Ciphertext :: Ciphertext GOST_28147_89 -> ByteString
getGOST_28147_89Ciphertext :: Ciphertext GOST_28147_89 -> ByteString
getGOST_28147_89Ciphertext (GOST_28147_89Ciphertext ByteString
bs) = ByteString
bs

type GOST_28147_89Ciphertext = Ciphertext GOST_28147_89

newtype instance LazyCiphertext GOST_28147_89 = MkGOST_28147_89LazyCiphertext GLazyCiphertext
    deriving newtype (LazyCiphertext GOST_28147_89
-> LazyCiphertext GOST_28147_89 -> Bool
(LazyCiphertext GOST_28147_89
 -> LazyCiphertext GOST_28147_89 -> Bool)
-> (LazyCiphertext GOST_28147_89
    -> LazyCiphertext GOST_28147_89 -> Bool)
-> Eq (LazyCiphertext GOST_28147_89)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LazyCiphertext GOST_28147_89
-> LazyCiphertext GOST_28147_89 -> Bool
== :: LazyCiphertext GOST_28147_89
-> LazyCiphertext GOST_28147_89 -> Bool
$c/= :: LazyCiphertext GOST_28147_89
-> LazyCiphertext GOST_28147_89 -> Bool
/= :: LazyCiphertext GOST_28147_89
-> LazyCiphertext GOST_28147_89 -> Bool
Eq, Eq (LazyCiphertext GOST_28147_89)
Eq (LazyCiphertext GOST_28147_89) =>
(LazyCiphertext GOST_28147_89
 -> LazyCiphertext GOST_28147_89 -> Ordering)
-> (LazyCiphertext GOST_28147_89
    -> LazyCiphertext GOST_28147_89 -> Bool)
-> (LazyCiphertext GOST_28147_89
    -> LazyCiphertext GOST_28147_89 -> Bool)
-> (LazyCiphertext GOST_28147_89
    -> LazyCiphertext GOST_28147_89 -> Bool)
-> (LazyCiphertext GOST_28147_89
    -> LazyCiphertext GOST_28147_89 -> Bool)
-> (LazyCiphertext GOST_28147_89
    -> LazyCiphertext GOST_28147_89 -> LazyCiphertext GOST_28147_89)
-> (LazyCiphertext GOST_28147_89
    -> LazyCiphertext GOST_28147_89 -> LazyCiphertext GOST_28147_89)
-> Ord (LazyCiphertext GOST_28147_89)
LazyCiphertext GOST_28147_89
-> LazyCiphertext GOST_28147_89 -> Bool
LazyCiphertext GOST_28147_89
-> LazyCiphertext GOST_28147_89 -> Ordering
LazyCiphertext GOST_28147_89
-> LazyCiphertext GOST_28147_89 -> LazyCiphertext GOST_28147_89
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 :: LazyCiphertext GOST_28147_89
-> LazyCiphertext GOST_28147_89 -> Ordering
compare :: LazyCiphertext GOST_28147_89
-> LazyCiphertext GOST_28147_89 -> Ordering
$c< :: LazyCiphertext GOST_28147_89
-> LazyCiphertext GOST_28147_89 -> Bool
< :: LazyCiphertext GOST_28147_89
-> LazyCiphertext GOST_28147_89 -> Bool
$c<= :: LazyCiphertext GOST_28147_89
-> LazyCiphertext GOST_28147_89 -> Bool
<= :: LazyCiphertext GOST_28147_89
-> LazyCiphertext GOST_28147_89 -> Bool
$c> :: LazyCiphertext GOST_28147_89
-> LazyCiphertext GOST_28147_89 -> Bool
> :: LazyCiphertext GOST_28147_89
-> LazyCiphertext GOST_28147_89 -> Bool
$c>= :: LazyCiphertext GOST_28147_89
-> LazyCiphertext GOST_28147_89 -> Bool
>= :: LazyCiphertext GOST_28147_89
-> LazyCiphertext GOST_28147_89 -> Bool
$cmax :: LazyCiphertext GOST_28147_89
-> LazyCiphertext GOST_28147_89 -> LazyCiphertext GOST_28147_89
max :: LazyCiphertext GOST_28147_89
-> LazyCiphertext GOST_28147_89 -> LazyCiphertext GOST_28147_89
$cmin :: LazyCiphertext GOST_28147_89
-> LazyCiphertext GOST_28147_89 -> LazyCiphertext GOST_28147_89
min :: LazyCiphertext GOST_28147_89
-> LazyCiphertext GOST_28147_89 -> LazyCiphertext GOST_28147_89
Ord, Int -> LazyCiphertext GOST_28147_89 -> ShowS
[LazyCiphertext GOST_28147_89] -> ShowS
LazyCiphertext GOST_28147_89 -> String
(Int -> LazyCiphertext GOST_28147_89 -> ShowS)
-> (LazyCiphertext GOST_28147_89 -> String)
-> ([LazyCiphertext GOST_28147_89] -> ShowS)
-> Show (LazyCiphertext GOST_28147_89)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LazyCiphertext GOST_28147_89 -> ShowS
showsPrec :: Int -> LazyCiphertext GOST_28147_89 -> ShowS
$cshow :: LazyCiphertext GOST_28147_89 -> String
show :: LazyCiphertext GOST_28147_89 -> String
$cshowList :: [LazyCiphertext GOST_28147_89] -> ShowS
showList :: [LazyCiphertext GOST_28147_89] -> ShowS
Show, ByteString -> Maybe (LazyCiphertext GOST_28147_89)
LazyCiphertext GOST_28147_89 -> ByteString
(LazyCiphertext GOST_28147_89 -> ByteString)
-> (ByteString -> Maybe (LazyCiphertext GOST_28147_89))
-> Encodable (LazyCiphertext GOST_28147_89)
forall a.
(a -> ByteString) -> (ByteString -> Maybe a) -> Encodable a
$cencode :: LazyCiphertext GOST_28147_89 -> ByteString
encode :: LazyCiphertext GOST_28147_89 -> ByteString
$cdecode :: ByteString -> Maybe (LazyCiphertext GOST_28147_89)
decode :: ByteString -> Maybe (LazyCiphertext GOST_28147_89)
Encodable, Encodable (LazyCiphertext GOST_28147_89)
ByteString -> Maybe (LazyCiphertext GOST_28147_89)
LazyCiphertext GOST_28147_89 -> ByteString
Encodable (LazyCiphertext GOST_28147_89) =>
(LazyCiphertext GOST_28147_89 -> ByteString)
-> (ByteString -> Maybe (LazyCiphertext GOST_28147_89))
-> LazyEncodable (LazyCiphertext GOST_28147_89)
forall a.
Encodable a =>
(a -> ByteString) -> (ByteString -> Maybe a) -> LazyEncodable a
$cencodeLazy :: LazyCiphertext GOST_28147_89 -> ByteString
encodeLazy :: LazyCiphertext GOST_28147_89 -> ByteString
$cdecodeLazy :: ByteString -> Maybe (LazyCiphertext GOST_28147_89)
decodeLazy :: ByteString -> Maybe (LazyCiphertext GOST_28147_89)
LazyEncodable)

pattern GOST_28147_89LazyCiphertext :: Lazy.ByteString -> LazyCiphertext GOST_28147_89
pattern $mGOST_28147_89LazyCiphertext :: forall {r}.
LazyCiphertext GOST_28147_89
-> (ByteString -> r) -> ((# #) -> r) -> r
$bGOST_28147_89LazyCiphertext :: ByteString -> LazyCiphertext GOST_28147_89
GOST_28147_89LazyCiphertext lbs = MkGOST_28147_89LazyCiphertext (MkGLazyCiphertext lbs)

getGOST_28147_89LazyCiphertext :: LazyCiphertext GOST_28147_89 -> Lazy.ByteString
getGOST_28147_89LazyCiphertext :: LazyCiphertext GOST_28147_89 -> ByteString
getGOST_28147_89LazyCiphertext (GOST_28147_89LazyCiphertext ByteString
bs) = ByteString
bs

type GOST_28147_89LazyCiphertext = LazyCiphertext GOST_28147_89

instance HasSecretKey GOST_28147_89 where
    
    secretKeySpec :: SizeSpecifier (SecretKey GOST_28147_89)
    secretKeySpec :: SizeSpecifier (SecretKey GOST_28147_89)
secretKeySpec = SizeSpecifier () -> SizeSpecifier (SecretKey GOST_28147_89)
forall a b. SizeSpecifier a -> SizeSpecifier b
coerceSizeSpec (SizeSpecifier () -> SizeSpecifier (SecretKey GOST_28147_89))
-> SizeSpecifier () -> SizeSpecifier (SecretKey GOST_28147_89)
forall a b. (a -> b) -> a -> b
$ BlockCipher -> SizeSpecifier ()
Botan.blockCipherKeySpec BlockCipher
Botan.gost_28147_89

instance (MonadRandomIO m )=> SecretKeyGen GOST_28147_89 m where

    newSecretKey :: MonadRandomIO m => m (SecretKey GOST_28147_89)
    newSecretKey :: MonadRandomIO m => m (SecretKey GOST_28147_89)
newSecretKey = ByteString -> SecretKey GOST_28147_89
GOST_28147_89SecretKey (ByteString -> SecretKey GOST_28147_89)
-> m ByteString -> m (SecretKey GOST_28147_89)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SizeSpecifier (SecretKey GOST_28147_89) -> m ByteString
forall (m :: * -> *) a.
MonadRandomIO m =>
SizeSpecifier a -> m ByteString
newSized (forall alg. HasSecretKey alg => SizeSpecifier (SecretKey alg)
secretKeySpec @GOST_28147_89)
    
    newSecretKeyMaybe :: MonadRandomIO m => Int -> m (Maybe (SecretKey GOST_28147_89))
    newSecretKeyMaybe :: MonadRandomIO m => Int -> m (Maybe (SecretKey GOST_28147_89))
newSecretKeyMaybe Int
i = (ByteString -> SecretKey GOST_28147_89)
-> Maybe ByteString -> Maybe (SecretKey GOST_28147_89)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> SecretKey GOST_28147_89
GOST_28147_89SecretKey (Maybe ByteString -> Maybe (SecretKey GOST_28147_89))
-> m (Maybe ByteString) -> m (Maybe (SecretKey GOST_28147_89))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SizeSpecifier (SecretKey GOST_28147_89)
-> Int -> m (Maybe ByteString)
forall (m :: * -> *) a.
MonadRandomIO m =>
SizeSpecifier a -> Int -> m (Maybe ByteString)
newSizedMaybe (forall alg. HasSecretKey alg => SizeSpecifier (SecretKey alg)
secretKeySpec @GOST_28147_89) Int
i

instance HasCiphertext GOST_28147_89 where

instance BlockCipher GOST_28147_89 where

    blockCipherEncrypt :: SecretKey GOST_28147_89 -> ByteString -> Maybe (Ciphertext GOST_28147_89)
    blockCipherEncrypt :: SecretKey GOST_28147_89
-> ByteString -> Maybe (Ciphertext GOST_28147_89)
blockCipherEncrypt (GOST_28147_89SecretKey ByteString
k) = (ByteString -> Ciphertext GOST_28147_89)
-> Maybe ByteString -> Maybe (Ciphertext GOST_28147_89)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Ciphertext GOST_28147_89
GOST_28147_89Ciphertext (Maybe ByteString -> Maybe (Ciphertext GOST_28147_89))
-> (ByteString -> Maybe ByteString)
-> ByteString
-> Maybe (Ciphertext GOST_28147_89)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockCipher -> ByteString -> ByteString -> Maybe ByteString
Botan.blockCipherEncrypt BlockCipher
Botan.gost_28147_89 ByteString
k

    blockCipherDecrypt :: SecretKey GOST_28147_89 -> Ciphertext GOST_28147_89 -> Maybe ByteString
    blockCipherDecrypt :: SecretKey GOST_28147_89
-> Ciphertext GOST_28147_89 -> Maybe ByteString
blockCipherDecrypt (GOST_28147_89SecretKey ByteString
k) (GOST_28147_89Ciphertext ByteString
ct) = BlockCipher -> ByteString -> ByteString -> Maybe ByteString
Botan.blockCipherDecrypt BlockCipher
Botan.gost_28147_89 ByteString
k ByteString
ct

instance HasLazyCiphertext GOST_28147_89 where

instance IncrementalBlockCipher GOST_28147_89 where

    blockCipherEncryptLazy :: SecretKey GOST_28147_89 -> Lazy.ByteString -> Maybe (LazyCiphertext GOST_28147_89)
    blockCipherEncryptLazy :: SecretKey GOST_28147_89
-> ByteString -> Maybe (LazyCiphertext GOST_28147_89)
blockCipherEncryptLazy (GOST_28147_89SecretKey ByteString
k) = (ByteString -> LazyCiphertext GOST_28147_89)
-> Maybe ByteString -> Maybe (LazyCiphertext GOST_28147_89)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> LazyCiphertext GOST_28147_89
GOST_28147_89LazyCiphertext (Maybe ByteString -> Maybe (LazyCiphertext GOST_28147_89))
-> (ByteString -> Maybe ByteString)
-> ByteString
-> Maybe (LazyCiphertext GOST_28147_89)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockCipher -> ByteString -> ByteString -> Maybe ByteString
Botan.blockCipherEncryptLazy BlockCipher
Botan.gost_28147_89 ByteString
k

    blockCipherDecryptLazy :: SecretKey GOST_28147_89 -> LazyCiphertext GOST_28147_89 -> Maybe Lazy.ByteString
    blockCipherDecryptLazy :: SecretKey GOST_28147_89
-> LazyCiphertext GOST_28147_89 -> Maybe ByteString
blockCipherDecryptLazy (GOST_28147_89SecretKey ByteString
k) (GOST_28147_89LazyCiphertext ByteString
ct) = BlockCipher -> ByteString -> ByteString -> Maybe ByteString
Botan.blockCipherDecryptLazy BlockCipher
Botan.gost_28147_89 ByteString
k ByteString
ct

-- GOST_28147_89 blockCipher

gost_28147_89Encrypt :: SecretKey GOST_28147_89 -> ByteString -> Maybe GOST_28147_89Ciphertext
gost_28147_89Encrypt :: SecretKey GOST_28147_89
-> ByteString -> Maybe (Ciphertext GOST_28147_89)
gost_28147_89Encrypt = SecretKey GOST_28147_89
-> ByteString -> Maybe (Ciphertext GOST_28147_89)
forall bc.
BlockCipher bc =>
SecretKey bc -> ByteString -> Maybe (Ciphertext bc)
blockCipherEncrypt

gost_28147_89Decrypt :: SecretKey GOST_28147_89 -> GOST_28147_89Ciphertext -> Maybe ByteString
gost_28147_89Decrypt :: SecretKey GOST_28147_89
-> Ciphertext GOST_28147_89 -> Maybe ByteString
gost_28147_89Decrypt = SecretKey GOST_28147_89
-> Ciphertext GOST_28147_89 -> Maybe ByteString
forall bc.
BlockCipher bc =>
SecretKey bc -> Ciphertext bc -> Maybe ByteString
blockCipherDecrypt

gost_28147_89EncryptLazy :: SecretKey GOST_28147_89 -> Lazy.ByteString -> Maybe GOST_28147_89LazyCiphertext
gost_28147_89EncryptLazy :: SecretKey GOST_28147_89
-> ByteString -> Maybe (LazyCiphertext GOST_28147_89)
gost_28147_89EncryptLazy = SecretKey GOST_28147_89
-> ByteString -> Maybe (LazyCiphertext GOST_28147_89)
forall bc.
IncrementalBlockCipher bc =>
SecretKey bc -> ByteString -> Maybe (LazyCiphertext bc)
blockCipherEncryptLazy

gost_28147_89DecryptLazy :: SecretKey GOST_28147_89 -> GOST_28147_89LazyCiphertext -> Maybe Lazy.ByteString
gost_28147_89DecryptLazy :: SecretKey GOST_28147_89
-> LazyCiphertext GOST_28147_89 -> Maybe ByteString
gost_28147_89DecryptLazy = SecretKey GOST_28147_89
-> LazyCiphertext GOST_28147_89 -> Maybe ByteString
forall bc.
IncrementalBlockCipher bc =>
SecretKey bc -> LazyCiphertext bc -> Maybe ByteString
blockCipherDecryptLazy