{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies        #-}

module Metro.TP.Crypto
  ( Crypto
  , crypto
  , crypto_
  , CryptoMethod (..)
  , methodEcb
  , methodCbc
  , methodCfb
  , methodCtr

  , makeCrypto
  ) where

import           Control.Monad        (when)
import           Crypto.Cipher.Types  (BlockCipher (..), Cipher (..), IV (..),
                                       KeySizeSpecifier (..), ivAdd, nullIV)
import           Crypto.Error         (CryptoFailable (..))
import           Data.Binary          (Binary (..), decode, encode)
import           Data.Binary.Get      (getByteString, getWord32be)
import           Data.Binary.Put      (putByteString, putWord32be)
import           Data.ByteString      (ByteString, empty)
import qualified Data.ByteString      as B (append, length, replicate, take)
import           Data.ByteString.Lazy (fromStrict, toStrict)
import qualified Data.ByteString.Lazy as LB (cycle, fromStrict, take, toStrict)
import qualified Data.Text            as T (pack)
import           Data.Text.Encoding   (encodeUtf8)
import           Metro.Class          (Transport (..))
import           Metro.Utils          (recvEnough)
import           UnliftIO

newtype BlockLength = BlockLength Int
  deriving (Int -> BlockLength -> ShowS
[BlockLength] -> ShowS
BlockLength -> String
(Int -> BlockLength -> ShowS)
-> (BlockLength -> String)
-> ([BlockLength] -> ShowS)
-> Show BlockLength
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlockLength] -> ShowS
$cshowList :: [BlockLength] -> ShowS
show :: BlockLength -> String
$cshow :: BlockLength -> String
showsPrec :: Int -> BlockLength -> ShowS
$cshowsPrec :: Int -> BlockLength -> ShowS
Show, BlockLength -> BlockLength -> Bool
(BlockLength -> BlockLength -> Bool)
-> (BlockLength -> BlockLength -> Bool) -> Eq BlockLength
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlockLength -> BlockLength -> Bool
$c/= :: BlockLength -> BlockLength -> Bool
== :: BlockLength -> BlockLength -> Bool
$c== :: BlockLength -> BlockLength -> Bool
Eq)

instance Binary BlockLength where
  get :: Get BlockLength
get = Int -> BlockLength
BlockLength (Int -> BlockLength) -> (Word32 -> Int) -> Word32 -> BlockLength
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> BlockLength) -> Get Word32 -> Get BlockLength
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32be
  put :: BlockLength -> Put
put (BlockLength l :: Int
l) = Word32 -> Put
putWord32be (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l

data Block = Block
    { Block -> Int
msgSize :: !Int
    , Block -> ByteString
encData :: !ByteString
    }
    deriving (Int -> Block -> ShowS
[Block] -> ShowS
Block -> String
(Int -> Block -> ShowS)
-> (Block -> String) -> ([Block] -> ShowS) -> Show Block
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Block] -> ShowS
$cshowList :: [Block] -> ShowS
show :: Block -> String
$cshow :: Block -> String
showsPrec :: Int -> Block -> ShowS
$cshowsPrec :: Int -> Block -> ShowS
Show, Block -> Block -> Bool
(Block -> Block -> Bool) -> (Block -> Block -> Bool) -> Eq Block
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Block -> Block -> Bool
$c/= :: Block -> Block -> Bool
== :: Block -> Block -> Bool
$c== :: Block -> Block -> Bool
Eq)

instance Binary Block where
  get :: Get Block
get = do
    Int
pktSize <- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32be
    Int
msgSize <- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32be
    ByteString
encData <- Int -> Get ByteString
getByteString (Int -> Get ByteString) -> Int -> Get ByteString
forall a b. (a -> b) -> a -> b
$ Int
pktSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- 4
    Block -> Get Block
forall (m :: * -> *) a. Monad m => a -> m a
return $WBlock :: Int -> ByteString -> Block
Block {..}
  put :: Block -> Put
