ToJSON support for Origin

fumieval · Oct 29, 2020 · 00cfeda · 00cfeda
1 parent d10b744
commit 00cfeda
Show file tree

Hide file tree

Showing 2 changed files with 8 additions and 4 deletions.
diff --git a/src/Web/WebAuthn.hs b/src/Web/WebAuthn.hs
@@ -38,7 +38,6 @@ import qualified Data.Map as Map
 import Data.Text (Text)
 import Crypto.Random
 import Crypto.Hash
-import Crypto.Hash.Algorithms (SHA256(..))
 import qualified Codec.CBOR.Term as CBOR
 import qualified Codec.CBOR.Read as CBOR
 import qualified Codec.CBOR.Decoding as CBOR

diff --git a/src/Web/WebAuthn/Types.hs b/src/Web/WebAuthn/Types.hs
@@ -62,8 +62,7 @@ import Control.Monad.Fail ( MonadFail(fail) )
 import GHC.Generics (Generic)
 import qualified Data.X509 as X509
 import Data.Aeson.Types (typeMismatch)
-import Data.Aeson (genericToEncoding)
-import Data.Aeson (defaultOptions)
+import Data.Aeson (genericToEncoding, defaultOptions)
 import Data.Char ( toLower )
 
 newtype Base64ByteString = Base64ByteString { unBase64ByteString :: ByteString } deriving (Generic, Show, Eq)
@@ -125,7 +124,13 @@ data Origin = Origin
   , originHost :: Text
   , originPort :: Maybe Int
   }
-  deriving (Show, Eq, Ord)
+  deriving (Show, Eq, Ord, Generic)
+
+instance ToJSON Origin where
+  toJSON origin = String (originScheme origin <> "://" <> originHost origin <> (port $ originPort origin))
+    where
+      port (Just int) = ":" <> (T.pack $ show int)
+      port Nothing = ""
 
 data RelyingParty = RelyingParty
   { rpOrigin :: Origin