diff --git a/src/PaymentServer/Issuer.hs b/src/PaymentServer/Issuer.hs index 939910ccbd3e419f7b1a28978984c9268c2b2208..1041d768d4479b03e45cd69af01fe3fac328d7c2 100644 --- a/src/PaymentServer/Issuer.hs +++ b/src/PaymentServer/Issuer.hs @@ -48,7 +48,7 @@ data ChallengeBypass = -- | An issuer accepts a list of blinded tokens and returns signatures of -- those tokens along with proof that it used a particular key to construct -- the signatures. -type Issuer = [BlindedToken] -> (Either Text ChallengeBypass) +type Issuer = [BlindedToken] -> Either Text ChallengeBypass -- | trivialIssue makes up and returns some nonsense values that satisfy the -- structural requirements but not the semantic ones. diff --git a/src/PaymentServer/Main.hs b/src/PaymentServer/Main.hs index 26139640ff3e01cae7e18742a253f5d59f7ad848..8c52604b95aa793cf9f539e9884b19e09c43ad36 100644 --- a/src/PaymentServer/Main.hs +++ b/src/PaymentServer/Main.hs @@ -111,11 +111,11 @@ main = case (issuer, signingKey) of (Trivial, Nothing) -> Right trivialIssue (Ristretto, Just key) -> Right $ ristrettoIssue key - otherwise -> Left "invalid options" + _ -> Left "invalid options" getDatabase ServerConfig{ database, databasePath } = case (database, databasePath) of (Memory, Nothing) -> Right memory - otherwise -> Left "invalid options" + _ -> Left "invalid options" in do config <- execParser opts case getIssuer config of diff --git a/src/PaymentServer/Ristretto.hs b/src/PaymentServer/Ristretto.hs index 49278604ace90dd209440e47edd1d421c07c06ab..a2968331eb42368772901ade53344f447ff7b84b 100644 --- a/src/PaymentServer/Ristretto.hs +++ b/src/PaymentServer/Ristretto.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE EmptyDataDecls #-} @@ -90,7 +89,7 @@ data RistrettoFailure ristretto :: Text -- ^ The base64 encoded signing key. -> [Text] -- ^ A list of the base64 blinded tokens. - -> (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 @@ -109,17 +108,17 @@ ristretto textSigningKey textTokens = extractKeyMaterial :: String -> IO (Either RistrettoFailure (Ptr C_SigningKey, Ptr C_PublicKey)) extractKeyMaterial stringSigningKey = do cStringSigningKey <- newCString stringSigningKey - case cStringSigningKey == nullPtr of - True -> return $ Left SigningKeyAllocation - False -> do + if cStringSigningKey == nullPtr + then return $ Left SigningKeyAllocation + else do signingKey <- signing_key_decode_base64 cStringSigningKey - case signingKey == nullPtr of - True -> return $ Left SigningKeyDecoding - False -> do + if signingKey == nullPtr + then return $ Left SigningKeyDecoding + else do publicKey <- signing_key_get_public_key signingKey - case publicKey == nullPtr of - True -> return $ Left PublicKeyLookup - False -> return $ Right (signingKey, publicKey) + if publicKey == nullPtr + then return $ Left PublicKeyLookup + else return $ Right (signingKey, publicKey) in unsafePerformIO $ do keys <- extractKeyMaterial stringSigningKey @@ -127,26 +126,26 @@ ristretto textSigningKey textTokens = Left err -> return $ Left err Right (signingKey, publicKey) -> do cStringEncodedPublicKey <- public_key_encode_base64 publicKey - case cStringEncodedPublicKey == nullPtr of - True -> return $ Left PublicKeyEncoding - False -> do + if cStringEncodedPublicKey == nullPtr + then return $ Left PublicKeyEncoding + else do encodedPublicKey <- peekCString cStringEncodedPublicKey cStringTokens <- mapM newCString stringTokens - case any (== nullPtr) cStringTokens of - True -> return $ Left BlindedTokenAllocation - False -> do + if nullPtr `elem` cStringTokens + then return $ Left BlindedTokenAllocation + else do blindedTokens <- mapM blinded_token_decode_base64 cStringTokens - case any (== nullPtr) blindedTokens of - True -> return $ Left BlindedTokenDecoding - False -> do + if nullPtr `elem` blindedTokens + then return $ Left BlindedTokenDecoding + else do signedTokens <- mapM (signing_key_sign signingKey) blindedTokens - case any (== nullPtr) signedTokens of - True -> return $ Left TokenSigning - False -> do + if nullPtr `elem` signedTokens + then return $ Left TokenSigning + else do encodedCStringSignedTokens <- mapM signed_token_encode_base64 signedTokens - case any (== nullPtr) encodedCStringSignedTokens of - True -> return $ Left SignedTokenEncoding - False -> do + if nullPtr `elem` encodedCStringSignedTokens + then return $ Left SignedTokenEncoding + else do encodedSignedTokens <- mapM peekCString encodedCStringSignedTokens encodedProof <- newEncodedProof blindedTokens signedTokens signingKey return . Right $ Issuance (pack encodedPublicKey) (map pack encodedSignedTokens) (pack encodedProof)