put Block {..} = do
    Word32 -> Put
putWord32be (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
encData Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 4
    Word32 -> Put
putWord32be (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
msgSize
    ByteString -> Put
putByteString ByteString
encData

makeBlock :: Int -> ByteString -> Block
makeBlock :: Int -> ByteString -> Block
makeBlock bSize :: Int
bSize msg :: ByteString
msg = Int -> ByteString -> Block
Block Int
size ByteString
msg0
  where size :: Int
size = ByteString -> Int
B.length ByteString
msg
        fixedSize :: Int
fixedSize = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bSize Double -> Double -> Double
forall a. Num a => a -> a -> a
* 1.0) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bSize
        msg0 :: ByteString
msg0 = if Int
size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
fixedSize then ByteString
msg ByteString -> ByteString -> ByteString
`B.append` Int -> Word8 -> ByteString
B.replicate (Int
fixedSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
size) 0
                                   else ByteString
msg

getMsg :: Block -> ByteString
getMsg :: Block -> ByteString
getMsg Block {..} = Int -> ByteString -> ByteString
B.take Int
msgSize ByteString
encData

prepareBlock
  :: BlockCipher cipher
  => (cipher -> IV cipher -> ByteString -> ByteString)
  -> cipher -> IV cipher -> Block -> Block
prepareBlock :: (cipher -> IV cipher -> ByteString -> ByteString)
-> cipher -> IV cipher -> Block -> Block
prepareBlock f :: cipher -> IV cipher -> ByteString -> ByteString
f c :: cipher
c iv :: IV cipher
iv b :: Block
b = Block
b { encData :: ByteString
encData = cipher -> IV cipher -> ByteString -> ByteString
f cipher
c IV cipher
iv (Block -> ByteString
encData Block
b) }

data CryptoMethod cipher = CryptoMethod
    { CryptoMethod cipher
-> cipher -> IV cipher -> ByteString -> ByteString
encrypt :: cipher -> IV cipher -> ByteString -> ByteString
    , CryptoMethod cipher
-> cipher -> IV cipher -> ByteString -> ByteString
decrypt :: cipher -> IV cipher -> ByteString -> ByteString
    , CryptoMethod cipher -> Bool
needIV  :: Bool
    }

data Crypto cipher tp = Crypto
    { Crypto cipher tp -> TVar ByteString
readBuffer   :: TVar ByteString
    , Crypto cipher tp -> CryptoMethod cipher
cryptoMethod :: CryptoMethod cipher
    , Crypto cipher tp -> TVar (IV cipher)
readIV       :: TVar (IV cipher)
    , Crypto cipher tp -> TVar (IV cipher)
writeIV      :: TVar (IV cipher)
    , Crypto cipher tp -> cipher
cipher       :: cipher
    , Crypto cipher tp -> tp
tp           :: tp
    }

instance (Transport tp, BlockCipher cipher) => Transport (Crypto cipher tp) where
  data TransportConfig (Crypto cipher tp) =
    CryptoConfig (CryptoMethod cipher) cipher (IV cipher) (TransportConfig tp)
  newTransport :: TransportConfig (Crypto cipher tp) -> IO (Crypto cipher tp)
newTransport (CryptoConfig cryptoMethod cipher iv config) = do
    TVar ByteString
readBuffer <- ByteString -> IO (TVar ByteString)
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO ByteString
empty
    tp
tp <- TransportConfig tp -> IO tp
forall transport.
Transport transport =>
TransportConfig transport -> IO transport
newTransport TransportConfig tp
config
    TVar (IV cipher)
readIV  <- IV cipher -> IO (TVar (IV cipher))
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO IV cipher
iv
    TVar (IV cipher)
writeIV <- IV cipher -> IO (TVar (IV cipher))
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO IV cipher
iv
    Crypto cipher tp -> IO (Crypto cipher tp)
forall (m :: * -> *) a. Monad m => a -> m a
return Crypto :: forall cipher tp.
TVar ByteString
-> CryptoMethod cipher
-> TVar (IV cipher)
-> TVar (IV cipher)
-> cipher
-> tp
-> Crypto cipher tp
Crypto {..}
  recvData :: Crypto cipher tp -> Int -> IO ByteString
recvData (Crypto buf :: TVar ByteString
buf method :: CryptoMethod cipher
method ivr :: TVar (IV cipher)
ivr _ cipher :: cipher
cipher tp :: tp
tp) _ = do
    ByteString
hbs <- TVar ByteString -> tp -> Int -> IO ByteString
forall (m :: * -> *) tp.
(MonadIO m, Transport tp) =>
TVar ByteString -> tp -> Int -> m ByteString
recvEnough TVar ByteString
buf tp
tp 4
    IV cipher
iv <- TVar (IV cipher) -> IO (IV cipher)
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar (IV cipher)
ivr
    case ByteString -> BlockLength
forall a. Binary a => ByteString -> a
decode (ByteString -> ByteString
fromStrict ByteString
hbs) of
      BlockLength len :: Int
len -> do
        ByteString
bs <- Block -> ByteString
getMsg
          (Block -> ByteString)
-> (ByteString -> Block) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (cipher -> IV cipher -> ByteString -> ByteString)
-> cipher -> IV cipher -> Block -> Block
forall cipher.
BlockCipher cipher =>
(cipher -> IV cipher -> ByteString -> ByteString)
-> cipher -> IV cipher -> Block -> Block
prepareBlock (CryptoMethod cipher
-> cipher -> IV cipher -> ByteString -> ByteString
forall cipher.
CryptoMethod cipher
-> cipher -> IV cipher -> ByteString -> ByteString
decrypt CryptoMethod cipher
method) cipher
cipher IV cipher
iv
          (Block -> Block) -> (ByteString -> Block) -> ByteString -> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Block
forall a. Binary a => ByteString -> a
decode
          (ByteString -> Block)
-> (ByteString -> ByteString) -> ByteString -> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
fromStrict
          (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString
hbs ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>) (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar ByteString -> tp -> Int -> IO ByteString
forall (m :: * -> *) tp.
(MonadIO m, Transport tp) =>
TVar ByteString -> tp -> Int -> m ByteString
recvEnough TVar ByteString
buf tp
tp Int
len

        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CryptoMethod cipher -> Bool
forall cipher. CryptoMethod cipher -> Bool
needIV CryptoMethod cipher
method) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
          STM () -> IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar (IV cipher) -> IV cipher -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (IV cipher)
ivr (IV cipher -> Int -> IV cipher
forall c. IV c -> Int -> IV c
ivAdd IV cipher
iv (ByteString -> Int
B.length ByteString
bs))

        ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs
  sendData :: Crypto cipher tp -> ByteString -> IO ()
sendData (Crypto _ method :: CryptoMethod cipher
method _ ivw :: TVar (IV cipher)
ivw cipher :: cipher
cipher tp :: tp
tp) bs :: ByteString
bs = do
    IV cipher
iv <- TVar (IV cipher) -> IO (IV cipher)
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar (IV cipher)
ivw

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CryptoMethod cipher -> Bool
forall cipher. CryptoMethod cipher -> Bool
needIV CryptoMethod cipher
method) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      STM () -> IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar (IV cipher) -> IV cipher -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (IV cipher)
ivw (IV cipher -> Int -> IV cipher
forall c. IV c -> Int -> IV c
ivAdd IV cipher
iv (ByteString -> Int
B.length ByteString
bs))

    tp -> ByteString -> IO ()
