yesod-auth-oauth2/URI/ByteString/Extension.hs
patrick brisbin 937ad572a3 Update to LTS-9.5 and hoauth2 1.3.0
The largest changes were around the hoauth2 interface:

The OAuth2 type replaced all of its ByteString fields with either Text
or URI. This is a huge improvement. The fields that are now Text are the
type we had them in anyway. The fields that are now URI are type safe
and easier to manipulate. For example, we were doing very unsafe query
string manipulations looking for raw ? or & values, but now we can work
with tuples in a well-typed property.

Additionally the AccessToken type was upgraded to OAuth2Token with an
accessToken field, and the simple Either ByteString a results were
replaced by a real OAuth2Error type. This required changes to our
InvalidProfileResponse mechanism to support.

To make working with uri-bytestring more convenient, an Extension
library was added with some useful instances and helper functions. This
library may be upstreamed at some point.
2017-10-18 17:21:47 -04:00

54 lines
1.4 KiB
Haskell

{-# LANGUAGE FlexibleInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module URI.ByteString.Extension where
import Data.ByteString (ByteString)
import Data.String (IsString(..))
import Data.Text (Text)
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import Lens.Micro
import qualified Data.ByteString.Char8 as C8
import URI.ByteString
instance IsString Scheme where
fromString = Scheme . fromString
instance IsString Host where
fromString = Host . fromString
instance IsString (URIRef Absolute) where
fromString = either (error . show) id
. parseURI strictURIParserOptions
. C8.pack
instance IsString (URIRef Relative) where
fromString = either (error . show) id
. parseRelativeRef strictURIParserOptions
. C8.pack
fromText :: Text -> Maybe URI
fromText = either (const Nothing) Just
. parseURI strictURIParserOptions
. encodeUtf8
unsafeFromText :: Text -> URI
unsafeFromText = either (error . show) id
. parseURI strictURIParserOptions
. encodeUtf8
toText :: URI -> Text
toText = decodeUtf8 . serializeURIRef'
fromRelative :: Scheme -> Host -> RelativeRef -> URI
fromRelative s h = flip withHost h . toAbsolute s
withHost :: URIRef a -> Host -> URIRef a
withHost u h = u & authorityL %~ maybe
(Just $ Authority Nothing h Nothing)
(\a -> Just $ a & authorityHostL .~ h)
withQuery :: URIRef a -> [(ByteString, ByteString)] -> URIRef a
withQuery u q = u & (queryL . queryPairsL) %~ (++ q)