{-# OPTIONS_GHC -fno-warn-orphans #-}

-- FUTUREWORK: disallow orphans.

module SAML2.WebSSO.Orphans where

import Control.Monad ((<=<))
import Data.Aeson
import Data.String.Conversions
import qualified Data.Text as Text
import Data.X509 as X509
import SAML2.Util (normURI, parseURI', renderURI)
import Servant hiding (URI)
import Text.XML.DSig
import URI.ByteString

instance FromJSON URI where
  parseJSON :: Value -> Parser URI
parseJSON = (Parser ST -> (ST -> Parser URI) -> Parser URI
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Parser URI)
-> (URI -> Parser URI) -> Either String URI -> Parser URI
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser URI
forall {m :: * -> *} {a} {a}. (MonadFail m, Show a) => a -> m a
unerror (URI -> Parser URI
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (URI -> Parser URI) -> (URI -> URI) -> URI -> Parser URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> URI
normURI) (Either String URI -> Parser URI)
-> (ST -> Either String URI) -> ST -> Parser URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ST -> Either String URI
forall (m :: * -> *). MonadError String m => ST -> m URI
parseURI') (Parser ST -> Parser URI)
-> (Value -> Parser ST) -> Value -> Parser URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser ST
forall a. FromJSON a => Value -> Parser a
parseJSON
    where
      unerror :: a -> m a
unerror = String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> (a -> String) -> a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"could not parse config: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<>) (String -> String) -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

instance ToJSON URI where
  toJSON :: URI -> Value
toJSON = ST -> Value
forall a. ToJSON a => a -> Value
toJSON (ST -> Value) -> (URI -> ST) -> URI -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> ST
renderURI

instance ToHttpApiData URI where
  toUrlPiece :: URI -> ST
toUrlPiece = URI -> ST
renderURI

instance FromHttpApiData URI where
  parseUrlPiece :: ST -> Either ST URI
parseUrlPiece = (String -> Either ST URI)
-> (URI -> Either ST URI) -> Either String URI -> Either ST URI
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ST -> Either ST URI
forall a b. a -> Either a b
Left (ST -> Either ST URI) -> (String -> ST) -> String -> Either ST URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ST
Text.pack) URI -> Either ST URI
forall a. a -> Either ST a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String URI -> Either ST URI)
-> (ST -> Either String URI) -> ST -> Either ST URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ST -> Either String URI
forall (m :: * -> *). MonadError String m => ST -> m URI
parseURI' (ST -> Either ST URI)
-> (ST -> Either ST ST) -> ST -> Either ST URI
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ST -> Either ST ST
forall a. FromHttpApiData a => ST -> Either ST a
parseUrlPiece

instance FromJSON X509.SignedCertificate where
  parseJSON :: Value -> Parser SignedCertificate
parseJSON = String
-> (ST -> Parser SignedCertificate)
-> Value
-> Parser SignedCertificate
forall a. String -> (ST -> Parser a) -> Value -> Parser a
withText String
"KeyInfo element" ((ST -> Parser SignedCertificate)
 -> Value -> Parser SignedCertificate)
-> (ST -> Parser SignedCertificate)
-> Value
-> Parser SignedCertificate
forall a b. (a -> b) -> a -> b
$ (String -> Parser SignedCertificate)
-> (SignedCertificate -> Parser SignedCertificate)
-> Either String SignedCertificate
-> Parser SignedCertificate
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser SignedCertificate
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail SignedCertificate -> Parser SignedCertificate
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String SignedCertificate -> Parser SignedCertificate)
-> (ST -> Either String SignedCertificate)
-> ST
-> Parser SignedCertificate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> LT -> Either String SignedCertificate
forall (m :: * -> *).
(HasCallStack, MonadError String m) =>
Bool -> LT -> m SignedCertificate
parseKeyInfo Bool
False (LT -> Either String SignedCertificate)
-> (ST -> LT) -> ST -> Either String SignedCertificate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ST -> LT
forall a b. ConvertibleStrings a b => a -> b
cs

instance ToJSON X509.SignedCertificate where
  toJSON :: SignedCertificate -> Value
toJSON = ST -> Value
String (ST -> Value)
-> (SignedCertificate -> ST) -> SignedCertificate -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LT -> ST
forall a b. ConvertibleStrings a b => a -> b
cs (LT -> ST) -> (SignedCertificate -> LT) -> SignedCertificate -> ST
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => SignedCertificate -> LT
SignedCertificate -> LT
renderKeyInfo