port to cryptonite

oauthenticated.cabal

@@ -1,5 +1,5 @@
 name:                oauthenticated
-version:             0.1.3.4
+version:             0.2.0
 synopsis:            Simple OAuth for http-client
 
 description:         
@@ -57,16 +57,15 @@ library
     Network.OAuth.Util
   build-depends:       base                >= 4.6      && < 4.9
                      , aeson               >= 0.6.2    && < 0.10
-                     , base64-bytestring   >= 1.0      && < 1.1
                      , blaze-builder       >= 0.3
                      , bytestring          >= 0.9
                      , case-insensitive    >= 1.0      && < 1.3
-                     , crypto-random       >= 0.0.7
-                     , cryptohash          >= 0.11     && < 0.12
+                     , cryptonite          == 0.2.*
                      , either              >= 4.0      && < 5.0
                      , exceptions          >= 0.4
                      , http-client         >= 0.2.0
                      , http-types          >= 0.8
+                     , memory              >= 0.7
                      , mtl                 >= 2.0
                      , time                >= 1.2
                      , text                >= 0.11     && < 1.3

src/Network/OAuth.hs

@@ -62,11 +62,11 @@ import qualified Network.OAuth.Types.Credentials as O
 import qualified Network.OAuth.Types.Params      as O
 
 -- | Sign a request with a fresh set of parameters. Creates a fresh
--- 'R.SystemRNG' using new entropy for each signing and thus is potentially
+-- 'R.ChaChaDRG' using new entropy for each signing and thus is potentially
 -- /dangerous/ if used too frequently. In almost all cases, 'S.oauth'
 -- should be used instead.
 oauthSimple :: O.Cred ty -> O.Server -> C.Request -> IO C.Request
 oauthSimple cr srv req = do
