{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE StrictData                 #-}

module OpenTracing.Types
    ( TraceID(..)
    , IPv4(..)
    , IPv6(..)
    , Port(..)

    , Protocol(..)
    , Addr(..)
    , addrHostName
    , addrPort
    , addrSecure

    , Hex
    , knownHex

    , AsHex(..)
    , hexText
    )
where

import           Control.Lens
import           Data.Aeson                 (ToJSON (..))
import           Data.Aeson.Encoding
import           Data.ByteString.Builder    as B
import qualified Data.IP                    as IP
import           Data.Semigroup             (Semigroup, (<>))
import           Data.Text                  (Text)
import qualified Data.Text                  as Text
import qualified Data.Text.Lazy.Encoding    as E
import qualified Data.Text.Read             as TR
import           Data.Word
import           Network.Socket             (HostName)


data TraceID = TraceID
    { TraceID -> Maybe Word64
traceIdHi :: Maybe Word64
    , TraceID -> Word64
traceIdLo :: Word64
    } deriving (TraceID -> TraceID -> Bool
(TraceID -> TraceID -> Bool)
-> (TraceID -> TraceID -> Bool) -> Eq TraceID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TraceID -> TraceID -> Bool
$c/= :: TraceID -> TraceID -> Bool
== :: TraceID -> TraceID -> Bool
$c== :: TraceID -> TraceID -> Bool
Eq, Eq TraceID
Eq TraceID
-> (TraceID -> TraceID -> Ordering)
-> (TraceID -> TraceID -> Bool)
-> (TraceID -> TraceID -> Bool)
-> (TraceID -> TraceID -> Bool)
-> (TraceID -> TraceID -> Bool)
-> (TraceID -> TraceID -> TraceID)
-> (TraceID -> TraceID -> TraceID)
-> Ord TraceID
TraceID -> TraceID -> Bool
TraceID -> TraceID -> Ordering
TraceID -> TraceID -> TraceID
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TraceID -> TraceID -> TraceID
$cmin :: TraceID -> TraceID -> TraceID
max :: TraceID -> TraceID -> TraceID
$cmax :: TraceID -> TraceID -> TraceID
>= :: TraceID -> TraceID -> Bool
$c>= :: TraceID -> TraceID -> Bool
> :: TraceID -> TraceID -> Bool
$c> :: TraceID -> TraceID -> Bool
<= :: TraceID -> TraceID -> Bool
$c<= :: TraceID -> TraceID -> Bool
< :: TraceID -> TraceID -> Bool
$c< :: TraceID -> TraceID -> Bool
compare :: TraceID -> TraceID -> Ordering
$ccompare :: TraceID -> TraceID -> Ordering
$cp1Ord :: Eq TraceID
Ord, Int -> TraceID -> ShowS
[TraceID] -> ShowS
TraceID -> String
(Int -> TraceID -> ShowS)
-> (TraceID -> String) -> ([TraceID] -> ShowS) -> Show TraceID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TraceID] -> ShowS
$cshowList :: [TraceID] -> ShowS
show :: TraceID -> String
$cshow :: TraceID -> String
showsPrec :: Int -> TraceID -> ShowS
$cshowsPrec :: Int -> TraceID -> ShowS
Show)


