From f8bff00f7eb3e5e0b8c6091da788bb9f4076dc25 Mon Sep 17 00:00:00 2001
From: Jean-Paul Calderone <exarkun@twistedmatrix.com>
Date: Thu, 19 Sep 2019 12:22:52 -0400
Subject: [PATCH] Take `ristretto` out of the IO monad

None of the FFI values escape from `ristretto` so all of the FFI IO should be
safe to do with `unsafePerformIO`.
---
 src/PaymentServer/Issuer.hs    | 2 +-
 src/PaymentServer/Ristretto.hs | 7 +++++--
 2 files changed, 6 insertions(+), 3 deletions(-)

diff --git a/src/PaymentServer/Issuer.hs b/src/PaymentServer/Issuer.hs
index 8ed7eb4..dfc048d 100644
--- a/src/PaymentServer/Issuer.hs
+++ b/src/PaymentServer/Issuer.hs
@@ -65,7 +65,7 @@ ristrettoIssue
   :: SigningKey    -- ^ The key to provide to the PrivacyPass signer.
   -> Issuer        -- ^ An issuer using the given key.
 ristrettoIssue signingKey tokens = do
-  issuance <- ristretto signingKey tokens
+  let issuance = ristretto signingKey tokens
   case issuance of
     Right (publicKey, tokens, proof) -> return . Just $ ChallengeBypass publicKey tokens proof
     Left err -> do
diff --git a/src/PaymentServer/Ristretto.hs b/src/PaymentServer/Ristretto.hs
index 0a9dcfd..65a4a73 100644
--- a/src/PaymentServer/Ristretto.hs
+++ b/src/PaymentServer/Ristretto.hs
@@ -11,6 +11,9 @@ import Control.Exception
   ( bracket
   , assert
   )
+import System.IO.Unsafe
+  ( unsafePerformIO
+  )
 import Data.Text
   ( Text
   , unpack
@@ -85,7 +88,7 @@ data RistrettoFailure
 ristretto
   :: Text                                  -- ^ The base64 encoded signing key.
   -> [Text]                                -- ^ A list of the base64 blinded tokens.
-  -> IO (Either RistrettoFailure Issuance) -- ^ Left for an error, otherwise
+  -> (Either RistrettoFailure Issuance)    -- ^ Left for an error, otherwise
                                            -- Right with the ristretto results
 ristretto textSigningKey textTokens =
   let
@@ -116,7 +119,7 @@ ristretto textSigningKey textTokens =
                 True -> return $ Left PublicKeyLookup
                 False -> return $ Right (signingKey, publicKey)
   in
-    do
+    unsafePerformIO $ do
       keys <- extractKeyMaterial stringSigningKey
       case keys of
         Left err -> return $ Left err
-- 
GitLab