{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}

module SAML2.WebSSO.Error where

import Data.String.Conversions
import Data.Void (Void, absurd)
import Servant.Server

data Error err
  = UnknownIdP LT
  | Forbidden LT
  | BadSamlResponseBase64Error LT
  | BadSamlResponseXmlError LT
  | BadSamlResponseSamlError LT
  | BadSamlResponseFormFieldMissing
  | BadSamlResponseIssuerMissing
  | BadSamlResponseNoAssertions
  | BadSamlResponseAssertionWithoutID
  | BadSamlResponseInvalidSignature LT
  | BadServerConfig LT
  | InvalidCert LT
  | UnknownError
  | CustomServant ServerError
  | CustomError err
  deriving (Error err -> Error err -> Bool
(Error err -> Error err -> Bool)
-> (Error err -> Error err -> Bool) -> Eq (Error err)
forall err. Eq err => Error err -> Error err -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall err. Eq err => Error err -> Error err -> Bool
== :: Error err -> Error err -> Bool
$c/= :: forall err. Eq err => Error err -> Error err -> Bool
/= :: Error err -> Error err -> Bool
Eq, Int -> Error err -> ShowS
[Error err] -> ShowS
Error err -> String
(Int -> Error err -> ShowS)
-> (Error err -> String)
-> ([Error err] -> ShowS)
-> Show (Error err)
forall err. Show err => Int -> Error err -> ShowS
forall err. Show err => [Error err] -> ShowS
forall err. Show err => Error err -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall err. Show err => Int -> Error err -> ShowS
showsPrec :: Int -> Error err -> ShowS
$cshow :: forall err. Show err => Error err -> String
show :: Error err -> String
$cshowList :: forall err. Show err => [Error err] -> ShowS
showList :: [Error err] -> ShowS
Show)

type SimpleError = Error Void

toServerError :: SimpleError -> ServerError
toServerError :: SimpleError -> ServerError
toServerError (UnknownIdP LT
msg) = ServerError
err404 {errBody = "Unknown IdP: " <> cs msg}
toServerError (Forbidden LT
msg) = ServerError
err403 {errBody = cs msg}
-- (this should probably be 401, not 403, but according to the standard we would also need to add
-- a WWW-Authenticate header if we do that, and we are not using saml, not basic auth.
-- https://en.wikipedia.org/wiki/List_of_HTTP_status_codes#4xx_Client_errors)
toServerError (BadSamlResponseBase64Error LT
msg) = ServerError
err400 {errBody = "Bad response: base64 error: " <> cs msg}
toServerError (BadSamlResponseXmlError LT
msg) = ServerError
err400 {errBody = "Bad response: xml parse error: " <> cs msg}
toServerError (BadSamlResponseSamlError LT
msg) = ServerError
err400 {errBody = "Bad response: saml parse error: " <> cs msg}
toServerError SimpleError
BadSamlResponseFormFieldMissing = ServerError
err400 {errBody = "Bad response: SAMLResponse form field missing from HTTP body"}
toServerError SimpleError
BadSamlResponseIssuerMissing = ServerError
err400 {errBody = "Bad response: no Issuer in AuthnResponse"}
toServerError SimpleError
BadSamlResponseNoAssertions = ServerError
err400 {errBody = "Bad response: no assertions in AuthnResponse"}
toServerError SimpleError
BadSamlResponseAssertionWithoutID = ServerError
err400 {errBody = "Bad response: assertion without ID"}
toServerError (BadSamlResponseInvalidSignature LT
msg) = ServerError
err400 {errBody = cs msg}
toServerError (InvalidCert LT
msg) = ServerError
err400 {errBody = "Invalid certificate: " <> cs msg}
toServerError (BadServerConfig LT
msg) = ServerError
err400 {errBody = "Invalid server config: " <> cs msg}
toServerError SimpleError
UnknownError = ServerError
err500 {errBody = "Internal server error.  Please consult the logs."}
toServerError (CustomServant ServerError
err) = ServerError
err
toServerError (CustomError Void
avoid) = Void -> ServerError
forall a. Void -> a
absurd Void
avoid