newtype IPv4 = IPv4 { IPv4 -> IPv4
fromIPv4 :: IP.IPv4 }
    deriving (IPv4
IPv4 -> IPv4 -> Bounded IPv4
forall a. a -> a -> Bounded a
maxBound :: IPv4
$cmaxBound :: IPv4
minBound :: IPv4
$cminBound :: IPv4
Bounded, Int -> IPv4
IPv4 -> Int
IPv4 -> [IPv4]
IPv4 -> IPv4
IPv4 -> IPv4 -> [IPv4]
IPv4 -> IPv4 -> IPv4 -> [IPv4]
(IPv4 -> IPv4)
-> (IPv4 -> IPv4)
-> (Int -> IPv4)
-> (IPv4 -> Int)
-> (IPv4 -> [IPv4])
-> (IPv4 -> IPv4 -> [IPv4])
-> (IPv4 -> IPv4 -> [IPv4])
-> (IPv4 -> IPv4 -> IPv4 -> [IPv4])
-> Enum IPv4
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: IPv4 -> IPv4 -> IPv4 -> [IPv4]
$cenumFromThenTo :: IPv4 -> IPv4 -> IPv4 -> [IPv4]
enumFromTo :: IPv4 -> IPv4 -> [IPv4]
$cenumFromTo :: IPv4 -> IPv4 -> [IPv4]
enumFromThen :: IPv4 -> IPv4 -> [IPv4]
$cenumFromThen :: IPv4 -> IPv4 -> [IPv4]
enumFrom :: IPv4 -> [IPv4]
$cenumFrom :: IPv4 -> [IPv4]
fromEnum :: IPv4 -> Int
$cfromEnum :: IPv4 -> Int
toEnum :: Int -> IPv4
$ctoEnum :: Int -> IPv4
pred :: IPv4 -> IPv4
$cpred :: IPv4 -> IPv4
succ :: IPv4 -> IPv4
$csucc :: IPv4 -> IPv4
Enum, IPv4 -> IPv4 -> Bool
(IPv4 -> IPv4 -> Bool) -> (IPv4 -> IPv4 -> Bool) -> Eq IPv4
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IPv4 -> IPv4 -> Bool
$c/= :: IPv4 -> IPv4 -> Bool
== :: IPv4 -> IPv4 -> Bool
$c== :: IPv4 -> IPv4 -> Bool
Eq, Eq IPv4
Eq IPv4
-> (IPv4 -> IPv4 -> Ordering)
-> (IPv4 -> IPv4 -> Bool)
-> (IPv4 -> IPv4 -> Bool)
-> (IPv4 -> IPv4 -> Bool)
-> (IPv4 -> IPv4 -> Bool)
-> (IPv4 -> IPv4 -> IPv4)
-> (IPv4 -> IPv4 -> IPv4)
-> Ord IPv4
IPv4 -> IPv4 -> Bool
IPv4 -> IPv4 -> Ordering
IPv4 -> IPv4 -> IPv4
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: IPv4 -> IPv4 -> IPv4
$cmin :: IPv4 -> IPv4 -> IPv4
max :: IPv4 -> IPv4 -> IPv4
$cmax :: IPv4 -> IPv4 -> IPv4
>= :: IPv4 -> IPv4 -> Bool
$c>= :: IPv4 -> IPv4 -> Bool
> :: IPv4 -> IPv4 -> Bool
$c> :: IPv4 -> IPv4 -> Bool
<= :: IPv4 -> IPv4 -> Bool
$c<= :: IPv4 -> IPv4 -> Bool
< :: IPv4 -> IPv4 -> Bool
$c< :: IPv4 -> IPv4 -> Bool
compare :: IPv4 -> IPv4 -> Ordering
$ccompare :: IPv4 -> IPv4 -> Ordering
$cp1Ord :: Eq IPv4
Ord)