forall transport.
Transport transport =>
transport -> ByteString -> IO ()
sendData tp
tp
      (ByteString -> IO ()) -> (Block -> ByteString) -> Block -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict
      (ByteString -> ByteString)
-> (Block -> ByteString) -> Block -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> ByteString
forall a. Binary a => a -> ByteString
encode
      (Block -> ByteString) -> (Block -> Block) -> Block -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (cipher -> IV cipher -> ByteString -> ByteString)
-> cipher -> IV cipher -> Block -> Block
forall cipher.
BlockCipher cipher =>
(cipher -> IV cipher -> ByteString -> ByteString)
-> cipher -> IV cipher -> Block -> Block
prepareBlock (CryptoMethod cipher
-> cipher -> IV cipher -> ByteString -> ByteString
forall cipher.
CryptoMethod cipher
-> cipher -> IV cipher -> ByteString -> ByteString
encrypt CryptoMethod cipher
method) cipher
cipher IV cipher
iv
      (Block -> IO ()) -> Block -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> Block
makeBlock (cipher -> Int
forall cipher. BlockCipher cipher => cipher -> Int
blockSize cipher
cipher) ByteString
bs
  closeTransport :: Crypto cipher tp -> IO ()
closeTransport (Crypto _ _ _ _ _ tp :: tp
tp) = tp -> IO ()
forall transport. Transport transport => transport -> IO ()
closeTransport tp
tp

