From 25c8b92c98e390bc384084611d714d0c709ec6d4 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= <honza.hrk@gmail.com>
Date: Tue, 24 Sep 2024 14:04:19 +0200
Subject: [PATCH] Don't use deprecated packages in examples, fix examples for
 more recent stack lts

---
 examples/scotty/Main.hs | 31 +++++++++++++++----------------
 oidc-client.cabal       |  4 ++--
 stack.yaml              |  5 +++++
 3 files changed, 22 insertions(+), 18 deletions(-)

diff --git a/examples/scotty/Main.hs b/examples/scotty/Main.hs
index bca2ee0..c285ee2 100644
--- a/examples/scotty/Main.hs
+++ b/examples/scotty/Main.hs
@@ -8,8 +8,7 @@ module Main where
 import           Control.Monad.IO.Class               (liftIO)
 import           Control.Monad.Reader                 (ReaderT, ask, lift,
                                                        runReaderT)
-import           Crypto.Random.AESCtr                 (AESRNG, makeSystem)
-import           Crypto.Random.API                    (cprgGenBytes)
+import           Crypto.Random                        (SystemDRG, getSystemDRG, randomBytesGenerate)
 import           Data.Aeson                           (FromJSON)
 import           Data.ByteString                      (ByteString)
 import           Data.ByteString.Base64.URL           (encode)
@@ -49,7 +48,7 @@ type SessionStateMap = Map T.Text (O.State, O.Nonce)
 
 data AuthServerEnv = AuthServerEnv
     { oidc :: O.OIDC
-    , cprg :: IORef AESRNG
+    , sdrg :: IORef SystemDRG
     , ssm  :: IORef SessionStateMap
     , mgr  :: Manager
     }
@@ -73,13 +72,13 @@ main = do
     let port = getPort baseUrl
         redirectUri = baseUrl <> "/login/cb"
 
-    cprg <- makeSystem >>= newIORef
+    sdrg <- getSystemDRG >>= newIORef
     ssm  <- newIORef M.empty
     mgr  <- newManager tlsManagerSettings
     prov <- O.discover "https://accounts.google.com" mgr
     let oidc = O.setCredentials clientId clientSecret redirectUri $ O.newOIDC prov
 
-    run port oidc cprg ssm mgr
+    run port oidc sdrg ssm mgr
 
 getPort :: ByteString -> Int
 getPort bs = fromMaybe 3000 port
@@ -90,10 +89,10 @@ getPort bs = fromMaybe 3000 port
         xs  -> let p = (!! 0) . L.reverse $ xs
                     in fst <$> B.readInt p
 
-run :: Int -> O.OIDC -> IORef AESRNG -> IORef SessionStateMap -> Manager -> IO ()
-run port oidc cprg ssm mgr = scottyT port runReader run'
+run :: Int -> O.OIDC -> IORef SystemDRG -> IORef SessionStateMap -> Manager -> IO ()
+run port oidc sdrg ssm mgr = scottyT port runReader run'
   where
-    runReader a = runReaderT a (AuthServerEnv oidc cprg ssm mgr)
+    runReader a = runReaderT a (AuthServerEnv oidc sdrg ssm mgr)
 
 run' :: AuthServer ()
 run' = do
@@ -105,8 +104,8 @@ run' = do
     post "/login" $ do
         AuthServerEnv{..} <- lift ask
 
-        sid <- genSessionId cprg
-        let store = sessionStoreFromSession cprg ssm sid
+        sid <- genSessionId sdrg
+        let store = sessionStoreFromSession sdrg ssm sid
         loc <- liftIO $ O.prepareAuthenticationRequestUrl store oidc [O.email, O.profile] []
         setSimpleCookie cookieName sid
         redirect . TL.pack . show $ loc
@@ -129,7 +128,7 @@ run' = do
         case cookie of
             Just sid -> do
                 AuthServerEnv{..} <- lift ask
-                let store = sessionStoreFromSession cprg ssm sid
+                let store = sessionStoreFromSession sdrg ssm sid
                 state <- param "state"
                 code  <- param "code"
                 tokens <- liftIO $ O.getValidTokens store oidc mgr state code
@@ -150,9 +149,9 @@ run' = do
             H.toHtml (email profile)
           H.p $ H.img ! (A.src $ H.textValue $ picture profile)
 
-    gen cprg                   = encode <$> atomicModifyIORef' cprg (swap . cprgGenBytes 64)
-    genSessionId cprg          = liftIO $ decodeUtf8 <$> gen cprg
-    genBytes cprg              = liftIO $ gen cprg
+    gen sdrg                   = encode <$> atomicModifyIORef' sdrg (swap . randomBytesGenerate 64)
+    genSessionId sdrg          = liftIO $ decodeUtf8 <$> gen sdrg
+    genBytes sdrg              = liftIO $ gen sdrg
     saveState ssm sid st nonce = liftIO $ atomicModifyIORef' ssm $ \m -> (M.insert sid (st, nonce) m, ())
     getStateBy ssm sid _st     = liftIO $ do
         m <- M.lookup sid <$> readIORef ssm
@@ -161,9 +160,9 @@ run' = do
             _               -> Nothing
     deleteState ssm sid  = liftIO $ atomicModifyIORef' ssm $ \m -> (M.delete sid m, ())
 
-    sessionStoreFromSession cprg ssm sid =
+    sessionStoreFromSession sdrg ssm sid =
         O.SessionStore
-            { sessionStoreGenerate = genBytes cprg
+            { sessionStoreGenerate = genBytes sdrg
             , sessionStoreSave     = saveState ssm sid
             , sessionStoreGet      = getStateBy ssm sid
             , sessionStoreDelete   = const $ deleteState ssm sid
diff --git a/oidc-client.cabal b/oidc-client.cabal
index 4719f54..38d51ee 100644
--- a/oidc-client.cabal
+++ b/oidc-client.cabal
@@ -115,11 +115,11 @@ executable scotty-example
     , containers
     , mtl
     , wai-extra
+    -- scotty-cookie not compatible with scotty 0.20+
     , scotty < 0.20
     , scotty-cookie
     , blaze-html
-    , cprng-aes
-    , crypto-random
+    , crypton ^>= 0.34
     , base64-bytestring
     , http-types
     , http-client
diff --git a/stack.yaml b/stack.yaml
index 2406e05..a5c307d 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -6,6 +6,7 @@ packages:
 # Dependency packages to be pulled from upstream that are not in the resolver
 extra-deps:
   - jose-jwt-0.10.0@sha256:6ed175a01c721e317ceea15eb251a81de145c03711a977517935633a5cdec1d4,3546
+  - scotty-0.12.1@sha256:15c06ece267187c4324645e54f2104a63fe3eb8ce6eb5698e4093735daba1f1a,5437
   - scotty-cookie-0.1.0.3@sha256:3ff1df13a5acba8ba170a5ac22b3ac6a2c227791292536ce1ebfc41038f58fc9,1204
   - crypton-0.34@sha256:9e4b50d79d1fba681befa08151db7223d2b4bb72564853e8530e614105d53a1a,14577
 
@@ -15,6 +16,10 @@ flags: {}
 # Extra package databases containing global packages
 extra-package-dbs: []
 
+allow-newer: true
+allow-newer-deps:
+  - scotty
+
 nix:
   packages:
   - ghc