newtype IPv6 = IPv6 { IPv6 -> IPv6
fromIPv6 :: IP.IPv6 }
    deriving (IPv6
IPv6 -> IPv6 -> Bounded IPv6
forall a. a -> a -> Bounded a
maxBound :: IPv6
$cmaxBound :: IPv6
minBound :: IPv6
$cminBound :: IPv6
Bounded, Int -> IPv6
IPv6 -> Int
IPv6 -> [IPv6]
IPv6 -> IPv6
IPv6 -> IPv6 -> [IPv6]
IPv6 -> IPv6 -> IPv6 -> [IPv6]
(IPv6 -> IPv6)
-> (IPv6 -> IPv6)
-> (Int -> IPv6)
-> (IPv6 -> Int)
-> (IPv6 -> [IPv6])
-> (IPv6 -> IPv6 -> [IPv6])
-> (IPv6 -> IPv6 -> [IPv6])
-> (IPv6 -> IPv6 -> IPv6 -> [IPv6])
-> Enum IPv6
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: IPv6 -> IPv6 -> IPv6 -> [IPv6]
$cenumFromThenTo :: IPv6 -> IPv6 -> IPv6 -> [IPv6]
enumFromTo :: IPv6 -> IPv6 -> [IPv6]
$cenumFromTo :: IPv6 -> IPv6 -> [IPv6]
enumFromThen :: IPv6 -> IPv6 -> [IPv6]
$cenumFromThen :: IPv6 -> IPv6 -> [IPv6]
enumFrom :: IPv6 -> [IPv6]
$cenumFrom :: IPv6 -> [IPv6]
fromEnum :: IPv6 -> Int
$cfromEnum :: IPv6 -> Int
toEnum :: Int -> IPv6
$ctoEnum :: Int -> IPv6
pred :: IPv6 -> IPv6
$cpred :: IPv6 -> IPv6
succ :: IPv6 -> IPv6
$csucc :: IPv6 -> IPv6
Enum, IPv6 -> IPv6 -> Bool
(IPv6 -> IPv6 -> Bool) -> (IPv6 -> IPv6 -> Bool) -> Eq IPv6
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IPv6 -> IPv6 -> Bool
$c/= :: IPv6 -> IPv6 -> Bool
== :: IPv6 -> IPv6 -> Bool
$c== :: IPv6 -> IPv6 -> Bool
Eq, Eq IPv6
Eq IPv6
-> (IPv6 -> IPv6 -> Ordering)
-> (IPv6 -> IPv6 -> Bool)
-> (IPv6 -> IPv6 -> Bool)
-> (IPv6 -> IPv6 -> Bool)
-> (IPv6 -> IPv6 -> Bool)
-> (IPv6 -> IPv6 -> IPv6)
-> (IPv6 -> IPv6 -> IPv6)
-> Ord IPv6
IPv6 -> IPv6 -> Bool
IPv6 -> IPv6 -> Ordering
IPv6 -> IPv6 -> IPv6
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: IPv6 -> IPv6 -> IPv6
$cmin :: IPv6 -> IPv6 -> IPv6
max :: IPv6 -> IPv6 -> IPv6
$cmax :: IPv6 -> IPv6 -> IPv6
>= :: IPv6 -> IPv6 -> Bool
$c>= :: IPv6 -> IPv6 -> Bool
> :: IPv6 -> IPv6 -> Bool
$c> :: IPv6 -> IPv6 -> Bool
<= :: IPv6 -> IPv6 -> Bool
$c<= :: IPv6 -> IPv6 -> Bool
< :: IPv6 -> IPv6 -> Bool
$c< :: IPv6 -> IPv6 -> Bool
compare :: IPv6 -> IPv6 -> Ordering
$ccompare :: IPv6 -> IPv6 -> Ordering
$cp1Ord :: Eq IPv6
Ord)

instance Show IPv4 where show :: IPv4 -> String
show = IPv4 -> String
forall a. Show a => a -> String
show (IPv4 -> String) -> (IPv4 -> IPv4) -> IPv4 -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv4 -> IPv4
fromIPv4
instance Show IPv6 where show :: IPv6 -> String
show = IPv6 -> String
forall a. Show a => a -> String
show (IPv6 -> String) -> (IPv6 -> IPv6) -> IPv6 -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv6 -> IPv6
fromIPv6

