diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -35,9 +35,6 @@ described in [API.md](API.md). The server is will run on the `localhost` loopback interface on port 8081. -Also included is a [Paw](https://luckymarmot.com/paw) file with a -pre-defined `localhost` environment for use with the example server. - This particular example server uses a "mock lock" device which only internally logs lock and unlock events without depending on any actual hardware, so it will run anywhere. diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,19 @@ +## 0.8.0.2 (2017-09-04) + +- Fix .cabal file for now-removed Paw file. + +## 0.8.0.1 (2017-09-04) + +- Hackage compliance fix. + +## 0.8.0.0 (2017-09-04) + +- Remove out-of-date Paw file. + +- Port to Servant 0.11. Due to Servant 0.11 API changes, our API + has changed, as well (just the Haskell bits; the web API remains + the same). + ## 0.7.1.1 (2017-05-24) No changes; copyright has been assigned to Quixoftic, LLC. diff --git a/examples/ScheduleUnlock.hs b/examples/ScheduleUnlock.hs --- a/examples/ScheduleUnlock.hs +++ b/examples/ScheduleUnlock.hs @@ -111,7 +111,7 @@ do putStrLn $ "Mellon service error: " ++ prettyServantError e exitWith $ ExitFailure 1 prettyServantError :: ServantError -> String - prettyServantError (FailureResponse status _ _) = + prettyServantError (FailureResponse _ status _ _) = show (statusCode status) ++ " " ++ (C8.unpack $ statusMessage status) prettyServantError (DecodeFailure _ _ _) = "decode failure" diff --git a/mellon-web.cabal b/mellon-web.cabal --- a/mellon-web.cabal +++ b/mellon-web.cabal @@ -1,6 +1,6 @@ Name: mellon-web -Version: 0.7.1.1 -Cabal-Version: >= 1.10 +Version: 0.8.0.2 +Cabal-Version: >= 1.18 Build-Type: Simple Author: Drew Hess Maintainer: Drew Hess @@ -43,7 +43,6 @@ , swagger.json Extra-Source-Files: changelog.md , examples/*.hs - , mellon-web.paw -- Build doctests Flag test-doctests @@ -85,28 +84,28 @@ , MultiParamTypeClasses , OverloadedStrings , TypeOperators - Build-Depends: base >= 4.8 && < 5 - , aeson >= 0.11 && < 1.3 - , aeson-pretty - , bytestring == 0.10.* - , http-client >= 0.4 && < 0.6 - , http-types == 0.9.* - , lens - , lucid == 2.9.* - , mellon-core == 0.7.* - , servant >= 0.9 && < 0.10 - , servant-client >= 0.9 && < 0.10 - , servant-docs >= 0.9 && < 0.10 - , servant-lucid >= 0.7.1 && < 0.10 - , servant-server >= 0.9 && < 0.10 - , servant-swagger - , servant-swagger-ui - , swagger2 - , text == 1.2.* - , time >= 1.5 && < 2 - , transformers >= 0.4.2 && < 0.6 - , wai == 3.2.* - , warp == 3.2.* + Build-Depends: base >= 4.8 && < 5 + , aeson >= 0.11 && < 1.3 + , aeson-pretty == 0.8.* + , bytestring == 0.10.* + , http-client >= 0.4 && < 0.6 + , http-types == 0.9.* + , lens >= 4 && < 5 + , lucid == 2.9.* + , mellon-core == 0.8.* + , servant == 0.11.* + , servant-client == 0.11.* + , servant-docs >= 0.10 && < 0.12 + , servant-lucid == 0.7.* + , servant-server == 0.11.* + , servant-swagger == 1.1.* + , servant-swagger-ui == 0.2.* + , swagger2 == 2.1.* + , text == 1.2.* + , time >= 1.5 && < 2 + , transformers >= 0.4.2 && < 0.6 + , wai == 3.2.* + , warp == 3.2.* Executable mock-mellon-server Main-Is: MockServer.hs @@ -138,7 +137,7 @@ , exceptions >= 0.8.0 && < 1 , hpio >= 0.8 && < 1 , mellon-core - , mellon-gpio == 0.7.* + , mellon-gpio == 0.8.* , mellon-web , mtl , network == 2.6.* @@ -184,7 +183,7 @@ Buildable: False Else Build-Depends: base - , hlint == 1.9.* + , hlint >= 1.9 && < 2.1 Test-Suite doctest Type: exitcode-stdio-1.0 @@ -252,4 +251,4 @@ Source-Repository this Type: git Location: git://github.com/quixoftic/mellon.git - Tag: v0.7.1.1 + Tag: v0.8.0.2 diff --git a/mellon-web.paw b/mellon-web.paw deleted file mode 100644 --- a/mellon-web.paw +++ /dev/null @@ -1,387 +0,0 @@ - - - - - - 134481920 - 1E1D451C-4E87-4F1C-8A5D-6A76267CA5ED - 132 - - - - NSPersistenceFrameworkVersion - 640 - NSStoreModelVersionHashes - - LMCookieJar - - Fttmf2L4PrGvKUF496+nqgVVGek45TjOe7sUMtjNg8I= - - LMEnvironment - - uzBoVFcO4YvR9/3ej4AJ1UOOsA/u5DKY2aemusoIseU= - - LMEnvironmentDomain - - yM1GPGHdquS8IWLtuczlNoqKhIhD9FW6IReSfFffJgs= - - LMEnvironmentVariable - - P8e0lYd5JZKRabS/eXVSOJ4oitilz67xtv+pLqW1Jqg= - - LMEnvironmentVariableValue - - my5hNPJ51oDCSa8EgdNxWAnRcDLcERUGjtuXnzhSxQ0= - - LMKeyValue - - bIXXbyYF2xAv2MXg8JTVFsslmMKuvsfnR86QdUcFkdM= - - LMRequest - - kYB6By9dZHqmH3YNw3h9tYPoxeG5ZWHPfhLXXp7OLFs= - - LMRequestGroup - - N3ml+gYVWc4m0LSGLnBDJ37p9isOc41y+TtaM0Eacrc= - - LMRequestTreeItem - - ak+hYb/lDeG55U0kgGvU5ej7HUltUj0RTrX5z/izNrs= - - - NSStoreModelVersionHashesVersion - 3 - NSStoreModelVersionIdentifiers - - LMDocumentVersion3 - - - - - - - 48D5A84F-CA3A-4E31-B9A2-3E90E65179F5 - [{"data":{"environmentVariable":"CF638FE7-0A86-4129-B488-AF6225D53392"},"identifier":"com.luckymarmot.EnvironmentVariableDynamicValue"},":\\/\\/",{"data":{"environmentVariable":"0F7D7E4D-E5E5-430F-90EB-E4617541F817"},"identifier":"com.luckymarmot.EnvironmentVariableDynamicValue"},":",{"data":{"environmentVariable":"7CB28DDF-2140-4675-A9FC-6DF2570EE218"},"identifier":"com.luckymarmot.EnvironmentVariableDynamicValue"},"\\/state"] - 1 - 1 - 0 - 0 - PUT - 0 - [{"data":{"json":"{\\"state\\":\\"Unlocked\\",\\"until\\":\\"[{\\\\\\"data\\\\\\":{\\\\\\"format\\\\\\":3,\\\\\\"customFormat\\\\\\":[],\\\\\\"now\\\\\\":true,\\\\\\"useTSeparator\\\\\\":1,\\\\\\"date\\\\\\":1443060019.378293,\\\\\\"delta\\\\\\":10,\\\\\\"useZForUTC\\\\\\":1},\\\\\\"identifier\\\\\\":\\\\\\"com.luckymarmot.TimestampDynamicValue\\\\\\"}]\\"}"},"identifier":"com.luckymarmot.JSONDynamicValue"}] - 3 - Unlock for 10s - - - - - - 46D05D33-1307-4DE8-A337-54150C4D82D4 - 1 - Default Jar - - - 1BC02327-3607-4075-A036-96A3F21EB896 - 0 - Default Domain - - - - - 0F7D7E4D-E5E5-430F-90EB-E4617541F817 - 0 - host - - - - - localhost - - - - - 08E692C2-8C79-4BF5-95E1-C7CBC9627D79 - [{"data":{"environmentVariable":"CF638FE7-0A86-4129-B488-AF6225D53392"},"identifier":"com.luckymarmot.EnvironmentVariableDynamicValue"},":\\/\\/",{"data":{"environmentVariable":"0F7D7E4D-E5E5-430F-90EB-E4617541F817"},"identifier":"com.luckymarmot.EnvironmentVariableDynamicValue"},":",{"data":{"environmentVariable":"7CB28DDF-2140-4675-A9FC-6DF2570EE218"},"identifier":"com.luckymarmot.EnvironmentVariableDynamicValue"},"\\/time"] - 1 - 1 - 0 - 0 - GET - 0 - 5 - Get time - - - - - - 806883AB-58E3-4D72-9C0B-FFF62CB0E228 - 0 - localhost - - - - - - 0 - - 1 - - - - - - - - 0 - - 1 - - - - - - - - 0 - - 1 - - - - - - - 949BC3B1-EE2E-40AB-A805-C59ACFA37E5A - [{"data":{"environmentVariable":"CF638FE7-0A86-4129-B488-AF6225D53392"},"identifier":"com.luckymarmot.EnvironmentVariableDynamicValue"},":\\/\\/",{"data":{"environmentVariable":"0F7D7E4D-E5E5-430F-90EB-E4617541F817"},"identifier":"com.luckymarmot.EnvironmentVariableDynamicValue"},":",{"data":{"environmentVariable":"7CB28DDF-2140-4675-A9FC-6DF2570EE218"},"identifier":"com.luckymarmot.EnvironmentVariableDynamicValue"},"\\/state"] - 1 - 1 - 0 - 0 - GET - 0 - 0 - Get state - - - - - - 296FB78E-5DF8-427F-B0B3-87F36566B5AE - [{"data":{"environmentVariable":"CF638FE7-0A86-4129-B488-AF6225D53392"},"identifier":"com.luckymarmot.EnvironmentVariableDynamicValue"},":\\/\\/",{"data":{"environmentVariable":"0F7D7E4D-E5E5-430F-90EB-E4617541F817"},"identifier":"com.luckymarmot.EnvironmentVariableDynamicValue"},":",{"data":{"environmentVariable":"7CB28DDF-2140-4675-A9FC-6DF2570EE218"},"identifier":"com.luckymarmot.EnvironmentVariableDynamicValue"},"\\/state"] - 1 - 1 - 0 - 0 - PUT - 0 - [{"data":{"json":"{\\"state\\":\\"Locked\\",\\"until\\":[]}"},"identifier":"com.luckymarmot.JSONDynamicValue"}] - 4 - Lock now - - - - - - - 0 - - 1 - - - - - - - 63AA61F1-3718-458E-9ED7-BF94700EFE50 - [{"data":{"environmentVariable":"CF638FE7-0A86-4129-B488-AF6225D53392"},"identifier":"com.luckymarmot.EnvironmentVariableDynamicValue"},":\\/\\/",{"data":{"environmentVariable":"0F7D7E4D-E5E5-430F-90EB-E4617541F817"},"identifier":"com.luckymarmot.EnvironmentVariableDynamicValue"},":",{"data":{"environmentVariable":"7CB28DDF-2140-4675-A9FC-6DF2570EE218"},"identifier":"com.luckymarmot.EnvironmentVariableDynamicValue"},"\\/state"] - 1 - 1 - 0 - 0 - GET - 0 - - 1 - Get state (accept JSON) - - - - - - application/json - 0 - Accept - 1 - - - - - - - - 1 - - 1 - - - - - - - 18CAAEEC-FC1F-40A9-B000-71EF7965A35D - [{"data":{"environmentVariable":"CF638FE7-0A86-4129-B488-AF6225D53392"},"identifier":"com.luckymarmot.EnvironmentVariableDynamicValue"},":\\/\\/",{"data":{"environmentVariable":"0F7D7E4D-E5E5-430F-90EB-E4617541F817"},"identifier":"com.luckymarmot.EnvironmentVariableDynamicValue"},":",{"data":{"environmentVariable":"7CB28DDF-2140-4675-A9FC-6DF2570EE218"},"identifier":"com.luckymarmot.EnvironmentVariableDynamicValue"},"\\/state"] - 1 - 1 - 0 - 0 - GET - 0 - - 2 - Get state (accept HTML) - - - - - - - 1 - - 1 - - - - - - - text/html - 0 - Accept - 1 - - - - - - - - 1 - - 1 - - - - - - - text/html - 0 - Accept - 1 - - - - - - - F4DDFE27-4F2E-4E50-8CD1-05C666C5B1A5 - [{"data":{"environmentVariable":"CF638FE7-0A86-4129-B488-AF6225D53392"},"identifier":"com.luckymarmot.EnvironmentVariableDynamicValue"},":\\/\\/",{"data":{"environmentVariable":"0F7D7E4D-E5E5-430F-90EB-E4617541F817"},"identifier":"com.luckymarmot.EnvironmentVariableDynamicValue"},":",{"data":{"environmentVariable":"7CB28DDF-2140-4675-A9FC-6DF2570EE218"},"identifier":"com.luckymarmot.EnvironmentVariableDynamicValue"},"\\/time"] - 1 - 1 - 0 - 0 - GET - 0 - 7 - Get time (accept HTML) - - - - - - - 1 - - 1 - - - - - - - application/json - 0 - Accept - 1 - - - - - - - 62F86462-ED46-4738-9877-86AD97E3535A - [{"data":{"environmentVariable":"CF638FE7-0A86-4129-B488-AF6225D53392"},"identifier":"com.luckymarmot.EnvironmentVariableDynamicValue"},":\\/\\/",{"data":{"environmentVariable":"0F7D7E4D-E5E5-430F-90EB-E4617541F817"},"identifier":"com.luckymarmot.EnvironmentVariableDynamicValue"},":",{"data":{"environmentVariable":"7CB28DDF-2140-4675-A9FC-6DF2570EE218"},"identifier":"com.luckymarmot.EnvironmentVariableDynamicValue"},"\\/time"] - 1 - 1 - 0 - 0 - GET - 0 - 6 - Get time (accept JSON) - - - - - - A0AE2FB5-7F43-4C52-BFF7-0E922225030D - [{"data":{"environmentVariable":"CF638FE7-0A86-4129-B488-AF6225D53392"},"identifier":"com.luckymarmot.EnvironmentVariableDynamicValue"},":\\/\\/",{"data":{"environmentVariable":"0F7D7E4D-E5E5-430F-90EB-E4617541F817"},"identifier":"com.luckymarmot.EnvironmentVariableDynamicValue"},":",{"data":{"environmentVariable":"7CB28DDF-2140-4675-A9FC-6DF2570EE218"},"identifier":"com.luckymarmot.EnvironmentVariableDynamicValue"},"\\/docs"] - 1 - 1 - 0 - 0 - GET - 0 - 8 - Get docs - - - - - - - 0 - - 1 - - - - - - - 7CB28DDF-2140-4675-A9FC-6DF2570EE218 - 2 - port - - - - - 8081 - - - - - CF638FE7-0A86-4129-B488-AF6225D53392 - 1 - protocol - - - - - http - - - - diff --git a/src/Mellon/Web/Server/API.hs b/src/Mellon/Web/Server/API.hs --- a/src/Mellon/Web/Server/API.hs +++ b/src/Mellon/Web/Server/API.hs @@ -19,7 +19,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedLists #-} @@ -40,8 +39,7 @@ import Control.Lens ((&), (.~), (?~), mapped) import Control.Monad.Trans.Reader (ReaderT, runReaderT, ask) -import Control.Monad.Trans.Except (ExceptT) -import Control.Monad.IO.Class (MonadIO, liftIO) +import Control.Monad.IO.Class (liftIO) import qualified Data.Aeson.Types as Aeson (Value(String)) import Data.Aeson.Types ((.=), (.:), (.:?), FromJSON(..), Pair, Series, ToJSON(..), @@ -66,8 +64,8 @@ import qualified Mellon.Controller as Controller (State(..)) import Network.Wai (Application) import Servant - ((:>), (:<|>)(..), (:~>)(..), JSON, Get, ReqBody, Put, Proxy(..), - ServerT, Server, ServantErr, enter, serve) + ((:<|>)(..), (:>), (:~>)(..), Get, Handler, JSON, Proxy(..), Put, + ReqBody, Server, ServerT, enter, serve) import Servant.Docs (ToSample(..)) import Servant.HTML.Lucid (HTML) @@ -249,25 +247,25 @@ "state" :> Get '[JSON, HTML] State :<|> "state" :> ReqBody '[JSON] State :> Put '[JSON, HTML] State -type AppM d m = ReaderT (Controller d) (ExceptT ServantErr m) +type AppM d = ReaderT (Controller d) Handler -serverT :: (MonadIO m) => ServerT MellonAPI (AppM d m) +serverT :: ServerT MellonAPI (AppM d) serverT = getTime :<|> getState :<|> putState where - getTime :: (MonadIO m) => AppM d m Time + getTime :: AppM d Time getTime = do now <- liftIO getCurrentTime return $ Time now - getState :: (MonadIO m) => AppM d m State + getState :: AppM d State getState = do cc <- ask fmap stateToState (queryController cc) - putState :: (MonadIO m) => State -> AppM d m State + putState :: State -> AppM d State putState Locked = do cc <- ask fmap stateToState (lockController cc) @@ -280,8 +278,8 @@ mellonAPI :: Proxy MellonAPI mellonAPI = Proxy -serverToEither :: (MonadIO m) => Controller d -> AppM d m :~> ExceptT ServantErr m -serverToEither cc = Nat $ \m -> runReaderT m cc +appToHandler :: Controller d -> AppM d :~> Handler +appToHandler cc = NT $ \m -> runReaderT m cc -- | A Servant 'Server' which serves the 'MellonAPI' on the given -- 'Controller'. @@ -289,7 +287,7 @@ -- Normally you will just use 'app', but this function is exported so -- that you can extend/wrap 'MellonAPI'. server :: Controller d -> Server MellonAPI -server cc = enter (serverToEither cc) serverT +server cc = enter (appToHandler cc) serverT -- | A WAI 'Network.Wai.Application' which runs the service, using the -- given 'Controller'. diff --git a/swagger.json b/swagger.json --- a/swagger.json +++ b/swagger.json @@ -57,13 +57,13 @@ } }, "produces": [ - "application/json", + "application/json;charset=utf-8", "text/html;charset=utf-8" ] }, "put": { "consumes": [ - "application/json" + "application/json;charset=utf-8" ], "responses": { "400": { @@ -77,7 +77,7 @@ } }, "produces": [ - "application/json", + "application/json;charset=utf-8", "text/html;charset=utf-8" ], "parameters": [ @@ -103,7 +103,7 @@ } }, "produces": [ - "application/json", + "application/json;charset=utf-8", "text/html;charset=utf-8" ] }