{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module SAML2.WebSSO.Test.Util.Misc where

import Control.Exception (ErrorCall (ErrorCall), throwIO)
import Control.Monad
import Control.Monad.IO.Class
import qualified Data.ByteString.Base64.Lazy as EL (encode)
import Data.EitherR
import Data.Generics.Uniplate.Data
import Data.List (sort)
import Data.String
import Data.String.Conversions
import qualified Data.Text.Lazy.IO as LT
import Data.Typeable
import Data.UUID as UUID
import GHC.Stack
import SAML2.WebSSO
import Servant
import Shelly (run, setStdin, shelly, silently)
import System.Directory (doesFileExist)
import System.Environment
import System.FilePath
import System.IO.Temp
import System.Process (system)
import Test.Hspec
import Text.Show.Pretty
import Text.XML as XML

-- | pipe the output of `curl https://.../initiate-login/...` into this to take a look.
readAuthReq :: String -> IO ()
readAuthReq :: String -> Expectation
readAuthReq String
raw = do
  Either String (FormRedirect Document) -> Expectation
forall a. Show a => a -> Expectation
print (Either String (FormRedirect Document) -> Expectation)
-> Either String (FormRedirect Document) -> Expectation
forall a b. (a -> b) -> a -> b
$ forall {k} (ctype :: k) a.
MimeUnrender ctype a =>
Proxy ctype -> ByteString -> Either String a
forall ctype a.
MimeUnrender ctype a =>
Proxy ctype -> ByteString -> Either String a
mimeUnrender @HTML @(FormRedirect Document) Proxy HTML
forall {k} (t :: k). Proxy t
Proxy (String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs String
raw)

render' :: Document -> LT
render' :: Document -> LT
render' =
  RenderSettings -> Document -> LT
renderText (RenderSettings -> Document -> LT)
-> RenderSettings -> Document -> LT
forall a b. (a -> b) -> a -> b
$
    RenderSettings
forall a. Default a => a
def
      { rsPretty = True
      --  , rsNamespaces :: [(Text, Text)]
      --  , rsAttrOrder :: Name -> Map.Map Name Text -> [(Name, Text)]
      --  , rsUseCDATA :: Content -> Bool
      --  , rsXMLDeclaration :: Bool
      }

rerender' :: LT -> LT
rerender' :: LT -> LT
rerender' = Document -> LT
render' (Document -> LT) -> (LT -> Document) -> LT -> LT
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseSettings -> LT -> Document
parseText_ ParseSettings
forall a. Default a => a
def

showFile :: FilePath -> IO String
showFile :: String -> IO String
showFile String
fp = LT -> String
forall a b. ConvertibleStrings a b => a -> b
cs (LT -> String) -> (String -> LT) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LT -> LT
rerender' (LT -> LT) -> (String -> LT) -> String -> LT
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> LT
forall a b. ConvertibleStrings a b => a -> b
cs (String -> LT) -> (String -> String) -> String -> LT
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'<') (String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
Prelude.readFile String
fp

dumpFile :: FilePath -> IO ()
dumpFile :: String -> Expectation
dumpFile = String -> IO String
showFile (String -> IO String)
-> (String -> Expectation) -> String -> Expectation
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> String -> Expectation
putStrLn

rerenderFile :: FilePath -> IO ()
rerenderFile :: String -> Expectation
rerenderFile String
fp = String -> IO String
showFile String
fp IO String -> (String -> Expectation) -> Expectation
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> String -> Expectation
Prelude.writeFile (String
fp String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"-")

hedgehog :: IO Bool -> Spec
hedgehog :: IO Bool -> Spec
hedgehog = String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"hedgehog tests" (Expectation -> Spec)
-> (IO Bool -> Expectation) -> IO Bool -> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IO Bool -> Bool -> Expectation
forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> Expectation
`shouldReturn` Bool
True)

-- | Helper function for generating new tests cases.  This is probably dead code.
haskellCodeFromXML :: forall a. (Typeable a, Show a, HasXMLRoot a) => Proxy a -> FilePath -> IO ()
haskellCodeFromXML :: forall a.
(Typeable a, Show a, HasXMLRoot a) =>
Proxy a -> String -> Expectation
haskellCodeFromXML Proxy a
Proxy String
ifilepath_ = do
  String