instance Read IPv4 where readsPrec :: Int -> ReadS IPv4
readsPrec Int
p = ((IPv4, String) -> (IPv4, String))
-> [(IPv4, String)] -> [(IPv4, String)]
forall a b. (a -> b) -> [a] -> [b]
map (ASetter (IPv4, String) (IPv4, String) IPv4 IPv4
-> (IPv4 -> IPv4) -> (IPv4, String) -> (IPv4, String)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (IPv4, String) (IPv4, String) IPv4 IPv4
forall s t a b. Field1 s t a b => Lens s t a b
_1 IPv4 -> IPv4
IPv4) ([(IPv4, String)] -> [(IPv4, String)])
-> (String -> [(IPv4, String)]) -> ReadS IPv4
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(IPv4, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
p
instance Read IPv6 where readsPrec :: Int -> ReadS IPv6
readsPrec Int
p = ((IPv6, String) -> (IPv6, String))
-> [(IPv6, String)] -> [(IPv6, String)]
forall a b. (a -> b) -> [a] -> [b]
map (ASetter (IPv6, String) (IPv6, String) IPv6 IPv6
-> (IPv6 -> IPv6) -> (IPv6, String) -> (IPv6, String)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (IPv6, String) (IPv6, String) IPv6 IPv6
forall s t a b. Field1 s t a b => Lens s t a b
_1 IPv6 -> IPv6
IPv6) ([(IPv6, String)] -> [(IPv6, String)])
-> (String -> [(IPv6, String)]) -> ReadS IPv6
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(IPv6, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
p

instance ToJSON IPv4 where
    toJSON :: IPv4 -> Value
toJSON     = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String -> Value) -> (IPv4 -> String) -> IPv4 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv4 -> String
forall a. Show a => a -> String
show (IPv4 -> String) -> (IPv4 -> IPv4) -> IPv4 -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv4 -> IPv4
fromIPv4
    toEncoding :: IPv4 -> Encoding
toEncoding = String -> Encoding
forall a. String -> Encoding' a
string (String -> Encoding) -> (IPv4 -> String) -> IPv4 -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv4 -> String
forall a. Show a => a -> String
show (IPv4 -> String) -> (IPv4 -> IPv4) -> IPv4 -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv4 -> IPv4
fromIPv4

instance ToJSON IPv6 where
    toJSON :: IPv6 -> Value
toJSON     = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String -> Value) -> (IPv6 -> String) -> IPv6 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv6 -> String
forall a. Show a => a -> String
show (IPv6 -> String) -> (IPv6 -> IPv6) -> IPv6 -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv6 -> IPv6
fromIPv6
    toEncoding :: IPv6 -> Encoding
toEncoding = String -> Encoding
forall a. String -> Encoding' a
string (String -> Encoding) -> (IPv6 -> String) -> IPv6 -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv6 -> String
forall a. Show a => a -> String
show (IPv6 -> String) -> (IPv6 -> IPv6) -> IPv6 -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv6 -> IPv6
fromIPv6


newtype Port = Port { Port -> Word16
fromPort :: Word16 }
    deriving (Int -> Port
Port -> Int
Port -> [Port]
Port -> Port
Port -> Port -> [Port]
Port -> Port -> Port -> [Port]
(Port -> Port)
-> (Port -> Port)
-> (Int -> Port)
-> (Port -> Int)
-> (Port -> [Port])
-> (Port -> Port -> [Port])
-> (Port -> Port -> [Port])
-> (Port -> Port -> Port -> [Port])
-> Enum Port
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Port -> Port -> Port -> [Port]
$cenumFromThenTo :: Port -> Port -> Port -> [Port]
enumFromTo :: Port -> Port -> [Port]
$cenumFromTo :: Port -> Port -> [Port]
enumFromThen :: Port -> Port -> [Port]
$cenumFromThen :: Port -> Port -> [Port]
enumFrom :: Port -> [Port]
$cenumFrom :: Port -> [Port]
fromEnum :: Port -> Int
$cfromEnum :: Port -> Int
toEnum :: Int -> Port
$ctoEnum :: Int -> Port
pred :: Port -> Port
$cpred :: Port -> Port
succ :: Port -> Port
$csucc :: Port -> Port
Enum, Port -> Port -> Bool
(Port -> Port -> Bool) -> (Port -> Port -> Bool) -> Eq Port
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Port -> Port -> Bool
$c/= :: Port -> Port -> Bool
== :: Port -> Port -> Bool
$c== :: Port -> Port -> Bool
Eq, Integer -> Port
Port -> Port
Port -> Port -> Port
(Port -> Port -> Port)
-> (Port -> Port -> Port)
-> (Port -> Port -> Port)
-> (Port -> Port)
-> (Port -> Port)
-> (Port -> Port)
-> (Integer -> Port)
-> Num Port
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Port
$cfromInteger :: Integer -> Port
signum :: Port -> Port
$csignum :: Port -> Port
abs :: Port -> Port
$cabs :: Port -> Port
negate :: Port -> Port
$cnegate :: Port -> Port
* :: Port -> Port -> Port
$c* :: Port -> Port -> Port
- :: Port -> Port -> Port
$c- :: Port -> Port -> Port
+ :: Port -> Port -> Port
$c+ :: Port -> Port -> Port
Num, Eq Port
Eq Port
-> (Port -> Port -> Ordering)
-> (Port -> Port -> Bool)
-> (Port -> Port -> Bool)
-> (Port -> Port -> Bool)
-> (Port -> Port -> Bool)
-> (Port -> Port -> Port)
-> (Port -> Port -> Port)
-> Ord Port
Port -> Port -> Bool
Port -> Port -> Ordering
Port -> Port -> Port
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Port -> Port -> Port
$cmin :: Port -> Port -> Port
max :: Port -> Port -> Port
$cmax :: Port -> Port -> Port
>= :: Port -> Port -> Bool
$c>= :: Port -> Port -> Bool
> :: Port -> Port -> Bool
$c> :: Port -> Port -> Bool
<= :: Port -> Port -> Bool
$c<= :: Port -> Port -> Bool
< :: Port -> Port -> Bool
$c< :: Port -> Port -> Bool
compare :: Port -> Port -> Ordering
$ccompare :: Port -> Port -> Ordering
$cp1Ord :: Eq Port
Ord)