-  entropy   <- R.createEntropyPool
-  (req', _) <- S.oauth cr srv req (R.cprgCreate entropy :: R.SystemRNG)
+  entropy   <- R.drgNew
+  (req', _) <- S.oauth cr srv req entropy
   return req'

src/Network/OAuth/Signing.hs

@@ -35,13 +35,13 @@ module Network.OAuth.Signing (
 
   ) where
 
-import qualified Blaze.ByteString.Builder        as Blz
 import           Control.Applicative
-import           Crypto.Hash.SHA1                (hash)
-import           Crypto.MAC.HMAC                 (hmac)
+import qualified Blaze.ByteString.Builder        as Blz
+import           Crypto.Hash                     (SHA1)
+import           Crypto.MAC.HMAC                 (HMAC, hmac)
 import           Crypto.Random
+import           Data.ByteArray.Encoding         (Base(Base64), convertToBase)
 import qualified Data.ByteString                 as S
-import qualified Data.ByteString.Base64          as S64
 import qualified Data.ByteString.Char8           as S8
 import qualified Data.ByteString.Lazy            as SL
 import           Data.Char                       (toUpper)
@@ -58,7 +58,7 @@ import           Network.OAuth.Util
 import           Network.URI
 
 -- | Sign a request with a fresh set of parameters.
-oauth :: CPRG gen => Cred ty -> Server -> C.Request -> gen -> IO (C.Request, gen)
+oauth :: DRG gen => Cred ty -> Server -> C.Request -> gen -> IO (C.Request, gen)
 oauth creds sv req gen = do
   (oax, gen') <- freshOa creds gen
   return (sign oax sv req, gen')
@@ -73,7 +73,8 @@ sign oax server req =
   in augmentRequest (parameterMethod server) params req
 
 makeSignature :: SignatureMethod -> S.ByteString -> S.ByteString -> S.ByteString
-makeSignature HmacSha1  sigKey payload = S64.encode (hmac hash 64 sigKey payload)
+makeSignature HmacSha1  sigKey payload = convertToBase Base64 hmac'
+  where hmac' = hmac sigKey payload :: HMAC SHA1
 makeSignature Plaintext sigKey _       = sigKey
 
 -- | Augments whatever component of the 'C.Request' is specified by

src/Network/OAuth/Simple.hs

@@ -81,10 +81,10 @@ data OaConfig ty =
 -- | Perform authenticated requests using a shared 'C.Manager' and
 -- a particular set of 'O.Cred's.
 newtype OAuthT ty m a =
-  OAuthT { unOAuthT :: ReaderT (OaConfig ty) (StateT R.SystemRNG m) a }
+  OAuthT { unOAuthT :: ReaderT (OaConfig ty) (StateT R.ChaChaDRG m) a }
   deriving ( Functor, Applicative, Monad
            , MonadReader (OaConfig ty)
-           , MonadState R.SystemRNG
+           , MonadState R.ChaChaDRG
            , E.MonadCatch
            , E.MonadThrow
            , MonadIO
@@ -100,8 +100,8 @@ runOAuthT
      OAuthT ty m a -> O.Cred ty -> O.Server -> O.ThreeLegged ->
      m a
 runOAuthT oat cr srv tl = do
-  entropy <- liftIO R.createEntropyPool
-  evalStateT (runReaderT (unOAuthT oat) (OaConfig cr srv tl)) (R.cprgCreate entropy)
+  gen <- liftIO R.drgNew
+  evalStateT (runReaderT (unOAuthT oat) (OaConfig cr srv tl)) gen
 
 runOAuth :: OAuth ty a -> O.Cred ty -> O.Server -> O.ThreeLegged -> IO a
 runOAuth = runOAuthT
@@ -121,14 +121,14 @@ upgradeCred tok = liftM (Cred.upgradeCred tok . cred) ask
 
 -- | Given a 'Cred.ResourceToken' of some kind, run an inner 'OAuthT' session
 -- with the same configuration but new credentials.
-upgrade :: (Cred.ResourceToken ty', Monad m) => O.Token ty' -> OAuthT ty' m a -> OAuthT ty m a
+upgrade :: (Cred.ResourceToken ty', Monad m, MonadIO m) => O.Token ty' -> OAuthT ty' m a -> OAuthT ty m a
 upgrade tok oat = do
-  gen  <- state R.cprgFork
+  gen  <- liftIO R.drgNew
   conf <- ask
   let conf' = conf { cred = Cred.upgradeCred tok (cred conf) }
   lift $ evalStateT (runReaderT (unOAuthT oat) conf') gen
 
-liftBasic :: MonadIO m => (R.SystemRNG -> OaConfig ty -> IO (a, R.SystemRNG)) -> OAuthT ty m a
+liftBasic :: MonadIO m => (R.ChaChaDRG -> OaConfig ty -> IO (a, R.ChaChaDRG)) -> OAuthT ty m a
 liftBasic f = do
   gen  <- get
   conf <- ask
@@ -208,7 +208,7 @@ requestTokenProtocol man getVerifier = runEitherT $ do
     upE      :: (Monad m, Functor m) => (e -> f) -> Either e b -> EitherT f m b
     upE f = liftE f . return
     -- This is just 'upgrade' played out in the EitherT monad.
-    upgradeE :: (Monad m, Cred.ResourceToken ty') =>
+    upgradeE :: (Monad m, MonadIO m, Cred.ResourceToken ty') =>
                 Cred.Token ty'
                 -> EitherT e (OAuthT ty' m) a -> EitherT e (OAuthT ty m) a
     upgradeE tok = EitherT . upgrade tok . runEitherT

src/Network/OAuth/ThreeLegged.hs

@@ -89,9 +89,9 @@ parseThreeLegged a b c d =
 --
 -- Throws 'C.HttpException's.
 requestTemporaryTokenRaw
-  :: R.CPRG gen => O.Cred O.Client -> O.Server
-                -> ThreeLegged -> C.Manager -> gen
-                -> IO (C.Response SL.ByteString, gen)
+  :: R.DRG gen => O.Cred O.Client -> O.Server
+               -> ThreeLegged -> C.Manager -> gen
+               -> IO (C.Response SL.ByteString, gen)
 requestTemporaryTokenRaw cr srv (ThreeLegged {..}) man gen = do
   (oax, gen') <- O.freshOa cr gen
   let req = O.sign (oax { P.workflow = P.TemporaryTokenRequest callback }) srv temporaryTokenRequest
@@ -105,9 +105,9 @@ requestTemporaryTokenRaw cr srv (ThreeLegged {..}) man gen = do
 --
 -- Throws 'C.HttpException's.
 requestTemporaryToken
-  :: R.CPRG gen => O.Cred O.Client -> O.Server
-                -> ThreeLegged -> C.Manager -> gen
-                -> IO (C.Response (Either SL.ByteString (O.Token O.Temporary)), gen)
+  :: R.DRG gen => O.Cred O.Client -> O.Server
+               -> ThreeLegged -> C.Manager -> gen
+               -> IO (C.Response (Either SL.ByteString (O.Token O.Temporary)), gen)
 requestTemporaryToken cr srv tl man gen = do
   (raw, gen') <- requestTemporaryTokenRaw cr srv tl man gen
   return (tryParseToken <$> raw, gen')
@@ -135,10 +135,10 @@ buildAuthorizationUrl cr (ThreeLegged {..}) =
 --
 -- Throws 'C.HttpException's.
 requestPermanentTokenRaw
-  :: R.CPRG gen => O.Cred O.Temporary -> O.Server
-                -> P.Verifier
-                -> ThreeLegged -> C.Manager -> gen
-                -> IO (C.Response SL.ByteString, gen)
+  :: R.DRG gen => O.Cred O.Temporary -> O.Server
+               -> P.Verifier
+               -> ThreeLegged -> C.Manager -> gen
+               -> IO (C.Response SL.ByteString, gen)
 requestPermanentTokenRaw cr srv verifier (ThreeLegged {..}) man gen = do
   (oax, gen') <- O.freshOa cr gen
   let req = O.sign (oax { P.workflow = P.PermanentTokenRequest verifier }) srv permanentTokenRequest
@@ -149,11 +149,11 @@ requestPermanentTokenRaw cr srv verifier (ThreeLegged {..}) man gen = do
 -- See also 'requestPermanentTokenRaw'.
 --
 -- Throws 'C.HttpException's.
-requestPermanentToken 
-  :: R.CPRG gen => O.Cred O.Temporary -> O.Server
-                -> P.Verifier
-                -> ThreeLegged -> C.Manager -> gen
-                -> IO (C.Response (Either SL.ByteString (O.Token O.Permanent)), gen)
+requestPermanentToken
+  :: R.DRG gen => O.Cred O.Temporary -> O.Server
+               -> P.Verifier
+               -> ThreeLegged -> C.Manager -> gen
+               -> IO (C.Response (Either SL.ByteString (O.Token O.Permanent)), gen)
 requestPermanentToken cr srv verifier tl man gen = do
   (raw, gen') <- requestPermanentTokenRaw cr srv verifier tl man gen
   return (tryParseToken <$> raw, gen')
@@ -165,15 +165,14 @@ requestPermanentToken cr srv verifier tl man gen = do
 
 -- | Like 'requestTokenProtocol' but allows for specification of the
 -- 'C.ManagerSettings'.
-requestTokenProtocol' 
-  :: C.ManagerSettings -> O.Cred O.Client -> O.Server -> ThreeLegged 
-     -> (URI -> IO P.Verifier) 
+requestTokenProtocol'
+  :: C.ManagerSettings -> O.Cred O.Client -> O.Server -> ThreeLegged
+     -> (URI -> IO P.Verifier)
      -> IO (Maybe (O.Cred O.Permanent))
 requestTokenProtocol' mset cr srv tl getVerifier = do
-  entropy <- R.createEntropyPool
+  gen <- R.drgNew
   E.bracket (C.newManager mset) C.closeManager $ \man -> do
-    let gen = (R.cprgCreate entropy :: R.SystemRNG)
-    (respTempToken, gen') <- requestTemporaryToken cr srv tl man gen 
+    (respTempToken, gen') <- requestTemporaryToken cr srv tl man gen
     case C.responseBody respTempToken of
       Left _ -> return Nothing
       Right tok -> do

src/Network/OAuth/Types/Params.hs

@@ -21,8 +21,8 @@ module Network.OAuth.Types.Params where
 
 import           Control.Applicative
 import           Crypto.Random
+import           Data.ByteArray.Encoding         (Base(Base64), convertToBase)
 import qualified Data.ByteString                 as S
-import qualified Data.ByteString.Base64          as S64
 import qualified Data.ByteString.Char8           as S8
 import           Data.Data
 import           Data.Time
@@ -178,20 +178,27 @@ emptyPin = OaPin { timestamp = Timestamp (UTCTime (ModifiedJulianDay 0) 0)
 
 -- | Creates a new, unique, unpredictable 'OaPin'. This should be used quickly
 -- as dependent on the OAuth server settings it may expire.
-freshPin :: CPRG gen => gen -> IO (OaPin, gen)
+freshPin :: DRG gen => gen -> IO (OaPin, gen)
 freshPin gen = do
   t <- Timestamp <$> getCurrentTime
   return (OaPin { timestamp = t, nonce = n }, gen')
   where
-    (n, gen') = withRandomBytes gen 8 S64.encode
+    (n, gen') = withRandomBytes gen 8 (convertToBase Base64)
+
+-- | generate @len random bytes and mapped the bytes to the function @f.
+--
+-- This is equivalent to use Control.Arrow 'first' with 'randomBytesGenerate'
+withRandomBytes :: DRG g => g -> Int -> (S.ByteString -> a) -> (a, g)
+withRandomBytes rng len f = (f bs, rng')
+  where (bs, rng') = randomBytesGenerate len rng
 
 -- | Uses 'emptyPin' to create an empty set of params 'Oa'.
 emptyOa :: Cred ty -> Oa ty
 emptyOa creds =
   Oa { credentials = creds, workflow = Standard, pin = emptyPin }
 
 -- | Uses 'freshPin' to create a fresh, default set of params 'Oa'.
-freshOa :: CPRG gen => Cred ty -> gen -> IO (Oa ty, gen)
+freshOa :: DRG gen => Cred ty -> gen -> IO (Oa ty, gen)
 freshOa creds gen = do
   (pinx, gen') <- freshPin gen
   return (Oa { credentials = creds, workflow = Standard, pin = pinx }, gen')