root <- String -> IO String
getEnv String
"SAML2_WEB_SSO_ROOT"
  let ifilepath :: String
ifilepath = String
root String -> String -> String
</> String
"test/xml" String -> String -> String
</> String
ifilepath_
      ofilepath :: String
ofilepath = String
root String -> String -> String
</> String
"test/Samples.hs"
      f :: String -> IO a
      f :: String -> IO a
f = (String -> IO a) -> (a -> IO a) -> Either String a -> IO a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ErrorCall -> IO a
forall e a. Exception e => e -> IO a
throwIO (ErrorCall -> IO a) -> (String -> ErrorCall) -> String -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ErrorCall
ErrorCall) a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String a -> IO a)
-> (String -> Either String a) -> String -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LT -> Either String a
forall (m :: * -> *) a.
(HasXMLRoot a, MonadError String m) =>
LT -> m a
decode (LT -> Either String a)
-> (String -> LT) -> String -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> LT
forall a b. ConvertibleStrings a b => a -> b
cs
      g :: a -> String
      g :: a -> String
g = (String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String]
forall {a}. IsString a => [a]
aft) (String -> String) -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> String
forall a. Monoid a => [a] -> a
mconcat [String]
bef 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
        where
          bef :: [String]
bef = [String
"\n\n", String
fnm, String
" :: ", TypeRep -> String
forall a. Show a => a -> String
show (a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (a
forall a. HasCallStack => a
undefined :: a)), String
"\n", String
fnm, String
" = "]
          aft :: [a]
aft = [a
"\n\n"]
          fnm :: String
fnm = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'.') (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\case Char
'-' -> Char
'_'; Char
c -> Char
c) String
ifilepath_
  a
typ <- String -> IO a
f (String -> IO a) -> IO String -> IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO String
Prelude.readFile String
ifilepath
  (String, String) -> Expectation
forall a. Show a => a -> Expectation
print (String
ifilepath, String
ofilepath)
  String -> Expectation
putStrLn (String -> Expectation) -> (a -> String) -> a -> Expectation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LT -> String
forall a b. ConvertibleStrings a b => a -> b
cs (LT -> String) -> (a -> LT) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> LT
forall a. HasXMLRoot a => a -> LT
encode (a -> Expectation) -> a -> Expectation
forall a b. (a -> b) -> a -> b
$ a
typ
  String -> String -> Expectation
Prelude.appendFile String
ofilepath (String -> Expectation) -> String -> Expectation
forall a b. (a -> b) -> a -> b
$ a -> String
g a
typ

readSampleIO :: MonadIO m => FilePath -> m LT
readSampleIO :: forall (m :: * -> *). MonadIO m => String -> m LT
readSampleIO String
fpath = IO LT -> m LT
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO LT -> m LT) -> IO LT -> m LT
forall a b. (a -> b) -> a -> b
$ do
  String
root <- String -> IO String
getEnv String
"SAML2_WEB_SSO_ROOT"
  String -> IO LT
LT.readFile (String -> IO LT) -> String -> IO LT
forall a b. (a -> b) -> a -> b
$ String
root String -> String -> String
</> String
"test/samples" String -> String -> String
</> String
fpath

doesSampleExistIO :: MonadIO m => FilePath -> m Bool
doesSampleExistIO :: forall (m :: * -> *). MonadIO m => String -> m Bool
doesSampleExistIO String
fpath = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
  String
root <- String -> IO String
getEnv String
"SAML2_WEB_SSO_ROOT"
  String -> IO Bool
doesFileExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
root String -> String -> String
</> String
"test/samples" String -> String -> String
</> String
fpath