instance Show Port where show :: Port -> String
show = Word16 -> String
forall a. Show a => a -> String
show (Word16 -> String) -> (Port -> Word16) -> Port -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Port -> Word16
fromPort
instance Read Port where readsPrec :: Int -> ReadS Port
readsPrec Int
p = ((Word16, String) -> (Port, String))
-> [(Word16, String)] -> [(Port, String)]
forall a b. (a -> b) -> [a] -> [b]
map (ASetter (Word16, String) (Port, String) Word16 Port
-> (Word16 -> Port) -> (Word16, String) -> (Port, String)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (Word16, String) (Port, String) Word16 Port
forall s t a b. Field1 s t a b => Lens s t a b
_1 Word16 -> Port
Port) ([(Word16, String)] -> [(Port, String)])
-> (String -> [(Word16, String)]) -> ReadS Port
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(Word16, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
p

instance ToJSON Port where
    toJSON :: Port -> Value
toJSON     = Word16 -> Value
forall a. ToJSON a => a -> Value
toJSON (Word16 -> Value) -> (Port -> Word16) -> Port -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Port -> Word16
fromPort
    toEncoding :: Port -> Encoding
toEncoding = Word16 -> Encoding
word16 (Word16 -> Encoding) -> (Port -> Word16) -> Port -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Port -> Word16
fromPort


data Protocol = UDP | HTTP

data Addr a where
    UDPAddr  :: HostName -> Port         -> Addr 'UDP
    HTTPAddr :: HostName -> Port -> Bool -> Addr 'HTTP

addrHostName :: Lens' (Addr a) HostName
addrHostName :: (String -> f String) -> Addr a -> f (Addr a)
addrHostName String -> f String
f (UDPAddr  String
h Port
p  ) = (\String
h' -> String -> Port -> Addr 'UDP
UDPAddr  String
h' Port
p  ) (String -> Addr 'UDP) -> f String -> f (Addr 'UDP)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> f String
f String
h
addrHostName String -> f String
f (HTTPAddr String
h Port
p Bool
s) = (\String
h' -> String -> Port -> Bool -> Addr 'HTTP
HTTPAddr String
h' Port
p Bool
s) (String -> Addr 'HTTP) -> f String -> f (Addr 'HTTP)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> f String
f String
h

addrPort :: Lens' (Addr a) Port
addrPort :: (Port -> f Port) -> Addr a -> f (Addr a)
addrPort Port -> f Port
f (UDPAddr  String
h Port
p  ) = (\Port
p' -> String -> Port -> Addr 'UDP
UDPAddr  String
h Port
p'  ) (Port -> Addr 'UDP) -> f Port -> f (Addr 'UDP)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Port -> f Port
f Port
p
addrPort Port -> f Port
f (HTTPAddr String
h Port
p Bool
s) = (\Port
p' -> String -> Port -> Bool -> Addr 'HTTP
HTTPAddr String
h Port
p' Bool
s) (Port -> Addr 'HTTP) -> f Port -> f (Addr 'HTTP)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Port -> f Port
f Port
p

addrSecure :: Lens' (Addr 'HTTP) Bool
addrSecure :: (Bool -> f Bool) -> Addr 'HTTP -> f (Addr 'HTTP)
addrSecure Bool -> f Bool
f (HTTPAddr String
h Port
p Bool
s) = (\Bool
s' -> String -> Port -> Bool -> Addr 'HTTP
HTTPAddr String
h Port
p Bool
s') (Bool -> Addr 'HTTP) -> f Bool -> f (Addr 'HTTP)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> f Bool
f Bool
s


newtype Hex = Hex { Hex -> Text
unHex :: Text }
    deriving (Hex -> Hex -> Bool
(Hex -> Hex -> Bool) -> (Hex -> Hex -> Bool) -> Eq Hex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Hex -> Hex -> Bool
$c/= :: Hex -> Hex -> Bool
== :: Hex -> Hex -> Bool
$c== :: Hex -> Hex -> Bool
Eq, Int -> Hex -> ShowS
[Hex] -> ShowS
Hex -> String
(Int -> Hex -> ShowS)
-> (Hex -> String) -> ([Hex] -> ShowS) -> Show Hex
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Hex] -> ShowS
$cshowList :: [Hex] -> ShowS
show :: Hex -> String
$cshow :: Hex -> String
showsPrec :: Int -> Hex -> ShowS
$cshowsPrec :: Int -> Hex -> ShowS
Show, Semigroup Hex
Hex
Semigroup Hex
-> Hex -> (Hex -> Hex -> Hex) -> ([Hex] -> Hex) -> Monoid Hex
[Hex] -> Hex
Hex -> Hex -> Hex
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Hex] -> Hex
$cmconcat :: [Hex] -> Hex
mappend :: Hex -> Hex -> Hex
$cmappend :: Hex -> Hex -> Hex
mempty :: Hex
$cmempty :: Hex
$cp1Monoid :: Semigroup Hex
Monoid, b -> Hex -> Hex
NonEmpty Hex -> Hex
Hex -> Hex -> Hex
(Hex -> Hex -> Hex)
-> (NonEmpty Hex -> Hex)
-> (forall b. Integral b => b -> Hex -> Hex)
-> Semigroup Hex
forall b. Integral b => b -> Hex -> Hex
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Hex -> Hex
$cstimes :: forall b. Integral b => b -> Hex -> Hex
sconcat :: NonEmpty Hex -> Hex
$csconcat :: NonEmpty Hex -> Hex
<> :: Hex -> Hex -> Hex
$c<> :: Hex -> Hex -> Hex
Semigroup)

