diff --git a/saml2-web-sso.cabal b/saml2-web-sso.cabal index d21b87e8..3dfec292 100644 --- a/saml2-web-sso.cabal +++ b/saml2-web-sso.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.31.2. +-- This file has been generated from package.yaml by hpack version 0.33.0. -- -- see: https://github.com/sol/hpack -- diff --git a/src/SAML2/WebSSO/API/Example.hs b/src/SAML2/WebSSO/API/Example.hs index fdf32ba9..126a85d7 100644 --- a/src/SAML2/WebSSO/API/Example.hs +++ b/src/SAML2/WebSSO/API/Example.hs @@ -12,6 +12,7 @@ import Control.Lens import Control.Monad.Except import Control.Monad.Reader import Data.EitherR (fmapL) +import Data.Kind (Type) import Data.Map as Map import Data.Proxy import Data.String.Conversions @@ -153,7 +154,7 @@ app :: Config -> [IdPConfig_] -> IO Application app cfg idps = app' (Proxy @SimpleSP) =<< mkSimpleSPCtx cfg idps app' :: - forall (m :: * -> *). + forall (m :: Type -> Type). (SP m, MonadApp m) => Proxy m -> NTCTX m -> diff --git a/src/SAML2/WebSSO/Cookie.hs b/src/SAML2/WebSSO/Cookie.hs index fed994da..4cd6137b 100644 --- a/src/SAML2/WebSSO/Cookie.hs +++ b/src/SAML2/WebSSO/Cookie.hs @@ -43,7 +43,7 @@ cookieToHeader = . renderSetCookie . fromSimpleSetCookie -cookieName :: forall (proxy :: Symbol -> *) (name :: Symbol). KnownSymbol name => proxy name -> SBS +cookieName :: forall (proxy :: Symbol -> Type) (name :: Symbol). KnownSymbol name => proxy name -> SBS cookieName _ = cs $ symbolVal (Proxy @name) headerValueToCookie :: forall name. KnownSymbol name => ST -> Either ST (SimpleSetCookie name) diff --git a/src/SAML2/WebSSO/Orphans.hs b/src/SAML2/WebSSO/Orphans.hs index 5329368d..59c94d67 100644 --- a/src/SAML2/WebSSO/Orphans.hs +++ b/src/SAML2/WebSSO/Orphans.hs @@ -7,6 +7,7 @@ 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) @@ -25,7 +26,7 @@ instance ToHttpApiData URI where toUrlPiece = renderURI instance FromHttpApiData URI where - parseUrlPiece = either (fail . show) pure . parseURI' <=< parseUrlPiece + parseUrlPiece = either (Left . Text.pack) pure . parseURI' <=< parseUrlPiece instance FromJSON X509.SignedCertificate where parseJSON = withText "KeyInfo element" $ either fail pure . parseKeyInfo False . cs diff --git a/src/SAML2/WebSSO/SP.hs b/src/SAML2/WebSSO/SP.hs index 14c17e6e..65c74063 100644 --- a/src/SAML2/WebSSO/SP.hs +++ b/src/SAML2/WebSSO/SP.hs @@ -6,6 +6,7 @@ import Control.Lens hiding (Level) import Control.Monad.Except import Control.Monad.Extra (ifM) import Control.Monad.Reader +import Data.Kind (Type) import Control.Monad.Writer import Data.Foldable (toList) import Data.List.NonEmpty (NonEmpty) @@ -56,14 +57,14 @@ class SPStoreID i m where m Bool class (MonadError err m) => SPStoreIdP err m where - type IdPConfigExtra m :: * + type IdPConfigExtra m :: Type storeIdPConfig :: IdPConfig (IdPConfigExtra m) -> m () getIdPConfig :: IdPId -> m (IdPConfig (IdPConfigExtra m)) getIdPConfigByIssuer :: Issuer -> m (IdPConfig (IdPConfigExtra m)) -- | HTTP handling of the service provider. class (SP m, SPStore m, SPStoreIdP err m, MonadError err m) => SPHandler err m where - type NTCTX m :: * + type NTCTX m :: Type nt :: forall x. NTCTX m -> m x -> Handler x ---------------------------------------------------------------------- @@ -169,7 +170,7 @@ getSsoURI proxyAPI proxyAPIAuthResp = extpath . (^. cfgSPSsoURI) <$> getConfig -- FUTUREWORK: this is only sometimes what we need. it would be nice to have a type class with a -- method 'getSsoURI' for arbitrary path arities. getSsoURI' :: - forall endpoint api a (f :: * -> *) t. + forall endpoint api a (f :: Type -> Type) t. ( HasConfig f, MkLink endpoint ~ (t -> a), HasLink endpoint, diff --git a/src/SAML2/WebSSO/Test/Util/TestSP.hs b/src/SAML2/WebSSO/Test/Util/TestSP.hs index 2a3344c0..4c4c063c 100644 --- a/src/SAML2/WebSSO/Test/Util/TestSP.hs +++ b/src/SAML2/WebSSO/Test/Util/TestSP.hs @@ -7,17 +7,16 @@ import Control.Concurrent.MVar import Control.Exception (ErrorCall (..), throwIO) import Control.Lens import Control.Monad.Except -import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Reader import Crypto.Random.Types (MonadRandom (..)) import Data.EitherR +import Data.Kind (Type) import Data.List.NonEmpty (NonEmpty ((:|))) import qualified Data.Map as Map import Data.Maybe import Data.Time import qualified Data.UUID as UUID import qualified Data.UUID.V4 as UUID -import GHC.Stack (HasCallStack) import Network.Wai.Test (runSession) import SAML2.WebSSO as SAML import SAML2.WebSSO.API.Example (GetAllIdPs (..), simpleGetIdPConfigBy, simpleIsAliveID', simpleStoreID', simpleUnStoreID') @@ -119,7 +118,7 @@ ioFromTestSP :: CtxV -> TestSP a -> IO a ioFromTestSP ctx m = either (throwIO . ErrorCall . show) pure =<< (runExceptT . runHandler' $ handlerFromTestSP ctx m) withapp :: - forall (api :: *). + forall (api :: Type). (HasServer api '[]) => Proxy api -> ServerT api TestSP -> diff --git a/src/SAML2/WebSSO/Types.hs b/src/SAML2/WebSSO/Types.hs index 234b4041..8c99b945 100644 --- a/src/SAML2/WebSSO/Types.hs +++ b/src/SAML2/WebSSO/Types.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StrictData #-} @@ -163,10 +165,10 @@ import Data.Aeson.TH -- depend on that via xml-conduit anyway. (is it a problem though that it is -- string-based? is it less of a problem because we need it anyway?) +import Data.Bifunctor (first) import qualified Data.List as L import Data.List.NonEmpty import Data.Maybe -import Data.Monoid ((<>)) import Data.String.Conversions (ST, cs) import qualified Data.Text as ST import Data.Time (NominalDiffTime, UTCTime (..), addUTCTime, defaultTimeLocale, formatTime, parseTimeM) @@ -804,12 +806,18 @@ instance Servant.ToHttpApiData (ID a) where instance Servant.FromHttpApiData Time where parseUrlPiece st = - fmap Time . parseTimeM True defaultTimeLocale timeFormat =<< Servant.parseUrlPiece @String st + fmap Time . first ST.pack . unwrapEitherFail . parseTimeM True defaultTimeLocale timeFormat =<< Servant.parseUrlPiece @String st instance Servant.ToHttpApiData Time where toUrlPiece = Servant.toUrlPiece . formatTime defaultTimeLocale timeFormat . fromTime +newtype EitherFail a = EitherFail {unwrapEitherFail :: Either String a} + deriving newtype (Functor, Applicative, Monad) + +instance MonadFail EitherFail where + fail s = EitherFail (Left s) + instance FromJSON Status instance ToJSON Status diff --git a/src/SAML2/WebSSO/XML.hs b/src/SAML2/WebSSO/XML.hs index dd53d92e..45a09357 100644 --- a/src/SAML2/WebSSO/XML.hs +++ b/src/SAML2/WebSSO/XML.hs @@ -29,13 +29,12 @@ import Control.Monad import Control.Monad.Except import Data.EitherR import Data.Foldable (toList) +import Data.Kind (Type) import qualified Data.List as List import Data.List.NonEmpty as NL (NonEmpty ((:|)), nonEmpty) import qualified Data.List.NonEmpty as NL import qualified Data.Map as Map import Data.Maybe -import Data.Maybe (catMaybes, fromMaybe) -import Data.Monoid ((<>)) import Data.String.Conversions import qualified Data.Text as ST import Data.Time @@ -232,7 +231,7 @@ class HasXMLImport us them where exportXml :: us -> them wrapParse :: - forall (m :: * -> *) them us. + forall (m :: Type -> Type) them us. (HasCallStack, MonadError String m, HS.XmlPickler them, HasXML us, Typeable us) => (them -> m us) -> [Node] -> diff --git a/src/Text/XML/DSig.hs b/src/Text/XML/DSig.hs index 3a52864e..ea030fd6 100644 --- a/src/Text/XML/DSig.hs +++ b/src/Text/XML/DSig.hs @@ -59,7 +59,6 @@ import Data.List (foldl') import Data.List.NonEmpty (NonEmpty ((:|))) import qualified Data.List.NonEmpty as NL import qualified Data.Map as Map -import Data.Monoid ((<>)) import Data.String.Conversions import Data.UUID as UUID import qualified Data.X509 as X509 @@ -307,9 +306,9 @@ signRootAt sigPos (SignPrivCreds hashAlg (SignPrivKeyRSA keypair)) doc = -- (note that there are two rounds of SHA256 application, hence two mentions of the has alg here) signedInfoSBS :: SBS <- - either (throwError . show) (pure . cs) . unsafePerformIO . try @SomeException $ - HS.applyCanonicalization (HS.signedInfoCanonicalizationMethod signedInfo) Nothing $ - HS.samlToDoc signedInfo + either (throwError . show) (pure . cs) . unsafePerformIO . try @SomeException + $ HS.applyCanonicalization (HS.signedInfoCanonicalizationMethod signedInfo) Nothing + $ HS.samlToDoc signedInfo sigval :: SBS <- either (throwError . show @RSA.Error) pure =<< RSA.signSafer diff --git a/src/Text/XML/Util.hs b/src/Text/XML/Util.hs index b418ee6d..dcbbc1e0 100644 --- a/src/Text/XML/Util.hs +++ b/src/Text/XML/Util.hs @@ -5,8 +5,8 @@ module Text.XML.Util where import Control.Monad.Except import qualified Data.ByteString.Lazy as BSL import Data.Char (isSpace) -import Data.Default (Default (..)) import qualified Data.Generics.Uniplate.Data as Uniplate +import Data.Kind (Type) import Data.Map as Map import Data.Proxy import Data.String.Conversions @@ -19,10 +19,10 @@ import Text.XML import qualified Text.XML.HXT.Core as HXT import qualified Text.XML.HXT.DOM.ShowXml -die :: forall (a :: *) b c m. (Typeable a, Show b, MonadError String m) => Proxy a -> b -> m c +die :: forall (a :: Type) b c m. (Typeable a, Show b, MonadError String m) => Proxy a -> b -> m c die = die' Nothing -die' :: forall (a :: *) b c m. (Typeable a, Show b, MonadError String m) => Maybe String -> Proxy a -> b -> m c +die' :: forall (a :: Type) b c m. (Typeable a, Show b, MonadError String m) => Maybe String -> Proxy a -> b -> m c die' mextra Proxy msg = throwError $ "HasXML: could not parse " <> show (typeOf @a undefined) <> ": " <> show msg <> maybe "" ("; " <>) mextra diff --git a/stack.yaml b/stack.yaml index 22bc0ce4..710d0fb3 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,19 +1,18 @@ -resolver: lts-14.27 +resolver: lts-16.10 packages: - . extra-deps: - git: https://github.com/wireapp/hsaml2 - commit: cc47da1d097b0b26595b8889e40c33c6c0c1c551 # master (Feb 27, 2020) + commit: 2ff7b0c11a9d510f1ec411f436bc134b216ebd4a # akshaymankar/pull-upstream-2020-08-18 (Aug 21, 2020) - git: https://github.com/wireapp/hspec-wai - commit: ca10d13deab929f1cc3a569abea2e7fbe35fdbe3 # https://github.com/hspec/hspec-wai/pull/49 + commit: 0a5142cd3ba48116ff059c041348b817fb7bdb25 # https://github.com/hspec/hspec-wai/pull/49 - invertible-hxt-0.1 # for hsaml2 -- hedgehog-quickcheck-0.1.1 +- servant-multipart-0.11.5 # Dropped from stackage -- ormolu-0.1.1.0 +- ormolu-0.1.2.0 - ghc-lib-parser-8.10.1.20200412@sha256:b0517bb150a02957d7180f131f5b94abd2a7f58a7d1532a012e71618282339c2,8751 # for ormolu-0.0.5.0 - nix: packages: - zlib diff --git a/stack.yaml.lock b/stack.yaml.lock new file mode 100644 index 00000000..42c9290c --- /dev/null +++ b/stack.yaml.lock @@ -0,0 +1,62 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/lock_files + +packages: +- completed: + name: hsaml2 + version: '0.1' + git: https://github.com/wireapp/hsaml2 + pantry-tree: + size: 3918 + sha256: c2f2849bc28cc7fb8a4ec843dbc7606df179915dc54c5cc2aa2e30b974ef3d61 + commit: 2ff7b0c11a9d510f1ec411f436bc134b216ebd4a + original: + git: https://github.com/wireapp/hsaml2 + commit: 2ff7b0c11a9d510f1ec411f436bc134b216ebd4a +- completed: + name: hspec-wai + version: 0.9.2 + git: https://github.com/wireapp/hspec-wai + pantry-tree: + size: 1829 + sha256: 1da15bc431ded925782e30d299556f7c33ab89fa74e5a519061081616fb9f4d7 + commit: 0a5142cd3ba48116ff059c041348b817fb7bdb25 + original: + git: https://github.com/wireapp/hspec-wai + commit: 0a5142cd3ba48116ff059c041348b817fb7bdb25 +- completed: + hackage: invertible-hxt-0.1@sha256:8495092e94f6a7eebbdf980a8ccd3684f2078b02b2faf4b4822b1202ee42dae9,865 + pantry-tree: + size: 195 + sha256: da65a22968a2fecc17f42e66f1f3d0d2f341e4af50bf496c6c0fe84c0907f756 + original: + hackage: invertible-hxt-0.1 +- completed: + hackage: servant-multipart-0.11.5@sha256:1633f715b5b53d648a1da69839bdc5046599f4f7244944d4bbf852dba38d8f4b,2319 + pantry-tree: + size: 333 + sha256: b3e1fd2ad2e654475be000c2f0ac6f717b5499436fa73eec50ceccddf352dcec + original: + hackage: servant-multipart-0.11.5 +- completed: + hackage: ormolu-0.1.2.0@sha256:c94a62e515cd03f6610a88de5fe37927756ad793885243a2736289930419e71e,6237 + pantry-tree: + size: 71915 + sha256: 7a0cad8ba46f118c4c46e65280e363c73190e7f4e4a01534b33e62fd475847ea + original: + hackage: ormolu-0.1.2.0 +- completed: + hackage: ghc-lib-parser-8.10.1.20200412@sha256:b0517bb150a02957d7180f131f5b94abd2a7f58a7d1532a012e71618282339c2,8751 + pantry-tree: + size: 19497 + sha256: b11275740480138dd1fce4a22a2aa8835cddfecaa8da58a153f130b4575f9df5 + original: + hackage: ghc-lib-parser-8.10.1.20200412@sha256:b0517bb150a02957d7180f131f5b94abd2a7f58a7d1532a012e71618282339c2,8751 +snapshots: +- completed: + size: 532383 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/16/10.yaml + sha256: 469d781ab6d2a4eceed6b31b6e4ec842dcd3cd1d11577972e86902603dce24df + original: lts-16.10