{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
module Botan.SRP6
(
SRP6ServerSession(..)
, destroySRP6ServerSession
, SRP6Group(..)
, SRP6Hash(..)
, SRP6Salt(..)
, SRP6Verifier(..)
, SRP6ServerKey(..)
, SRP6ClientKey(..)
, SRP6SessionKey(..)
, newSRP6ServerSession
, srp6GroupSize
, generateSRP6ClientVerifier
, generateSRP6ClientSecrets
, generateSRP6ServerKey
, generateSRP6ClientKeys
, generateSRP6SessionKey
) where
import qualified Data.ByteString as ByteString
import qualified Botan.Low.SRP6 as Low
import Botan.Error
import Botan.Hash
import Botan.PubKey
import Botan.Prelude
import Botan.RNG
import Control.Monad.Reader
type SRP6ServerSession = Low.SRP6ServerSession
destroySRP6ServerSession :: (MonadIO m) => Low.SRP6ServerSession -> m ()
destroySRP6ServerSession :: forall (m :: * -> *). MonadIO m => SRP6ServerSession -> m ()
destroySRP6ServerSession = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> (SRP6ServerSession -> IO ()) -> SRP6ServerSession -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SRP6ServerSession -> IO ()
Low.srp6ServerSessionDestroy
type SRP6Group = DLGroup
type SRP6Hash = Hash
type SRP6Salt = ByteString
type SRP6Verifier = ByteString
type SRP6ServerKey = ByteString
type SRP6ClientKey = ByteString
type SRP6SessionKey = ByteString
newSRP6ServerSession :: (MonadIO m) => m SRP6ServerSession
newSRP6ServerSession :: forall (m :: * -> *). MonadIO m => m SRP6ServerSession
newSRP6ServerSession = IO SRP6ServerSession -> m SRP6ServerSession
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO SRP6ServerSession
Low.srp6ServerSessionInit
srp6GroupSize :: DLGroup -> Int
srp6GroupSize :: DLGroup -> Int
srp6GroupSize = IO Int -> Int
forall a. IO a -> a
unsafePerformIO (IO Int -> Int) -> (DLGroup -> IO Int) -> DLGroup -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DLGroupName -> IO Int
Low.srp6GroupSize (DLGroupName -> IO Int)
-> (DLGroup -> DLGroupName) -> DLGroup -> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DLGroup -> DLGroupName
dlGroupName
generateSRP6ClientVerifier
:: SRP6Group
-> SRP6Hash
-> ByteString
-> ByteString
-> SRP6Salt
-> SRP6Verifier
generateSRP6ClientVerifier :: DLGroup
-> SRP6Hash
-> DLGroupName
-> DLGroupName
-> DLGroupName
-> DLGroupName
generateSRP6ClientVerifier DLGroup
group SRP6Hash
hash DLGroupName
ident DLGroupName
pass DLGroupName
salt = IO DLGroupName -> DLGroupName
forall a. IO a -> a
unsafePerformIO (IO DLGroupName -> DLGroupName) -> IO DLGroupName -> DLGroupName
forall a b. (a -> b) -> a -> b
$ do
DLGroupName
-> DLGroupName
-> DLGroupName
-> DLGroupName
-> DLGroupName
-> IO DLGroupName
Low.srp6GenerateVerifier DLGroupName
ident DLGroupName
pass DLGroupName
salt (DLGroup -> DLGroupName
dlGroupName DLGroup
group) (SRP6Hash -> DLGroupName
hashName SRP6Hash
hash)
generateSRP6ClientSecrets
:: (MonadRandomIO m)
=> SRP6Group
-> SRP6Hash
-> ByteString
-> ByteString
-> m (SRP6Salt, SRP6Verifier)
generateSRP6ClientSecrets :: forall (m :: * -> *).
MonadRandomIO m =>
DLGroup
-> SRP6Hash
-> DLGroupName
-> DLGroupName
-> m (DLGroupName, DLGroupName)
generateSRP6ClientSecrets DLGroup
group SRP6Hash
hash DLGroupName
ident DLGroupName
pass = do
DLGroupName
salt <- Int -> m DLGroupName
forall (m :: * -> *). MonadRandomIO m => Int -> m DLGroupName
getRandomBytes Int
12
let verifier :: DLGroupName
verifier = DLGroup
-> SRP6Hash
-> DLGroupName
-> DLGroupName
-> DLGroupName
-> DLGroupName
generateSRP6ClientVerifier DLGroup
group SRP6Hash
hash DLGroupName
ident DLGroupName
pass DLGroupName
salt
(DLGroupName, DLGroupName) -> m (DLGroupName, DLGroupName)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((DLGroupName, DLGroupName) -> m (DLGroupName, DLGroupName))
-> (DLGroupName, DLGroupName) -> m (DLGroupName, DLGroupName)
forall a b. (a -> b) -> a -> b
$ DLGroupName
verifier DLGroupName
-> (DLGroupName, DLGroupName) -> (DLGroupName, DLGroupName)
forall a b. a -> b -> b
`seq` (DLGroupName
salt, DLGroupName
verifier)
generateSRP6ServerKey
:: (MonadRandomIO m)
=> SRP6Group
-> SRP6Hash
-> SRP6ServerSession
-> SRP6Verifier
-> m SRP6ServerKey
generateSRP6ServerKey :: forall (m :: * -> *).
MonadRandomIO m =>
DLGroup
-> SRP6Hash -> SRP6ServerSession -> DLGroupName -> m DLGroupName
generateSRP6ServerKey DLGroup
group SRP6Hash
hash SRP6ServerSession
session DLGroupName
verifier = do
RNG
rng <- m RNG
forall (m :: * -> *). MonadRandomIO m => m RNG
getRNG
IO DLGroupName -> m DLGroupName
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DLGroupName -> m DLGroupName)
-> IO DLGroupName -> m DLGroupName
forall a b. (a -> b) -> a -> b
$ SRP6ServerSession
-> DLGroupName
-> DLGroupName
-> DLGroupName
-> RNG
-> IO DLGroupName
Low.srp6ServerSessionStep1
SRP6ServerSession
session
DLGroupName
verifier
(DLGroup -> DLGroupName
dlGroupName DLGroup
group)
(SRP6Hash -> DLGroupName
hashName SRP6Hash
hash)
RNG
rng
generateSRP6ClientKeys
:: (MonadRandomIO m)
=> SRP6Group
-> SRP6Hash
-> ByteString
-> ByteString
-> SRP6Salt
-> SRP6ServerKey
-> m (SRP6ClientKey, SRP6SessionKey)
generateSRP6ClientKeys :: forall (m :: * -> *).
MonadRandomIO m =>
DLGroup
-> SRP6Hash
-> DLGroupName
-> DLGroupName
-> DLGroupName
-> DLGroupName
-> m (DLGroupName, DLGroupName)
generateSRP6ClientKeys DLGroup
group SRP6Hash
hash DLGroupName
ident DLGroupName
pass DLGroupName
salt DLGroupName
skey = do
RNG
rng <- m RNG
forall (m :: * -> *). MonadRandomIO m => m RNG
getRNG
IO (DLGroupName, DLGroupName) -> m (DLGroupName, DLGroupName)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (DLGroupName, DLGroupName) -> m (DLGroupName, DLGroupName))
-> IO (DLGroupName, DLGroupName) -> m (DLGroupName, DLGroupName)
forall a b. (a -> b) -> a -> b
$ DLGroupName
-> DLGroupName
-> DLGroupName
-> DLGroupName
-> DLGroupName
-> DLGroupName
-> RNG
-> IO (DLGroupName, DLGroupName)
Low.srp6ClientAgree
DLGroupName
ident
DLGroupName
pass
(DLGroup -> DLGroupName
dlGroupName DLGroup
group)
(SRP6Hash -> DLGroupName
hashName SRP6Hash
hash)
DLGroupName
salt
DLGroupName
skey
RNG
rng
generateSRP6SessionKey
:: (MonadIO m)
=> SRP6ServerSession
-> SRP6ClientKey
-> m SRP6SessionKey
generateSRP6SessionKey :: forall (m :: * -> *).
MonadIO m =>
SRP6ServerSession -> DLGroupName -> m DLGroupName
generateSRP6SessionKey SRP6ServerSession
session DLGroupName
ckey = IO DLGroupName -> m DLGroupName
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DLGroupName -> m DLGroupName)
-> IO DLGroupName -> m DLGroupName
forall a b. (a -> b) -> a -> b
$ SRP6ServerSession -> DLGroupName -> IO DLGroupName
Low.srp6ServerSessionStep2 SRP6ServerSession
session DLGroupName
ckey
data SRP6Config'
= SRP6Config'
{ SRP6Config' -> DLGroup
srp6ConfigGroup' :: SRP6Group
, SRP6Config' -> SRP6Hash
srp6ConfigHash' :: SRP6Hash
, SRP6Config' -> DLGroupName
srp6ConfigIdent' :: ByteString
, SRP6Config' -> DLGroupName
srp6ConfigSalt' :: SRP6Salt
}
class (Monad m) => SRP6Session' m where
getSRP6Config' :: m SRP6Config'
getSRP6SessionKey' :: m SRP6SessionKey
getSRP6Group' :: (SRP6Session' m) => m SRP6Group
getSRP6Group' :: forall (m :: * -> *). SRP6Session' m => m DLGroup
getSRP6Group' = SRP6Config' -> DLGroup
srp6ConfigGroup' (SRP6Config' -> DLGroup) -> m SRP6Config' -> m DLGroup
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m SRP6Config'
forall (m :: * -> *). SRP6Session' m => m SRP6Config'
getSRP6Config'
getSRP6Hash' :: (SRP6Session' m) => m SRP6Hash
getSRP6Hash' :: forall (m :: * -> *). SRP6Session' m => m SRP6Hash
getSRP6Hash' = SRP6Config' -> SRP6Hash
srp6ConfigHash' (SRP6Config' -> SRP6Hash) -> m SRP6Config' -> m SRP6Hash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m SRP6Config'
forall (m :: * -> *). SRP6Session' m => m SRP6Config'
getSRP6Config'
getSRP6Ident' :: (SRP6Session' m) => m ByteString
getSRP6Ident' :: forall (m :: * -> *). SRP6Session' m => m DLGroupName
getSRP6Ident' = SRP6Config' -> DLGroupName
srp6ConfigIdent' (SRP6Config' -> DLGroupName) -> m SRP6Config' -> m DLGroupName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m SRP6Config'
forall (m :: * -> *). SRP6Session' m => m SRP6Config'
getSRP6Config'
getSRP6Salt' :: (SRP6Session' m) => m SRP6Salt
getSRP6Salt' :: forall (m :: * -> *). SRP6Session' m => m DLGroupName
getSRP6Salt' = SRP6Config' -> DLGroupName
srp6ConfigSalt' (SRP6Config' -> DLGroupName) -> m SRP6Config' -> m DLGroupName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m SRP6Config'
forall (m :: * -> *). SRP6Session' m => m SRP6Config'
getSRP6Config'
class (SRP6Session' m) => SRP6Server' m where
getSRP6ServerSession' :: m SRP6ServerSession'
data SRP6ServerSession'
= SRP6ServerSession'
{ SRP6ServerSession' -> SRP6Config'
srp6ServerSessionConfig' :: SRP6Config'
, SRP6ServerSession' -> SRP6ServerSession
srp6ServerSessionRef' :: Low.SRP6ServerSession
, SRP6ServerSession' -> IORef DLGroupName
srp6ServerSessionServerKey' :: IORef SRP6ServerKey
, SRP6ServerSession' -> IORef DLGroupName
srp6ServerSessionSessionKey' :: IORef SRP6SessionKey
}
type SRP6ServerT' m = ReaderT SRP6ServerSession' m
runSRP6ServerT' :: (MonadIO m) => SRP6ServerT' m a -> SRP6ServerSession' -> m a
runSRP6ServerT' :: forall (m :: * -> *) a.
MonadIO m =>
SRP6ServerT' m a -> SRP6ServerSession' -> m a
runSRP6ServerT' = ReaderT SRP6ServerSession' m a -> SRP6ServerSession' -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT
instance (MonadIO m) => SRP6Session' (SRP6ServerT' m) where
getSRP6Config' :: SRP6ServerT' m SRP6Config'
getSRP6Config' :: SRP6ServerT' m SRP6Config'
getSRP6Config' = SRP6ServerSession' -> SRP6Config'
srp6ServerSessionConfig' (SRP6ServerSession' -> SRP6Config')
-> ReaderT SRP6ServerSession' m SRP6ServerSession'
-> SRP6ServerT' m SRP6Config'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT SRP6ServerSession' m SRP6ServerSession'
forall (m :: * -> *). SRP6Server' m => m SRP6ServerSession'
getSRP6ServerSession'
getSRP6SessionKey' :: SRP6ServerT' m SRP6SessionKey
getSRP6SessionKey' :: SRP6ServerT' m DLGroupName
getSRP6SessionKey' = do
SRP6ServerSession'
session <- ReaderT SRP6ServerSession' m SRP6ServerSession'
forall (m :: * -> *). SRP6Server' m => m SRP6ServerSession'
getSRP6ServerSession'
IO DLGroupName -> SRP6ServerT' m DLGroupName
forall a. IO a -> ReaderT SRP6ServerSession' m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DLGroupName -> SRP6ServerT' m DLGroupName)
-> IO DLGroupName -> SRP6ServerT' m DLGroupName
forall a b. (a -> b) -> a -> b
$ IORef DLGroupName -> IO DLGroupName
forall a. IORef a -> IO a
readIORef (SRP6ServerSession' -> IORef DLGroupName
srp6ServerSessionSessionKey' SRP6ServerSession'
session)
instance (MonadIO m) => SRP6Server' (SRP6ServerT' m) where
getSRP6ServerSession' :: SRP6ServerT' m SRP6ServerSession'
getSRP6ServerSession' :: SRP6ServerT' m SRP6ServerSession'
getSRP6ServerSession' = SRP6ServerT' m SRP6ServerSession'
forall r (m :: * -> *). MonadReader r m => m r
ask
class (SRP6Session' m) => SRP6Client' m where
getSRP6ClientSession' :: m SRP6ClientSession'
data SRP6ClientSession'
= SRP6ClientSession'
{ SRP6ClientSession' -> SRP6Config'
srp6ClientSessionConfig' :: SRP6Config'
, SRP6ClientSession' -> IORef DLGroupName
srp6ClientSessionClientKey' :: IORef SRP6ClientKey
, SRP6ClientSession' -> IORef DLGroupName
srp6ClientSessionSessionKey' :: IORef SRP6SessionKey
}
type SRP6ClientT' m = ReaderT SRP6ClientSession' m
runSRP6ClientT' :: (MonadIO m) => SRP6ClientT' m a -> SRP6ClientSession' -> m a
runSRP6ClientT' :: forall (m :: * -> *) a.
MonadIO m =>
SRP6ClientT' m a -> SRP6ClientSession' -> m a
runSRP6ClientT' = ReaderT SRP6ClientSession' m a -> SRP6ClientSession' -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT
instance (MonadIO m) => SRP6Session' (SRP6ClientT' m) where
getSRP6Config' :: SRP6ClientT' m SRP6Config'
getSRP6Config' :: SRP6ClientT' m SRP6Config'
getSRP6Config' = SRP6ClientSession' -> SRP6Config'
srp6ClientSessionConfig' (SRP6ClientSession' -> SRP6Config')
-> ReaderT SRP6ClientSession' m SRP6ClientSession'
-> SRP6ClientT' m SRP6Config'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT SRP6ClientSession' m SRP6ClientSession'
forall (m :: * -> *). SRP6Client' m => m SRP6ClientSession'
getSRP6ClientSession'
getSRP6SessionKey' :: SRP6ClientT' m SRP6SessionKey
getSRP6SessionKey' :: SRP6ClientT' m DLGroupName
getSRP6SessionKey' = do
SRP6ClientSession'
session <- ReaderT SRP6ClientSession' m SRP6ClientSession'
forall (m :: * -> *). SRP6Client' m => m SRP6ClientSession'
getSRP6ClientSession'
IO DLGroupName -> SRP6ClientT' m DLGroupName
forall a. IO a -> ReaderT SRP6ClientSession' m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DLGroupName -> SRP6ClientT' m DLGroupName)
-> IO DLGroupName -> SRP6ClientT' m DLGroupName
forall a b. (a -> b) -> a -> b
$ IORef DLGroupName -> IO DLGroupName
forall a. IORef a -> IO a
readIORef (SRP6ClientSession' -> IORef DLGroupName
srp6ClientSessionSessionKey' SRP6ClientSession'
session)
instance (MonadIO m) => SRP6Client' (SRP6ClientT' m) where
getSRP6ClientSession' :: SRP6ClientT' m SRP6ClientSession'
getSRP6ClientSession' :: SRP6ClientT' m SRP6ClientSession'
getSRP6ClientSession' = SRP6ClientT' m SRP6ClientSession'
forall r (m :: * -> *). MonadReader r m => m r
ask
newClient :: (MonadRandomIO m) => ByteString -> m SRP6ClientSession'
newClient :: forall (m :: * -> *).
MonadRandomIO m =>
DLGroupName -> m SRP6ClientSession'
newClient DLGroupName
ident = DLGroupName -> DLGroup -> SRP6Hash -> m SRP6ClientSession'
forall (m :: * -> *).
MonadRandomIO m =>
DLGroupName -> DLGroup -> SRP6Hash -> m SRP6ClientSession'
newClientWith DLGroupName
ident DLGroup
MODP_SRP_4096 SRP6Hash
sha2_512
newClientWith :: (MonadRandomIO m) => ByteString -> SRP6Group -> SRP6Hash -> m SRP6ClientSession'
newClientWith :: forall (m :: * -> *).
MonadRandomIO m =>
DLGroupName -> DLGroup -> SRP6Hash -> m SRP6ClientSession'
newClientWith DLGroupName
ident DLGroup
group SRP6Hash
hash = do
DLGroupName
salt <- Int -> m DLGroupName
forall (m :: * -> *). MonadRandomIO m => Int -> m DLGroupName
getRandomBytes Int
12
DLGroupName
-> (DLGroupName -> m (DLGroup, SRP6Hash, DLGroupName))
-> m SRP6ClientSession'
forall (m :: * -> *).
MonadIO m =>
DLGroupName
-> (DLGroupName -> m (DLGroup, SRP6Hash, DLGroupName))
-> m SRP6ClientSession'
loadClientWith DLGroupName
ident ((DLGroupName -> m (DLGroup, SRP6Hash, DLGroupName))
-> m SRP6ClientSession')
-> (DLGroupName -> m (DLGroup, SRP6Hash, DLGroupName))
-> m SRP6ClientSession'
forall a b. (a -> b) -> a -> b
$ \ DLGroupName
_ -> (DLGroup, SRP6Hash, DLGroupName)
-> m (DLGroup, SRP6Hash, DLGroupName)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (DLGroup
group, SRP6Hash
hash, DLGroupName
salt)
loadClientWith :: (MonadIO m) => ByteString -> (ByteString -> m (SRP6Group, SRP6Hash, SRP6Salt)) -> m SRP6ClientSession'
loadClientWith :: forall (m :: * -> *).
MonadIO m =>
DLGroupName
-> (DLGroupName -> m (DLGroup, SRP6Hash, DLGroupName))
-> m SRP6ClientSession'
loadClientWith DLGroupName
ident DLGroupName -> m (DLGroup, SRP6Hash, DLGroupName)
lookup = do
(DLGroup
group, SRP6Hash
hash, DLGroupName
salt) <- DLGroupName -> m (DLGroup, SRP6Hash, DLGroupName)
lookup DLGroupName
ident
let sessionConfig :: SRP6Config'
sessionConfig = SRP6Config'
{ srp6ConfigGroup' :: DLGroup
srp6ConfigGroup' = DLGroup
group
, srp6ConfigHash' :: SRP6Hash
srp6ConfigHash' = SRP6Hash
hash
, srp6ConfigIdent' :: DLGroupName
srp6ConfigIdent' = DLGroupName
ident
, srp6ConfigSalt' :: DLGroupName
srp6ConfigSalt' = DLGroupName
salt
}
IORef DLGroupName
clientKeyRef <- IO (IORef DLGroupName) -> m (IORef DLGroupName)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef DLGroupName) -> m (IORef DLGroupName))
-> IO (IORef DLGroupName) -> m (IORef DLGroupName)
forall a b. (a -> b) -> a -> b
$ DLGroupName -> IO (IORef DLGroupName)
forall a. a -> IO (IORef a)
newIORef DLGroupName
forall a. HasCallStack => a
undefined
IORef DLGroupName
sessionKeyRef <- IO (IORef DLGroupName) -> m (IORef DLGroupName)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef DLGroupName) -> m (IORef DLGroupName))
-> IO (IORef DLGroupName) -> m (IORef DLGroupName)
forall a b. (a -> b) -> a -> b
$ DLGroupName -> IO (IORef DLGroupName)
forall a. a -> IO (IORef a)
newIORef DLGroupName
forall a. HasCallStack => a
undefined
SRP6ClientSession' -> m SRP6ClientSession'
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SRP6ClientSession' -> m SRP6ClientSession')
-> SRP6ClientSession' -> m SRP6ClientSession'
forall a b. (a -> b) -> a -> b
$ SRP6ClientSession'
{ srp6ClientSessionConfig' :: SRP6Config'
srp6ClientSessionConfig' = SRP6Config'
sessionConfig
, srp6ClientSessionClientKey' :: IORef DLGroupName
srp6ClientSessionClientKey' = IORef DLGroupName
clientKeyRef
, srp6ClientSessionSessionKey' :: IORef DLGroupName
srp6ClientSessionSessionKey' = IORef DLGroupName
sessionKeyRef
}