knownHex :: Text -> Hex
knownHex :: Text -> Hex
knownHex = Text -> Hex
Hex

class AsHex a where
    _Hex :: Prism' Hex a

instance AsHex TraceID where
    _Hex :: p TraceID (f TraceID) -> p Hex (f Hex)
_Hex = (TraceID -> Hex) -> (Hex -> Maybe TraceID) -> Prism' Hex TraceID
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' TraceID -> Hex
enc Hex -> Maybe TraceID
dec
      where
        enc :: TraceID -> Hex
enc (TraceID Maybe Word64
hi Word64
lo)
            = Text -> Hex
Hex (Text -> Hex) -> (Hex -> Text) -> Hex -> Hex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hex -> Text
unHex (Hex -> Hex) -> Hex -> Hex
forall a b. (a -> b) -> a -> b
$ Hex -> (Word64 -> Hex) -> Maybe Word64 -> Hex
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Hex
forall a. Monoid a => a
mempty (AReview Hex Word64 -> Word64 -> Hex
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview Hex Word64
forall a. AsHex a => Prism' Hex a
_Hex) Maybe Word64
hi Hex -> Hex -> Hex
forall a. Semigroup a => a -> a -> a
<> AReview Hex Word64 -> Word64 -> Hex
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview Hex Word64
forall a. AsHex a => Prism' Hex a
_Hex Word64
lo

        dec :: Hex -> Maybe TraceID
