diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,10 @@ # Revision history for odid -## 0.1.0.0 -- YYYY-mm-dd +## 1.0.0.0 -- 9-29-2026 + +* Update Auth record fields, decoding, CLI parsers +* Improve CLI & docs + +## 0.1.0.0 -- 9-24-2026 * First version. Released on an unsuspecting world. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # Open Drone ID -ASTM F3411-22a +[ASTM F3411-22a](https://store.astm.org/f3411-22a.html) Usage @@ -9,11 +9,18 @@ odid w basic foo | odid r ``` -Development +Install ``` +cabal install odid +``` + +[Development](https://www.haskell.org/ghcup/) + +``` cabal build cabal test cabal haddock +cabal run odid -- w basic foo bar.bin cabal install ``` diff --git a/exe/Main.hs b/exe/Main.hs --- a/exe/Main.hs +++ b/exe/Main.hs @@ -11,6 +11,7 @@ import Data.Int import Data.ODID import Data.Version +import Numeric import Options.Applicative import Paths_odid import Prettyprinter @@ -78,7 +79,7 @@ parseUAType :: Parser UAType parseUAType = asum $ map mkFlag [None ..] where - mkFlag None = flag None None $ long "none" + mkFlag None = flag None None $ long "none" <> help "Default UA type" mkFlag GroundObstacle = flag' GroundObstacle $ long "ground-obstacle" mkFlag t = flag' t $ long $ map toLower $ show t @@ -86,15 +87,16 @@ parseUASID = pad 20 <$> strArgument (metavar "UASID") selfIDParser :: Parser Msg -selfIDParser = fmap (Msg $ MsgHdr 2 SelfIDTy) $ - SelfIDBdy <$> option auto (short 't' <> value 0 <> showDefault <> help "Description type") - <*> pad 23 `fmap` strArgument (metavar "DESC" <> help "Description") +selfIDParser = fmap (Msg $ MsgHdr 2 SelfIDTy) $ SelfIDBdy + <$> option auto (short 't' <> value 0 <> showDefault <> metavar "WORD8" <> help "Description type") + <*> pad 23 `fmap` strArgument (metavar "ASCII" <> help "Description") opIDParser :: Parser Msg opIDParser = fmap (Msg $ MsgHdr 2 OperatorID) $ OpIDBdy <$> parseOpIDTy <*> parseOpID <*> parseRsvdBytes where - parseOpIDTy = option auto $ short 't' <> help "Operator ID type" + parseOpIDTy = option auto $ short 't' <> value 0 <> showDefault <> metavar "WORD8" + <> help "Operator ID type" parseOpID = fmap (pad 20) $ strArgument $ metavar "ID" <> help "ASCII text" pad :: Int64 -> String -> ByteString @@ -113,22 +115,26 @@ LocMsg <$> opStatusParser <*> switch (long "flag-rsvd" <> help "Reserved flag") <*> heightTypeParser <*> switch (long "180" <> help "E/W direction segment switch. >=180 active otherwise <180") - <*> speedMultParser <*> option auto (long "track-dir" <> help "Track direction 0-359 deg.") - <*> option auto (long "speed" <> help "Ground speed m/s") - <*> option auto (long "vert-speed" <> help "Vertical speed m/s") + <*> speedMultParser + <*> option auto (long "track-dir" <> value 0 <> showDefault <> help "Track direction 0-359 deg.") + <*> option auto (long "speed" <> value 0 <> showDefault <> help "Ground speed m/s") + <*> option auto (long "vert-speed" <> value 0 <> showDefault <> help "Vertical speed m/s") <*> parseLat <*> parseLon - <*> option auto (long "pres-alt" <> help "Pressure altitude") - <*> option auto (long "geo-alt" <> help "Geodetic altitude") - <*> option auto (long "height") <*> vertAccParser "vert-acc" + <*> option auto (long "pres-alt" <> value 0 <> showDefault <> help "Pressure altitude") + <*> option auto (long "geo-alt" <> value 0 <> showDefault <> help "Geodetic altitude") + <*> option auto (long "height" <> value 0 <> showDefault <> help "Height m") + <*> vertAccParser "vert-acc" <*> horizAccParser <*> vertAccParser "baro-acc" <*> speedAccParser - <*> option auto (long "timestamp") <*> option auto (long "tstamp-acc-rsvd") - <*> option auto (long "tstamp-acc") <*> option auto (long "loc-rsvd") + <*> option auto (long "timestamp" <> value 0 <> showDefault <> help "seconds since last hour 0.1 step") + <*> option auto (long "tstamp-acc-rsvd" <> value 0 <> showDefault <> help "Reserved") + <*> option auto (long "tstamp-acc" <> value 0 <> showDefault <> help "timestamp accuracy 0-1.5 s 0.1 resolution") + <*> option auto (long "loc-rsvd" <> value 0 <> showDefault <> help "Reserved") parseLat :: Parser Double -parseLat = option auto $ long "lat" <> help "Latitude" +parseLat = option auto $ long "lat" <> value 0 <> showDefault <> help "Latitude" parseLon :: Parser Double -parseLon = option auto $ long "lon" <> help "Longitude" +parseLon = option auto $ long "lon" <> value 0 <> showDefault <> help "Longitude" opStatusParser :: Parser OpStatus opStatusParser = asum @@ -151,7 +157,7 @@ vertAccParser :: String -> Parser VertAcc vertAccParser s = asum - [ fmap readAcc $ option auto $ long s <> help "Vertical accuracy m" + [ fmap readAcc $ option auto $ long s <> value 0 <> showDefault <> help "Vertical accuracy m" , fmap VertAccRsvd $ option auto $ long (s ++ "-rsvd") <> help "Reserved low nibble" ] where @@ -167,7 +173,7 @@ horizAccParser :: Parser HorizAcc horizAccParser = asum - [ fmap readAcc $ option auto $ long "horiz-acc" <> help "Horizontal accuracy m" + [ fmap readAcc $ option auto $ long "horiz-acc" <> value 0 <> showDefault <> help "Horizontal accuracy m" , fmap HorizAccRsvd $ option auto $ long "horiz-acc-rsvd" <> help "Horizontal accuracy reserved value" ] @@ -190,7 +196,7 @@ speedAccParser :: Parser SpeedAcc speedAccParser = asum - [ fmap readAcc $ option auto $ long "speed-acc" <> help "Speed accuracy m/s" + [ fmap readAcc $ option auto $ long "speed-acc" <> value 0 <> showDefault <> help "Speed accuracy m/s" , fmap SpeedAccRsvd $ option auto $ long "speed-acc-rsvd" <> help "Reserved speed accuracy low nibble" ] @@ -267,11 +273,25 @@ <> help "Reserved" authParser :: Parser Msg -authParser = fmap (Msg (MsgHdr 2 Auth) . AuthBdy) $ +authParser = fmap (Msg (MsgHdr 2 Auth) . AuthBdy . padSig) $ AuthMsg <$> parseAuthType <*> parsePageNum <*> optional parsePage0 <*> parseSignature where - parseSignature = fmap BS.pack $ some $ argument auto $ metavar "BYTE" <> help "Signature bytes" + parseSignature = option (eitherReader bytes) $ short 's' <> long "sig" <> metavar "BYTES" + <> help "Signature bytes base-16. Example: 0x0123cafe" + padSig a | pageNum a == 0 = a{signature=pad 17 $ BSC.unpack $ signature a} + | otherwise = a{signature=pad 23 $ BSC.unpack $ signature a} +bytes :: String -> Either String ByteString +bytes s = BS.pack <$> case s of + '0':'x':rest -> go rest + _ -> go s + where + go (h:l:rest) = case readHex [h,l] of + [(byte,"")] -> (byte:) <$> go rest + _ -> Left $ "cannot read byte 0x" ++ [h,l] + go [c] = Left $ "cannot read byte 0x" ++ [c] + go [] = Right [] + parseAuthType :: Parser AuthType parseAuthType = asum [ flag AuthNone AuthNone $ long "none" <> help "No auth, default." @@ -285,7 +305,7 @@ ] parsePageNum :: Parser Word8 -parsePageNum = option auto $ long "page-num" <> help "Page number" +parsePageNum = option auto $ long "page-num" <> value 0 <> showDefault <> help "Page number" parsePage0 :: Parser (Word8, Word8, Word32) parsePage0 = (,,) diff --git a/lib/Data/ODID.hs b/lib/Data/ODID.hs --- a/lib/Data/ODID.hs +++ b/lib/Data/ODID.hs @@ -151,7 +151,8 @@ data MsgBdy = BasicIDBdy IDType UAType UASID ByteString | LocBdy LocMsg | AuthBdy AuthMsg | SelfIDBdy Word8 ByteString | SysBdy SysMsg | OpIDBdy Word8 ByteString ByteString - | PackBdy Word8 Word8 [Msg] | RsvdBdy ByteString + | -- | Message size 0x19, num msgs + PackBdy Word8 Word8 [Msg] | RsvdBdy ByteString deriving (Eq, Read, Show) instance Pretty MsgBdy where @@ -164,7 +165,7 @@ SelfIDBdy ty desc -> vsep ["Type:" <+> pretty ty, "Desc:" <+> pretty (BSC.unpack desc)] SysBdy s -> pretty s OpIDBdy t i r -> vsep ["Type:" <+> pretty t, "ID:" <+> pretty (BSC.unpack i) - , "Rsvd:" <+> pretty (BSC.unpack r)] + , "Rsvd:" <+> prettyBytes r] PackBdy sz nm ms -> vsep ["Size=" <> pretty sz <+> "Cnt=" <> pretty nm , indent 2 $ vsep $ pretty <$> ms] RsvdBdy bs -> "Reserved:" <+> prettyBytes bs @@ -185,7 +186,7 @@ IDTypeRsvd r -> "Reserved" <+> pretty r data HorizAcc - = GT10NM -- ^ >=18.52 km (10 NM) or Unknown + = GT10NM -- ^ \>=18.52 km (10 NM) or Unknown | LT10NM -- ^ <18.52 km (10 NM) | LT4NM -- ^ <7.408 km (4 NM) | LT2NM -- ^ <3.704 km (2 NM) @@ -226,7 +227,7 @@ pretty c = viaShow c data VertAcc - = VertAccGTE150M -- ^ >=150 m or Unknown + = VertAccGTE150M -- ^ \>=150 m or Unknown | VertAccLT150M-- ^ <150 m | VertAccLT45M -- ^ <45 m | VertAccLT25M -- ^ <25 m @@ -523,10 +524,10 @@ , "Reserved:" <+> pretty (sysRsvd s) ] -data AuthMsg = AuthMsg AuthType - Word8 -- ^ Page number - (Maybe (Word8, Word8, Word32)) -- ^ PageN last page index, length, timestamp - ByteString -- ^ signature +data AuthMsg = AuthMsg{authType :: AuthType, pageNum :: Word8 + , pageN :: Maybe (Word8, Word8, Word32) -- ^ last page index, length, timestamp + , signature :: ByteString + } deriving (Eq, Read, Show) instance Binary AuthMsg where @@ -547,11 +548,10 @@ AuthMsg ty pge (Just z) <$> getLazyByteString 17 else AuthMsg ty pge Nothing <$> getLazyByteString 23 - put (AuthMsg ty pge (Just (lpi, l, ts)) sig) = do - putWord8 $ writeAuthType ty `shiftL` 4 .|. pge .&. 0xF - putWord8 lpi <> putWord8 l <> putWord32le ts <> putLazyByteString sig - put (AuthMsg ty pge Nothing sig) = do + put (AuthMsg ty pge zM sig) = do putWord8 $ writeAuthType ty `shiftL` 4 .|. pge .&. 0xF + forM_ zM $ \(lpi, l, ts) -> + putWord8 lpi <> putWord8 l <> putWord32le ts putLazyByteString sig instance Pretty AuthMsg where diff --git a/odid.cabal b/odid.cabal --- a/odid.cabal +++ b/odid.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: odid -version: 0.1.0.0 +version: 1.0.0.0 synopsis: Open Drone ID description: ASTM F3411-22a homepage: https://github.com/dopamane/odid @@ -14,6 +14,10 @@ extra-doc-files: CHANGELOG.md README.md +source-repository head + type: git + location: https://github.com/dopamane/odid + library default-language: Haskell2010 ghc-options: -Wall -O2 @@ -50,8 +54,6 @@ base < 5, binary, bytestring, - hedgehog, odid, tasty, - tasty-hedgehog, tasty-hunit diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -5,60 +5,51 @@ import Data.Binary import qualified Data.ByteString.Lazy as BS import Data.ODID -import Hedgehog -import qualified Hedgehog.Gen as Gen -import qualified Hedgehog.Range as Range import Test.Tasty -import Test.Tasty.Hedgehog import Test.Tasty.HUnit main :: IO () -main = defaultMain $ testGroup "Test.ODID" [testBasicID, testLocation] +main = defaultMain $ testGroup "Test.ODID" [loopback "BasicID" basicID + , loopback "Location" loc, loopback "Auth0" auth0, loopback "AuthN" authN + , loopback "SelfID" selfID, loopback "Sys" sys, loopback "OpID" opID + , loopback "Pack" msgPack] -testBasicID :: TestTree -testBasicID = testCase "BasicID" $ do - let input = Msg (MsgHdr 2 BasicIDTy) $ - BasicIDBdy CAARegID Heli "01234567890123456789" $ BS.replicate 3 0x00 - decode (encode input) @?= input +loopback :: (Binary a, Eq a, Show a) => String -> a -> TestTree +loopback n d = testCase n $ decode (encode d) @?= d -testLocation :: TestTree -testLocation = testCase "Location" $ do - let input = Msg (MsgHdr 2 Location) $ LocBdy - LocMsg{locOpStatus=Ground, locFlagsRsvd=False, locHeightType=AGL - , locFlagsDir=False, locFlagsMult=False, locTrackDir=135 - , locSpeed=5, locVertSpeed=7.5, locLat=34.0522, locLon=118.2437 - , locPresAlt=10.5, locGeoAlt=8.5, locHeight=2 - , locVertAcc=VertAccLT3M, locHorzAcc=LT1M - , locBaroAltAcc=VertAccLT3M, locSpeedAcc=LT1MS, locTimestamp=0 - , locTStampAccRsvd=0, locTStampAcc=0.1, locRsvd=0} - decode (encode input) @?= input +basicID :: Msg +basicID = Msg (MsgHdr 2 BasicIDTy) $ + BasicIDBdy CAARegID Heli "01234567890123456789" $ BS.replicate 3 0x00 -{- -testMsgBinaryTrip :: TestTree -testMsgBinaryTrip = testProperty "Msg" $ property $ binTrip =<< forAll genMsg +loc :: Msg +loc = Msg (MsgHdr 2 Location) $ LocBdy + LocMsg{locOpStatus=Ground, locFlagsRsvd=False, locHeightType=AGL + , locFlagsDir=False, locFlagsMult=False, locTrackDir=135 + , locSpeed=5, locVertSpeed=7.5, locLat=34.0522, locLon=118.2437 + , locPresAlt=10.5, locGeoAlt=8.5, locHeight=2 + , locVertAcc=VertAccLT3M, locHorzAcc=LT1M + , locBaroAltAcc=VertAccLT3M, locSpeedAcc=LT1MS, locTimestamp=0 + , locTStampAccRsvd=0, locTStampAcc=0.1, locRsvd=0} -genMsg :: MonadGen m => m Msg -genMsg = do - ver <- Gen.word8 $ Range.linear 0 15 - typ <- Gen.element msgTypes - Msg (MsgHdr ver typ) <$> case typ of - BasicIDTy -> BasicIDBdy <$> Gen.enumBounded <*> Gen.enumBounded - <*> BS.fromStrict `fmap` Gen.bytes (Range.singleton 20) - <*> BS.fromStrict `fmap` Gen.bytes (Range.singleton 3) - Location -> LocBdy <$> Gen.discard - Auth -> Gen.discard - SelfIDTy -> SelfIDBdy <$> Gen.enumBounded - <*> BS.fromStrict `fmap` Gen.bytes (Range.singleton 23) - System -> Gen.discard - OperatorID -> OpIDBdy <$> Gen.enumBounded - <*> BS.fromStrict `fmap` Gen.bytes (Range.singleton 20) - <*> BS.fromStrict `fmap` Gen.bytes (Range.singleton 3) - Pack -> Gen.discard +selfID :: Msg +selfID = Msg (MsgHdr 2 SelfIDTy) $ SelfIDBdy 1 $ BS.pack [0..22] -genOpStatus :: MonadGen m => m OpStatus -genOpStatus = Gen.choice $ OpStatusRsvd `fmap` Gen.word8 (Range.linear 0 15) : map pure - [Undeclared, Ground, Airborne, Emergency, RemoteIDSystemFailure] +opID :: Msg +opID = Msg (MsgHdr 2 OperatorID) $ OpIDBdy 0 (BS.pack [0..19]) $ BS.pack [1, 2, 3] -binTrip :: (MonadTest m, Show a, Eq a, Binary a) => a -> m () -binTrip d = tripping d encode $ fmap (\(_, _, a) -> a) . decodeOrFail --} +sys :: Msg +sys = Msg (MsgHdr 2 System) $ SysBdy + SysMsg{sysClassType=EuroUnion, sysOpSrcType=Takeoff, sysOpLat=34.0575762 + , sysOpLon=(-118.2405026), sysArCnt=1, sysArRad=10, sysArCeil=10.5 + , sysArFloor=10.5, sysClassCat=Open, sysClassClass=3, sysOpAlt=24.5 + , sysTimestamp=12345, sysRsvd=0xAB} + +auth0 :: Msg +auth0 = Msg (MsgHdr 2 Auth) $ AuthBdy $ AuthMsg AuthNone 0 (Just (0, 255, 120)) $ + BS.pack [0..16] + +authN :: Msg +authN = Msg (MsgHdr 2 Auth) $ AuthBdy $ AuthMsg UASIDSig 1 Nothing $ BS.pack [0..22] + +msgPack :: Msg +msgPack = Msg (MsgHdr 2 Pack) $ PackBdy 0x19 7 [basicID, loc, selfID, opID, sys, auth0, authN]