roundtrip :: forall a. (Eq a, Show a, HasXMLRoot a) => Int -> IO LT -> a -> Spec
roundtrip :: forall a. (Eq a, Show a, HasXMLRoot a) => Int -> IO LT -> a -> Spec
roundtrip Int
serial IO LT
mkrendered a
parsed = String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (String
"roundtrip-" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
serial) (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
  let tweak :: LT -> Either String Document
tweak = (SomeException -> String)
-> Either SomeException Document -> Either String Document
forall a b r. (a -> b) -> Either a r -> Either b r
fmapL SomeException -> String
forall a. Show a => a -> String
show (Either SomeException Document -> Either String Document)
-> (LT -> Either SomeException Document)
-> LT
-> Either String Document
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseSettings -> LT -> Either SomeException Document
parseText ParseSettings
forall a. Default a => a
def
  String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"encode" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ do
    LT
rendered <- IO LT
mkrendered
    LT -> Either String Document
tweak LT
rendered HasCallStack =>
Either String Document -> Either String Document -> Expectation
Either String Document -> Either String Document -> Expectation
`assertXmlRoundtrip` LT -> Either String Document
tweak (a -> LT
forall a. HasXMLRoot a => a -> LT
encode a
parsed)
  String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"decode" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ do
    LT
rendered <- IO LT
mkrendered
    a -> Either String a
forall a b. b -> Either a b
Right a
parsed Either String a -> Either String a -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` (String -> String) -> Either String a -> Either String a
forall a b r. (a -> b) -> Either a r -> Either b r
fmapL String -> String
forall a. Show a => a -> String
show (LT -> Either String a
forall (m :: * -> *) a.
(HasXMLRoot a, MonadError String m) =>
LT -> m a
decode LT
rendered)

-- | If we get two XML structures that differ, compute the diff.
assertXmlRoundtrip ::
  HasCallStack =>
  Either String Document ->
  Either String Document ->
  Expectation
assertXmlRoundtrip :: HasCallStack =>
Either String Document -> Either String Document -> Expectation
assertXmlRoundtrip (Right (HasCallStack => Document -> Document
Document -> Document
normalizeDocument -> Document
x)) (Right (HasCallStack => Document -> Document
Document -> Document
normalizeDocument -> Document
y)) =
  HasCallStack => Document -> Document -> Expectation
Document -> Document -> Expectation
assertXmlRoundtripFailWithDiff Document
x Document
y
assertXmlRoundtrip Either String Document
x Either String Document
y =
  Either String Document
x Either String Document -> Either String Document -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Either String Document
y

assertXmlRoundtripFailWithDiff ::
  HasCallStack =>
  Document ->
  Document ->
  Expectation
assertXmlRoundtripFailWithDiff :: HasCallStack => Document -> Document -> Expectation
assertXmlRoundtripFailWithDiff Document
x Document
y = Bool -> Expectation -> Expectation
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Document
x Document -> Document -> Bool
forall a. Eq a => a -> a -> Bool
== Document
y)
  (Expectation -> Expectation)
-> ((String -> Expectation) -> Expectation)
-> (String -> Expectation)
-> Expectation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (String -> Expectation) -> Expectation
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (String -> m a) -> m a
withSystemTempDirectory String
"saml.web.sso.tmp"
  ((String -> Expectation) -> Expectation)
-> (String -> Expectation) -> Expectation
forall a b. (a -> b) -> a -> b
$ \String
tmpdir -> do
    let tmpx :: String
tmpx = String
tmpdir String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/x"
        tmpy :: String
tmpy = String
tmpdir String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/y"
        tmpd :: String
tmpd = String
tmpdir String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/xy"
    Document
x Document -> Expectation -> Expectation
forall a b. a -> b -> b
`seq` String -> String -> Expectation
Prelude.writeFile String
tmpx (Document -> String
forall a. Show a => a -> String
ppShow Document
x)
    Document
y Document -> Expectation -> Expectation
forall a b. a -> b -> b
`seq` String -> String -> Expectation
Prelude.writeFile String
tmpy (Document -> String
forall a. Show a => a -> String
ppShow Document
y)
    ExitCode
_ <- String -> IO ExitCode
system (String -> IO ExitCode) -> String -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ String
"diff " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
tmpx String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
tmpy String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" > " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
tmpd
    String
diff <- String -> IO String
Prelude.readFile String
tmpd
    HasCallStack => String -> Expectation
String -> Expectation
expectationFailure (String
"non-empty diff:\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
diff String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n\nyour output:\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Document -> String
forall a. Show a => a -> String
ppShow Document
y)

-- | Make two 'Document' values that are supposed to be equal easier to compare:
--
-- * render and parse back to normalize the locations where namespaces are declared
-- * sort all children and remove digital signatures
-- * remove all namespace prefices
normalizeDocument :: HasCallStack => Document -> Document
normalizeDocument :: HasCallStack => Document -> Document
normalizeDocument =
  HasCallStack => Document -> Document
Document -> Document
renderAndParse
    (Document -> Document)
-> (Document -> Document) -> Document -> Document
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Transformer]] -> Document -> Document
forall a. Data a => [[Transformer]] -> a -> a
transformBis
      [ [(Name -> Name) -> Transformer
forall a. Data a => (a -> a) -> Transformer
transformer ((Name -> Name) -> Transformer) -> (Name -> Name) -> Transformer
forall a b. (a -> b) -> a -> b
$ \(Name Text
nm Maybe Text
nmspace Maybe Text
_prefix) -> Text -> Maybe Text -> Maybe Text -> Name
Name Text
nm Maybe Text
nmspace Maybe Text
forall a. Maybe a
Nothing],
        [(Element -> Element) -> Transformer
forall a. Data a => (a -> a) -> Transformer
transformer ((Element -> Element) -> Transformer)
-> (Element -> Element) -> Transformer
forall a b. (a -> b) -> a -> b
$ \(Element Name
nm Map Name Text
attrs [Node]
nodes) -> Name -> Map Name Text -> [Node] -> Element
Element Name
nm Map Name Text
attrs ([Node] -> [Node]
forall a. Ord a => [a] -> [a]
sort ([Node] -> [Node]) -> ([Node] -> [Node]) -> [Node] -> [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Node -> Bool) -> [Node] -> [Node]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Node -> Bool) -> Node -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node -> Bool
isSignature) ([Node] -> [Node]) -> [Node] -> [Node]
forall a b. (a -> b) -> a -> b
$ [Node]
nodes)]
      ]

renderAndParse :: HasCallStack => Document -> Document
renderAndParse :: HasCallStack => Document -> Document
renderAndParse Document
doc = case ParseSettings -> LT -> Either SomeException Document
parseText ParseSettings
forall a. Default a => a
def (LT -> Either SomeException Document)
-> LT -> Either SomeException Document
forall a b. (a -> b) -> a -> b
$ RenderSettings -> Document -> LT
renderText RenderSettings
forall a. Default a => a
def {rsPretty = True} Document
doc of
  Right Document
doc' -> Document
doc'
  bad :: Either SomeException Document
bad@(Left SomeException
_) -> String -> Document
forall a. HasCallStack => String -> a
error (String -> Document) -> String -> Document
forall a b. (a -> b) -> a -> b
$ String
"impossible: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Either SomeException Document -> String
forall a. Show a => a -> String
show Either SomeException Document
bad

isSignature :: Node -> Bool
isSignature :: Node -> Bool
isSignature (NodeElement (Element Name
name Map Name Text
_ [Node]
_)) = Name
name Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
"{http://www.w3.org/2000/09/xmldsig#}Signature"
isSignature Node
_ = Bool
False

----------------------------------------------------------------------
-- helpers

passes :: MonadIO m => m ()
passes :: forall (m :: * -> *). MonadIO m => m ()
passes = Expectation -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Expectation -> m ()) -> Expectation -> m ()
forall a b. (a -> b) -> a -> b
$ Bool
True Bool -> Bool -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Bool
True

newtype SomeSAMLRequest = SomeSAMLRequest {SomeSAMLRequest -> Document
fromSomeSAMLRequest :: XML.Document}
  deriving (SomeSAMLRequest -> SomeSAMLRequest -> Bool
(SomeSAMLRequest -> SomeSAMLRequest -> Bool)
-> (SomeSAMLRequest -> SomeSAMLRequest -> Bool)
-> Eq SomeSAMLRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SomeSAMLRequest -> SomeSAMLRequest -> Bool
== :: SomeSAMLRequest -> SomeSAMLRequest -> Bool
$c/= :: SomeSAMLRequest -> SomeSAMLRequest -> Bool
/= :: SomeSAMLRequest -> SomeSAMLRequest -> Bool
Eq, Int -> SomeSAMLRequest -> String -> String
[SomeSAMLRequest] -> String -> String
SomeSAMLRequest -> String
(Int -> SomeSAMLRequest -> String -> String)
-> (SomeSAMLRequest -> String)
-> ([SomeSAMLRequest] -> String -> String)
-> Show SomeSAMLRequest
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> SomeSAMLRequest -> String -> String
showsPrec :: Int -> SomeSAMLRequest -> String -> String
$cshow :: SomeSAMLRequest -> String
show :: SomeSAMLRequest -> String
$cshowList :: [SomeSAMLRequest] -> String -> String
showList :: [SomeSAMLRequest] -> String -> String
Show)

instance HasFormRedirect SomeSAMLRequest where
  formRedirectFieldName :: SomeSAMLRequest -> Text
formRedirectFieldName SomeSAMLRequest
_ = Text
"SAMLRequest"

instance HasXML SomeSAMLRequest where
  nameSpaces :: Proxy SomeSAMLRequest -> [(Text, Text)]
nameSpaces Proxy SomeSAMLRequest
Proxy = []
  parse :: forall (m :: * -> *).
MonadError String m =>
[Node] -> m SomeSAMLRequest
parse = (Document -> SomeSAMLRequest) -> m Document -> m SomeSAMLRequest
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Document -> SomeSAMLRequest
SomeSAMLRequest (m Document -> m SomeSAMLRequest)
-> ([Node] -> m Document) -> [Node] -> m SomeSAMLRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Node] -> m Document
forall a (m :: * -> *).
(HasXML a, MonadError String m) =>
[Node] -> m a
forall (m :: * -> *). MonadError String m => [Node] -> m Document
parse

instance HasXMLRoot SomeSAMLRequest where
  renderRoot :: SomeSAMLRequest -> Element
renderRoot (SomeSAMLRequest Document
doc) = Document -> Element
forall a. HasXMLRoot a => a -> Element
renderRoot Document
doc

base64ours, base64theirs :: HasCallStack => SBS -> IO SBS
base64ours :: HasCallStack => SBS -> IO SBS
base64ours = SBS -> IO SBS
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SBS -> IO SBS) -> (SBS -> SBS) -> SBS -> IO SBS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> SBS
forall a b. ConvertibleStrings a b => a -> b
cs (ByteString -> SBS) -> (SBS -> ByteString) -> SBS -> SBS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
EL.encode (ByteString -> ByteString)
-> (SBS -> ByteString) -> SBS -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SBS -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs
base64theirs :: HasCallStack => SBS -> IO SBS
base64theirs SBS
sbs = Sh SBS -> IO SBS
forall (m :: * -> *) a. MonadIO m => Sh a -> m a
shelly (Sh SBS -> IO SBS) -> (Sh SBS -> Sh SBS) -> Sh SBS -> IO SBS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sh SBS -> Sh SBS
forall a. Sh a -> Sh a
silently (Sh SBS -> IO SBS) -> Sh SBS -> IO SBS
forall a b. (a -> b) -> a -> b
$ Text -> SBS
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> SBS) -> Sh Text -> Sh SBS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Sh ()
setStdin (SBS -> Text
forall a b. ConvertibleStrings a b => a -> b
cs SBS
sbs) Sh () -> Sh Text -> Sh Text
forall a b. Sh a -> Sh b -> Sh b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> [Text] -> Sh Text
run String
"/usr/bin/env" [Text
"base64", Text
"--wrap", Text
"0"])

----------------------------------------------------------------------
-- orphans

instance IsString IdPId where
  fromString :: String -> IdPId
fromString String
piece = IdPId -> (UUID -> IdPId) -> Maybe UUID -> IdPId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> IdPId
forall a. HasCallStack => String -> a
error (String -> IdPId) -> String -> IdPId
forall a b. (a -> b) -> a -> b
$ String
"no valid UUID" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
piece) (UUID -> IdPId
IdPId) (Maybe UUID -> IdPId) -> (String -> Maybe UUID) -> String -> IdPId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe UUID
UUID.fromString (String -> IdPId) -> String -> IdPId
forall a b. (a -> b) -> a -> b
$ String
piece