dec (Hex Text
t)
            = case Int -> Text -> (Text, Text)
Text.splitAt Int
16 Text
t of
                  (Text
"", Text
lo) -> Maybe Word64 -> Word64 -> TraceID
TraceID Maybe Word64
forall a. Maybe a
Nothing (Word64 -> TraceID) -> Maybe Word64 -> Maybe TraceID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (First Word64) Hex Word64 -> Hex -> Maybe Word64
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First Word64) Hex Word64
forall a. AsHex a => Prism' Hex a
_Hex (Text -> Hex
Hex Text
lo)
                  (Text
hi, Text
lo) -> Maybe Word64 -> Word64 -> TraceID
TraceID (Maybe Word64 -> Word64 -> TraceID)
-> Maybe (Maybe Word64) -> Maybe (Word64 -> TraceID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Word64 -> Maybe (Maybe Word64)
forall a. a -> Maybe a
Just (Getting (First Word64) Hex Word64 -> Hex -> Maybe Word64
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First Word64) Hex Word64
forall a. AsHex a => Prism' Hex a
_Hex (Text -> Hex
Hex Text
hi))
                                      Maybe (Word64 -> TraceID) -> Maybe Word64 -> Maybe TraceID
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Getting (First Word64) Hex Word64 -> Hex -> Maybe Word64
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First Word64) Hex Word64
forall a. AsHex a => Prism' Hex a
_Hex (Text -> Hex
Hex Text
lo)
    {-# INLINE _Hex #-}

instance AsHex Word64 where
    _Hex :: p Word64 (f Word64) -> p Hex (f Hex)
_Hex = (Word64 -> Hex) -> (Hex -> Maybe Word64) -> Prism' Hex Word64
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' Word64 -> Hex
enc Hex -> Maybe Word64
dec
      where
        enc :: Word64 -> Hex
enc = Text -> Hex
Hex (Text -> Hex) -> (Word64 -> Text) -> Word64 -> Hex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Text Text Text -> Text -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text Text Text
forall lazy strict. Strict lazy strict => Iso' lazy strict
strict (Text -> Text) -> (Word64 -> Text) -> Word64 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
E.decodeUtf8 (ByteString -> Text) -> (Word64 -> ByteString) -> Word64 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
B.toLazyByteString (Builder -> ByteString)
-> (Word64 -> Builder) -> Word64 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Builder
B.word64HexFixed
        dec :: Hex -> Maybe Word64
dec = (String -> Maybe Word64)
-> ((Word64, Text) -> Maybe Word64)
-> Either String (Word64, Text)
-> Maybe Word64
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Word64 -> String -> Maybe Word64
forall a b. a -> b -> a
const Maybe Word64
forall a. Maybe a
Nothing) (Word64 -> Maybe Word64
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64 -> Maybe Word64)
-> ((Word64, Text) -> Word64) -> (Word64, Text) -> Maybe Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64, Text) -> Word64
forall a b. (a, b) -> a
fst) (Either String (Word64, Text) -> Maybe Word64)
-> (Hex -> Either String (Word64, Text)) -> Hex -> Maybe Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reader Word64
forall a. Integral a => Reader a
TR.hexadecimal Reader Word64
-> (Hex -> Text) -> Hex -> Either String (Word64, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hex -> Text
unHex
    {-# INLINE _Hex #-}

hexText :: AsHex a => Getter a Text
hexText :: Getter a Text
hexText = AReview Hex a -> Getter a Hex
forall t b. AReview t b -> Getter b t
re AReview Hex a
forall a. AsHex a => Prism' Hex a
_Hex ((Hex -> f Hex) -> a -> f a)
-> ((Text -> f Text) -> Hex -> f Hex)
-> (Text -> f Text)
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Hex -> Text) -> (Text -> f Text) -> Hex -> f Hex
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Hex -> Text
unHex
{-# INLINE hexText #-}