Merge pull request #2 from NoRedInk/158775399-drop-dependencies

Drop dependencies

.hindent.yaml

@@ -0,0 +1,3 @@
+line-breaks:
+  - :>
+  - :<|>

package.yaml

@@ -7,18 +7,12 @@ copyright: 2017 NoRedInk
 license: BSD3
 dependencies:
 - aeson == 1.2.3.0
-- aeson-casing == 0.1.0.5
 - base == 4.10.1.0
-- bytestring == 0.10.8.2
 - cereal == 0.5.5.0
 - jose-jwt == 0.7.8
 - http-api-data == 0.3.7.1
-- http-types == 0.9.1
 - network-uri == 2.6.1.0
-- protolude == 0.2.1
 - servant == 0.11
-- servant-auth-server == 0.3.1.0
-- servant-server == 0.11.0.1
 - text == 1.2.2.2
 ghc-options:
 - -Wall
@@ -32,7 +26,6 @@ default-extensions:
 - LambdaCase
 - MultiParamTypeClasses
 - NamedFieldPuns
-- NoImplicitPrelude
 - OverloadedStrings
 - PackageImports
 - ScopedTypeVariables

src/OAuth2/Authorize.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE TypeFamilies #-}
 
 {-|
@@ -9,16 +8,16 @@ module OAuth2.Authorize where
 import "base" Control.Monad.Fail (fail)
 import "aeson" Data.Aeson
        (FromJSON(parseJSON), ToJSON(toJSON), withText)
-import qualified "text" Data.Text as T
 import "base" GHC.Exts (IsList(Item, fromList, toList))
 import "this" OAuth2.Types
        (CSRFState, ClientId, RedirectURI, Scope)
-import "protolude" Protolude
 import "servant" Servant.API
        ((:>), FromHttpApiData(parseUrlPiece), Header, Headers, JSON,
         NoContent, QueryParam, StdMethod(GET), ToHttpApiData(toUrlPiece),
         Verb)
 
+import qualified "text" Data.Text as T
+
 -- | Specification of the /autorize endpoint
 --
 --   <https://tools.ietf.org/html/rfc6749#section-4.1.1>
@@ -52,7 +51,7 @@ instance FromJSON ResponseType where
   parseJSON =
     withText "ResponseType" $ \case
       "code" -> pure Code
-      _ -> fail "Unknown response type"
+      _ -> Control.Monad.Fail.fail "Unknown response type"
 
 instance ToJSON ResponseType where
   toJSON Code = "code"
@@ -67,7 +66,7 @@ instance IsList Scopes where
   toList (Scopes scopes) = scopes
 
 instance ToHttpApiData Scopes where
-  toUrlPiece (Scopes scopes) = mconcat . intersperse " " $ toUrlPiece <$> scopes
+  toUrlPiece (Scopes scopes) = T.intercalate " " $ toUrlPiece <$> scopes
 
 instance FromHttpApiData Scopes where
   parseUrlPiece = fmap Scopes . traverse parseUrlPiece . T.words

src/OAuth2/Protect.hs

@@ -1,14 +1,11 @@
-{-# LANGUAGE OverloadedLists #-}
-{-# LANGUAGE TypeFamilies #-}
-
 {-|
 Description : Combinator for adding OAuth2 protection to a Servant API.
 -}
 module OAuth2.Protect where
 
+import "base" Data.Semigroup ((<>))
 import "this" OAuth2.Types
        (AccessToken(AccessToken), TokenType(Bearer), TokenType)
-import "protolude" Protolude
 import "servant" Servant.API
        (FromHttpApiData(parseUrlPiece), Header, ToHttpApiData(toUrlPiece))
 
@@ -40,7 +37,7 @@ instance FromHttpApiData Authorization where
       ["Bearer", token] ->
         Right
           Authorization
-          { authorizationAccessToken = AccessToken $ toS token
+          { authorizationAccessToken = AccessToken token
           , authorizationTokenType = Bearer
           }
       _ -> Left "Invalid authorization string"

src/OAuth2/Token.hs

@@ -1,6 +1,4 @@
 {-# LANGUAGE OverloadedLists #-}
-{-# LANGUAGE TypeFamilies #-}
-
 {-|
 Description : Token endpoint of an OAuth2 provider.
 -}
@@ -9,17 +7,17 @@ module OAuth2.Token where
 import "aeson" Data.Aeson
        (FromJSON(parseJSON), ToJSON(toJSON), (.:), (.:?), (.=), object,
         withObject)
-import qualified "jose-jwt" Jose.Jwt
 import "this" OAuth2.Types
        (AccessToken, AuthorizationCode, ClientId, ClientSecret,
         ExpirationTime, GrantType, RedirectURI, RefreshToken, TokenType)
-import "protolude" Protolude
 import "servant" Servant.API
        ((:>), FormUrlEncoded, JSON, Post, ReqBody,
         ToHttpApiData(toQueryParam))
 import "http-api-data" Web.FormUrlEncoded
        (FromForm(fromForm), ToForm(toForm), parseUnique)
 
+import qualified "jose-jwt" Jose.Jwt
+
 -- | Specification of the /token endpoint
 --
 --   <https://tools.ietf.org/html/rfc6749#section-4.1.3>

src/OAuth2/Types.hs

@@ -1,6 +1,3 @@
-{-# LANGUAGE OverloadedLists #-}
-{-# LANGUAGE TypeFamilies #-}
-
 {-|
 Description : Types shared by OAuth2 modules.
 -}
@@ -9,11 +6,14 @@ module OAuth2.Types where
 import "base" Control.Monad (fail)
 import "aeson" Data.Aeson
        (FromJSON(parseJSON), ToJSON(toJSON), withText)
-import "cereal" Data.Serialize
-import "text" Data.Text (pack)
+import "cereal" Data.Serialize (Serialize(get, put))
+import "base" Data.String (IsString)
+import "text" Data.Text (Text, pack, unpack)
+import "text" Data.Text.Encoding (decodeUtf8, encodeUtf8)
+import "base" GHC.Generics (Generic)
 import "network-uri" Network.URI (URI, parseAbsoluteURI)
-import "protolude" Protolude
-import "servant-server" Servant
+import "http-api-data" Web.HttpApiData
+       (FromHttpApiData(parseUrlPiece), ToHttpApiData(toUrlPiece))
 
 newtype AuthorizationCode =
   AuthorizationCode Text
@@ -47,8 +47,8 @@ instance ToHttpApiData RedirectURI where
 
 instance FromHttpApiData RedirectURI where
   parseUrlPiece =
-    maybeToRight "Not a valid absolute URI" .
-    fmap RedirectURI . parseAbsoluteURI . toS
+    maybe (Left "Not a valid absolute URI") Right .
+    fmap RedirectURI . parseAbsoluteURI . unpack
 
 -- | An OAuth2 access token.
 --

src/OpenIdConnect/Discovery.hs

@@ -1,22 +1,19 @@
-{-# LANGUAGE OverloadedLists #-}
-{-# LANGUAGE TypeFamilies #-}
-
 {-|
 Description : Discovery endpoint of a OpenIDClient provider.
 -}
 module OpenIdConnect.Discovery where
 
 import "base" Control.Monad.Fail (fail)
 import "aeson" Data.Aeson
-       (FromJSON(parseJSON), ToJSON(toJSON), defaultOptions,
-        genericParseJSON, genericToJSON, withText)
-import "aeson-casing" Data.Aeson.Casing (snakeCase)
-import "aeson" Data.Aeson.Types (fieldLabelModifier)
-import "network-uri" Network.URI (URI)
+       (FromJSON(parseJSON), Object, ToJSON(toJSON), Value, (.:), (.=),
+        object, withObject, withText)
+import "aeson" Data.Aeson.Types (Parser)
+import "base" Data.Semigroup ((<>))
+import "text" Data.Text (Text, unpack)
+import "base" GHC.Generics (Generic)
+import "network-uri" Network.URI (URI, parseURI)
 import "this" OAuth2.Authorize (ResponseType)
-import "protolude" Protolude
 import "servant" Servant.API ((:>), Get, JSON)
-import "servant-auth-server" Servant.Auth.Server () -- TODO: Get rid of this import (it provides a FromJSON URI orphan instance).
 
 type API
    = ".well-known"
@@ -40,10 +37,71 @@ data Response = Response
   } deriving (Show, Generic)
 
 instance FromJSON Response where
-  parseJSON = genericParseJSON defaultOptions {fieldLabelModifier = snakeCase}
+  parseJSON =
+    withObject "Response" $ \v -> do
+      issuer <- parseURI' v "issuer"
+      authorizationEndpoint <- parseURI' v "authorization_endpoint"
+      tokenEndpoint <- parseURI' v "token_endpoint"
+      userinfoEndpoint <- parseURI' v "userinfo_endpoint"
+      jwksUri <- parseURI' v "jwks_uri"
+      scopesSupported <- v .: "scopes_supported"
+      responseTypesSupported <- v .: "response_types_supported"
+      responseModesSupported <- v .: "response_modes_supported"
+      tokenEndpointAuthMethodsSupported <-
+        v .: "token_endpoint_auth_methods_supported"
+      subjectTypesSupported <- v .: "subject_types_supported"
+      claimTypesSupported <- v .: "claim_types_supported"
+      claimsSupported <- v .: "claims_supported"
+      idTokenSigningAlgValuesSupported <-
+        v .: "id_token_signing_alg_values_supported"
+      pure
+        Response
+        { issuer
+        , authorizationEndpoint
+        , tokenEndpoint
+        , userinfoEndpoint
+        , jwksUri
+        , scopesSupported
+        , responseTypesSupported
+        , responseModesSupported
+        , tokenEndpointAuthMethodsSupported
+        , subjectTypesSupported
+        , claimTypesSupported
+        , claimsSupported
+        , idTokenSigningAlgValuesSupported
+        }
+    where
+      parseURI' :: Object -> Text -> Parser URI
+      parseURI' obj x = do
+        str <- obj .: x
+        case parseURI str of
+          Just uri -> pure uri
+          Nothing ->
+            Control.Monad.Fail.fail
+              (unpack $ "Could not parse URI for field `" <> x <> "`")
 
 instance ToJSON Response where
-  toJSON = genericToJSON defaultOptions {fieldLabelModifier = snakeCase}
+  toJSON response =
+    object
+      [ fromURI "issuer" (issuer response)
+      , fromURI "authorization_endpoint" (authorizationEndpoint response)
+      , fromURI "token_endpoint" (tokenEndpoint response)
+      , fromURI "userinfo_endpoint" (userinfoEndpoint response)
+      , fromURI "jwks_uri" (jwksUri response)
+      , "scopes_supported" .= scopesSupported response
+      , "response_types_supported" .= responseTypesSupported response
+      , "response_modes_supported" .= responseModesSupported response
+      , "token_endpoint_auth_methods_supported" .=
+        tokenEndpointAuthMethodsSupported response
+      , "subject_types_supported" .= subjectTypesSupported response
+      , "claim_types_supported" .= claimTypesSupported response
+      , "claims_supported" .= claimsSupported response
+      , "id_token_signing_alg_values_supported" .=
+        idTokenSigningAlgValuesSupported response
+      ]
+    where
+      fromURI :: Text -> URI -> (Text, Value)
+      fromURI x uri = (x, toJSON $ show uri)
 
 data ResponseMode =
   Query
@@ -53,7 +111,7 @@ instance FromJSON ResponseMode where
   parseJSON =
     withText "ResponseMode" $ \case
       "query" -> pure Query
-      _ -> fail "Unknown response mode"
+      _ -> Control.Monad.Fail.fail "Unknown response mode"
 
 instance ToJSON ResponseMode where
   toJSON Query = "query"
@@ -66,7 +124,7 @@ instance FromJSON TokenEndpointAuthMethod where
   parseJSON =
     withText "TokenEndpointAuthMethod" $ \case
       "client_secret_basic" -> pure ClientSecretBasic
-      _ -> fail "Unknown token endpoint auth method"
+      _ -> Control.Monad.Fail.fail "Unknown token endpoint auth method"
 
 instance ToJSON TokenEndpointAuthMethod where
   toJSON ClientSecretBasic = "client_secret_basic"
@@ -79,7 +137,7 @@ instance FromJSON SubjectType where
   parseJSON =
     withText "SubjectType" $ \case
       "public" -> pure Public
-      _ -> fail "Unknown subject type"
+      _ -> Control.Monad.Fail.fail "Unknown subject type"
 
 instance ToJSON SubjectType where
   toJSON Public = "public"
@@ -92,7 +150,7 @@ instance FromJSON ClaimType where
   parseJSON =
     withText "ClaimType" $ \case
       "normal" -> pure Normal
-      _ -> fail "Unknown claim type"
+      _ -> Control.Monad.Fail.fail "Unknown claim type"
 
 instance ToJSON ClaimType where
   toJSON Normal = "normal"
@@ -132,7 +190,7 @@ instance FromJSON IdTokenSigningAlgValue where
   parseJSON =
     withText "IdTokenSigningAlgValue" $ \case
       "RS256" -> pure RS256
-      _ -> fail "Unknown signing algorithm"
+      _ -> Control.Monad.Fail.fail "Unknown signing algorithm"
 
 instance ToJSON IdTokenSigningAlgValue where
   toJSON RS256 = "RS256"

src/OpenIdConnect/Keys.hs

@@ -1,14 +1,11 @@
-{-# LANGUAGE OverloadedLists #-}
-{-# LANGUAGE TypeFamilies #-}
-
 {-|
 Description : keys endpoint of a OpenID Connect provider.
 -}
 module OpenIdConnect.Keys where
 
 import "aeson" Data.Aeson (FromJSON, ToJSON)
+import "base" GHC.Generics (Generic)
 import "jose-jwt" Jose.Jwk (Jwk)
-import "protolude" Protolude
 import "servant" Servant.API (Get, JSON)
 
 type API = Get '[ JSON] Response

stack.yaml

@@ -2,7 +2,5 @@ flags: {}
 extra-package-dbs: []
 packages:
   - .
-extra-deps:
-  - servant-auth-0.3.2.0
-  - servant-auth-server-0.3.1.0
+extra-deps: []
 resolver: lts-10.4