diff --git a/api-dungeon-studio.cabal b/api-dungeon-studio.cabal index c7f3457..940fd17 100644 --- a/api-dungeon-studio.cabal +++ b/api-dungeon-studio.cabal @@ -64,6 +64,7 @@ executable api-dungeon-studio , Internal.BoltPool.Environment , Internal.JWT.Environment , Internal.Network.URI + , Internal.Network.URI.Validation , Settings build-depends: @@ -95,6 +96,7 @@ executable api-dungeon-studio , time == 1.6.* , unordered-containers == 0.2.* , uuid == 1.3.* + , validation == 0.5.* , wai == 3.2.* , wai-cors == 0.2.* , wai-logger == 2.3.* diff --git a/default.nix b/default.nix index 6ad3c0c..8f023a8 100644 --- a/default.nix +++ b/default.nix @@ -1,10 +1,11 @@ { mkDerivation, aeson, base, bytestring, connection, containers -, data-default, envy, exceptions, hasbolt, hspec, http-api-data -, http-conduit, http-media, http-types, ieee754, jose, lens, mtl -, network-arbitrary, network-uri, network-uri-json, QuickCheck -, quickcheck-instances, regex-compat, resource-pool, retry, servant -, servant-server, siren-json, stdenv, test-invariant, text, time -, unordered-containers, uuid, wai, wai-cors, wai-logger, warp +, data-default, envy, exceptions, hasbolt, hspec, hspec-discover +, http-api-data, http-conduit, http-media, http-types, ieee754 +, jose, lens, mtl, network-arbitrary, network-uri, network-uri-json +, QuickCheck, quickcheck-instances, regex-compat, resource-pool +, retry, servant, servant-server, siren-json, stdenv +, test-invariant, text, time, unordered-containers, uuid +, validation, wai, wai-cors, wai-logger, warp }: mkDerivation { pname = "api-dungeon-studio"; @@ -17,7 +18,7 @@ mkDerivation { exceptions hasbolt http-api-data http-conduit http-media http-types jose lens mtl network-uri network-uri-json regex-compat resource-pool retry servant servant-server siren-json text time - unordered-containers uuid wai wai-cors wai-logger warp + unordered-containers uuid validation wai wai-cors wai-logger warp ]; testHaskellDepends = [ aeson base envy exceptions hspec http-api-data http-media @@ -26,6 +27,7 @@ mkDerivation { servant-server siren-json test-invariant text time unordered-containers ]; + testToolDepends = [ hspec-discover ]; homepage = "https://github.com/alunduil/api.dungeon.studio"; description = "Game Master's Companion"; license = stdenv.lib.licenses.mit; diff --git a/src/Characters/Queries.hs b/src/Characters/Queries.hs index 561c03b..7153230 100644 --- a/src/Characters/Queries.hs +++ b/src/Characters/Queries.hs @@ -66,10 +66,7 @@ instance Exception CharacterException -- | Retrieve all 'Character's. all :: (MonadIO m, MonadCatch m) => Pool Pipe -> Text -> m (URI -> [Link] -> Characters) -all p o = - do cs <- mapM (toCharacter <=< (`at` "c")) =<< q p cypher ps - return $ flip Characters cs - +all p o = flip Characters <$> mapM (toCharacter <=< (`at` "c")) =<< q p cypher ps where cypher :: Text cypher = "MATCH (c:Character)<-[:OWNS|:CAN_READ]-(:Owner {sub:{sub}}) " <> "RETURN c" diff --git a/src/Characters/Types.hs b/src/Characters/Types.hs index 8a7c872..c0498b8 100644 --- a/src/Characters/Types.hs +++ b/src/Characters/Types.hs @@ -94,8 +94,8 @@ instance ToEntity Character where -- | Earthdawn new character representation type. data NewCharacter = NewCharacter - { nDiscipline :: URI - , nRace :: URI + { nDiscipline :: AbsoluteURI + , nRace :: AbsoluteURI } instance FromForm NewCharacter where diff --git a/test/External/Servant/API/BearerAuth/InternalSpec.hs b/test/External/Servant/API/BearerAuth/InternalSpec.hs index d361240..69e6145 100644 --- a/test/External/Servant/API/BearerAuth/InternalSpec.hs +++ b/test/External/Servant/API/BearerAuth/InternalSpec.hs @@ -33,19 +33,19 @@ spec = it "should throw InvalidToken \"sub claim invalid\"" $ let cs = emptyClaimsSet & - claimSub .~ Just "mailto://user@example.com" + claimSub ?~ "mailto://user@example.com" in claims nullURI cs `shouldThrow` invalidToken "sub claim invalid" it "should throw InvalidToken \"scope claim missing\"" $ let cs = emptyClaimsSet & - claimSub .~ Just "user@example.com" + claimSub ?~ "user@example.com" in claims nullURI cs `shouldThrow` invalidToken "scope claim missing" it "should throw InvalidToken \"scope claim invalid\"" pending it "should return valid Claims" $ let cs = emptyClaimsSet & - claimSub .~ Just "subject" & + claimSub ?~ "subject" & unregisteredClaims .~ HashMap.fromList [ ("scope", String "s1 s2") ] in claims nullURI cs `shouldReturn` Claims { sub = "subject", scope = [ "s1", "s2" ], audience = nullURI }