crypto
  :: BlockCipher cipher
  => CryptoMethod cipher
  -> cipher
  -> TransportConfig tp
  -> TransportConfig (Crypto cipher tp)
crypto :: CryptoMethod cipher
-> cipher
-> TransportConfig tp
-> TransportConfig (Crypto cipher tp)
crypto method :: CryptoMethod cipher
method cipher :: cipher
cipher = CryptoMethod cipher
-> cipher
-> IV cipher
-> TransportConfig tp
-> TransportConfig (Crypto cipher tp)
forall cipher tp.
BlockCipher cipher =>
CryptoMethod cipher
-> cipher
-> IV cipher
-> TransportConfig tp
-> TransportConfig (Crypto cipher tp)
crypto_ CryptoMethod cipher
method cipher
cipher IV cipher
forall c. BlockCipher c => IV c
nullIV

crypto_
  :: BlockCipher cipher
  => CryptoMethod cipher
  -> cipher
  -> IV cipher
  -> TransportConfig tp
  -> TransportConfig (Crypto cipher tp)
crypto_ :: CryptoMethod cipher
-> cipher
-> IV cipher
-> TransportConfig tp
-> TransportConfig (Crypto cipher tp)
crypto_ = CryptoMethod cipher
-> cipher
-> IV cipher
-> TransportConfig tp
-> TransportConfig (Crypto cipher tp)
forall cipher tp.
CryptoMethod cipher
-> cipher
-> IV cipher
-> TransportConfig tp
-> TransportConfig (Crypto cipher tp)
CryptoConfig

methodEcb :: BlockCipher cipher => CryptoMethod cipher
methodEcb :: CryptoMethod cipher
methodEcb = (cipher -> IV cipher -> ByteString -> ByteString)
-> (cipher -> IV cipher -> ByteString -> ByteString)
-> Bool
-> CryptoMethod cipher
forall cipher.
(cipher -> IV cipher -> ByteString -> ByteString)
-> (cipher -> IV cipher -> ByteString -> ByteString)
-> Bool
-> CryptoMethod cipher
CryptoMethod ((cipher -> ByteString -> ByteString)
-> cipher -> IV cipher -> ByteString -> ByteString
forall t t p. (t -> t) -> t -> p -> t
ignoreIV cipher -> ByteString -> ByteString
forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> ba -> ba
ecbEncrypt) ((cipher -> ByteString -> ByteString)
-> cipher -> IV cipher -> ByteString -> ByteString
forall t t p. (t -> t) -> t -> p -> t
ignoreIV cipher -> ByteString -> ByteString
forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> ba -> ba
ecbDecrypt) Bool
False
  where ignoreIV :: (t -> t) -> t -> p -> t
ignoreIV f :: t -> t
f c :: t
c _ = t -> t
f t
c

methodCbc :: BlockCipher cipher => CryptoMethod cipher
methodCbc :: CryptoMethod cipher
methodCbc = (cipher -> IV cipher -> ByteString -> ByteString)
-> (cipher -> IV cipher -> ByteString -> ByteString)
-> Bool
-> CryptoMethod cipher
forall cipher.
(cipher -> IV cipher -> ByteString -> ByteString)
-> (cipher -> IV cipher -> ByteString -> ByteString)
-> Bool
-> CryptoMethod cipher
CryptoMethod cipher -> IV cipher -> ByteString -> ByteString
forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> IV cipher -> ba -> ba
cbcEncrypt cipher -> IV cipher -> ByteString -> ByteString
forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> IV cipher -> ba -> ba
cbcDecrypt Bool
True

methodCfb :: BlockCipher cipher => CryptoMethod cipher
methodCfb :: CryptoMethod cipher
methodCfb = (cipher -> IV cipher -> ByteString -> ByteString)
-> (cipher -> IV cipher -> ByteString -> ByteString)
-> Bool
-> CryptoMethod cipher
forall cipher.
(cipher -> IV cipher -> ByteString -> ByteString)
-> (cipher -> IV cipher -> ByteString -> ByteString)
-> Bool
-> CryptoMethod cipher
CryptoMethod cipher -> IV cipher -> ByteString -> ByteString
forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> IV cipher -> ba -> ba
cfbEncrypt cipher -> IV cipher -> ByteString -> ByteString
forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> IV cipher -> ba -> ba
cfbDecrypt  Bool
True

methodCtr :: BlockCipher cipher => CryptoMethod cipher
methodCtr :: CryptoMethod cipher
methodCtr = (cipher -> IV cipher -> ByteString -> ByteString)
-> (cipher -> IV cipher -> ByteString -> ByteString)
-> Bool
-> CryptoMethod cipher
forall cipher.
(cipher -> IV cipher -> ByteString -> ByteString)
-> (cipher -> IV cipher -> ByteString -> ByteString)
-> Bool
-> CryptoMethod cipher
CryptoMethod cipher -> IV cipher -> ByteString -> ByteString
forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> IV cipher -> ba -> ba
ctrCombine cipher -> IV cipher -> ByteString -> ByteString
forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> IV cipher -> ba -> ba
ctrCombine Bool
True

getCryptoMethod :: BlockCipher cipher => cipher -> String -> Maybe (CryptoMethod cipher)
getCryptoMethod :: cipher -> String -> Maybe (CryptoMethod cipher)
getCryptoMethod _ "CBC" = CryptoMethod cipher -> Maybe (CryptoMethod cipher)
forall a. a -> Maybe a
Just CryptoMethod cipher
forall cipher. BlockCipher cipher => CryptoMethod cipher
methodCbc
getCryptoMethod _ "cbc" = CryptoMethod cipher -> Maybe (CryptoMethod cipher)
forall a. a -> Maybe a
Just CryptoMethod cipher
forall cipher. BlockCipher cipher => CryptoMethod cipher
methodCbc
getCryptoMethod _ "CFB" = CryptoMethod cipher -> Maybe (CryptoMethod cipher)
forall a. a -> Maybe a
Just CryptoMethod cipher
forall cipher. BlockCipher cipher => CryptoMethod cipher
methodCfb
getCryptoMethod _ "cfb" = CryptoMethod cipher -> Maybe (CryptoMethod cipher)
forall a. a -> Maybe a
Just CryptoMethod cipher
forall cipher. BlockCipher cipher => CryptoMethod cipher
methodCfb
getCryptoMethod _ "ECB" = CryptoMethod cipher -> Maybe (CryptoMethod cipher)
forall a. a -> Maybe a
Just CryptoMethod cipher
forall cipher. BlockCipher cipher => CryptoMethod cipher
methodEcb
getCryptoMethod _ "ecb" = CryptoMethod cipher -> Maybe (CryptoMethod cipher)
forall a. a -> Maybe a
Just CryptoMethod cipher
forall cipher. BlockCipher cipher => CryptoMethod cipher
methodEcb
getCryptoMethod _ "CTR" = CryptoMethod cipher -> Maybe (CryptoMethod cipher)
forall a. a -> Maybe a
Just CryptoMethod cipher
forall cipher. BlockCipher cipher => CryptoMethod cipher
methodCtr
getCryptoMethod _ "ctr" = CryptoMethod cipher -> Maybe (CryptoMethod cipher)
forall a. a -> Maybe a
Just CryptoMethod cipher
forall cipher. BlockCipher cipher => CryptoMethod cipher
methodCtr
getCryptoMethod _ _     = Maybe (CryptoMethod cipher)
forall a. Maybe a
Nothing

makeCrypto
  :: forall cipher tp. (BlockCipher cipher, Cipher cipher)
  => cipher -> String -> String -> TransportConfig tp -> TransportConfig (Crypto cipher tp)
makeCrypto :: cipher
-> String
-> String
-> TransportConfig tp
-> TransportConfig (Crypto cipher tp)
makeCrypto cipher :: cipher
cipher method :: String
method key :: String
key c :: TransportConfig tp
c =
  case cipher -> String -> Maybe (CryptoMethod cipher)
forall cipher.
BlockCipher cipher =>
cipher -> String -> Maybe (CryptoMethod cipher)
getCryptoMethod cipher
cipher String
method of
    Nothing -> String -> TransportConfig (Crypto cipher tp)
forall a. HasCallStack => String -> a
error "crypto method not support"
    Just m :: CryptoMethod cipher
m  ->
      case ByteString -> CryptoFailable cipher
forall cipher key.
(Cipher cipher, ByteArray key) =>
key -> CryptoFailable cipher
cipherInit ByteString
key0 of
        CryptoFailed e :: CryptoError
e         -> String -> TransportConfig (Crypto cipher tp)
forall a. HasCallStack => String -> a
error (String -> TransportConfig (Crypto cipher tp))
-> String -> TransportConfig (Crypto cipher tp)
forall a b. (a -> b) -> a -> b
$ "Cipher init failed " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CryptoError -> String
forall a. Show a => a -> String
show CryptoError
e
        CryptoPassed (cipher
newCipher :: cipher) ->
          CryptoMethod cipher
-> cipher
-> TransportConfig tp
-> TransportConfig (Crypto cipher tp)
forall cipher tp.
BlockCipher cipher =>
CryptoMethod cipher
-> cipher
-> TransportConfig tp
-> TransportConfig (Crypto cipher tp)
crypto CryptoMethod cipher
m cipher
newCipher TransportConfig tp
c

  where size :: Int
size = KeySizeSpecifier -> Int
getKeySize (KeySizeSpecifier -> Int) -> KeySizeSpecifier -> Int
forall a b. (a -> b) -> a -> b
$ cipher -> KeySizeSpecifier
forall cipher. Cipher cipher => cipher -> KeySizeSpecifier
cipherKeySize cipher
cipher
        key0 :: ByteString
key0 =
          ByteString -> ByteString
LB.toStrict
          (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> ByteString -> ByteString
LB.take (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size)
          (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LB.cycle
          (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LB.fromStrict
          (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8
          (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
key


getKeySize :: KeySizeSpecifier -> Int
getKeySize :: KeySizeSpecifier -> Int
getKeySize (KeySizeRange _ x :: Int
x) = Int
x
getKeySize (KeySizeEnum xs :: [Int]
xs)   = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
xs
getKeySize (KeySizeFixed x :: Int
x)   = Int
x